From 0fcdc25a7d0321e1a5a84c382838346b230d6973 Mon Sep 17 00:00:00 2001 From: Aaron Tomb Date: Thu, 14 May 2026 14:44:26 -0700 Subject: [PATCH 01/28] Add PR template warning about repository split (#1166) Add a pull request description template that warns about the upcoming repository split. By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --- .github/pull_request_template.md | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 .github/pull_request_template.md diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md new file mode 100644 index 0000000000..268728fdc7 --- /dev/null +++ b/.github/pull_request_template.md @@ -0,0 +1,7 @@ +**Warning:** This repository will shortly undergo a split into several separate repositories. If you're creating a PR that crosses the boundaries between these repositories, you may want to hold off until the split is complete or be prepared to rework your PR into multiple PRs once the split is complete. + +The code that will be moved includes: +- Strata/DDM/* +- Strata/Languages/Boole/* +- Strata/Languages/Python/* along with Tools/Python/* +- Tools/BoogieToStrata \ No newline at end of file From 99b84e5d74622f629800fa147bca9e9064c7aa53 Mon Sep 17 00:00:00 2001 From: Michael Tautschnig Date: Fri, 15 May 2026 20:37:59 +0200 Subject: [PATCH 02/28] lake: build Strata lib as a test-driver dependency (#1138) The `StrataTestMain` test driver spawns `lean` on files under `StrataTestExtra/`, which is not declared as a `lean_lib`. Some of those files (e.g. `DDM/Integration/Java/TestGen.lean`) import modules from the `Strata` library that are not in `StrataTest`'s transitive closure, most notably `Strata.DDM.Integration.Java`. Before this change, `lake test` on a clean `.lake` would only build the closure reachable from `StrataTest` and then fail at subprocess time with: error: object file '.../Strata/DDM/Integration/Java.olean' of module Strata.DDM.Integration.Java does not exist Running `lake build` first masked the bug because the `Strata` library is in `defaultTargets`. Add `Strata` to the `needs` list of `StrataTestMain` so Lake builds the full `Strata` library before the test driver runs, regardless of whether `lake build` was run beforehand. By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. Co-authored-by: Kiro --- lakefile.toml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lakefile.toml b/lakefile.toml index b59a11c9e8..5110d270ac 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -27,7 +27,12 @@ globs = ["StrataTest.+"] [[lean_exe]] name = "StrataTestMain" root = "Scripts.StrataTestMain" -needs = ["StrataTest"] +# `Strata` is listed explicitly because the driver spawns `lean` on files +# under `StrataTestExtra/` (which is not a `lean_lib`). Those files import +# modules from the `Strata` library that are not in `StrataTest`'s transitive +# closure (e.g., `Strata.DDM.Integration.Java`), so without this the oleans +# would be missing when running `lake test` from a clean `.lake`. +needs = ["Strata", "StrataTest"] [[lean_exe]] name = "StrataToCBMC" From 8acaa4b56f3dee63b8e56da1a682e0ef4e6b2849 Mon Sep 17 00:00:00 2001 From: Juneyoung Lee <136006969+aqjune-aws@users.noreply.github.com> Date: Fri, 15 May 2026 15:39:21 -0500 Subject: [PATCH 03/28] The small-step semantics of Imperative must have scoped var init, remove unlabeled exit from Core (#1141) *Issue #, if available:* Closes https://github.com/strata-org/Strata/issues/372 *Description of changes:* Formalizing scoped variable initialization: - Adds scoped environment semantics to blocks: step_block_done now projects the store through the parent store via projectStore, discarding block-local variables on exit. This applies to both StepStmt (deterministic) and StepKleene (nondeterministic). - Adds PostWF helper definition in Specification.lean for postcondition stability under projectStore. - Adds .block constructor to KleeneStmt and corresponding step_block/step_block_body/step_block_done to StepKleene, mirroring the deterministic block semantics. - Changes StmtToKleeneStmt (.block _ bss _) to produce .block b (wrapping in a Kleene block), so the Kleene translation preserves scoping. Removing unlabeled `exit` command (`exit;`, not `exit lbl;`): - The unlabeled `exit` command doesn't have clear meaning when it is inside `while`. In `while cond { ... exit; ... }`, is `exit` equivalent to `continue` or `break` in C/Python? No translation to Core was introducing the unlabeled `exit`, and the small-step semantics wasn't clear about the meaning of `exit` inside a loop. - The type checker of Core (Strata/Languages/Core/StatementType.lean) fails when an unlabeled `exit` appears inside the body of a while loop / if statement (unless it is wrapped by another nested block), but the DDM syntax of core allows it, so from user's perspective this gap is kind of surprising. - This patch removes the unlabeled `exit` case because it can always be simulated by a labeled block + labeled exit. On top of this, this also renames `touchedVars` to `modifiedOrDefinedVars` for clarity, and instead makes `touchedVars` all vars that are read + modified + defined. ### How to review? - Strata/DL/Imperative/StmtSemantics.lean has the most important update: the `.block` constructor now has the input store which will be used to 'project' the output store to the variables that have been defined before. Also, any block-exiting small steps like `step_block_done` will do the projection, to define variables which were defined inside the inner scope. - Correspondingly, the Kleene language was updated to add a notion of block and scoping to its syntax and semantics, otherwise DetToKleene doesn't prove. (Strata/DL/Imperative/KleeneStmt.lean, Strata/DL/Imperative/KleeneStmtSemantics.lean) - StrataTest/DL/Imperative/StepStmtTest.lean has a few new tests that show scoping works well. - DetToKleeneCorrect.lean and ProcBodyVerifyCorrect.lean shows that the top-level statements are not touched after this update. - Strata/DL/Imperative/HasVars.lean has the `touchedVars` update and Strata/Languages/Core/StatementSemantics.lean has some additional well-formedness about evaluator extension that are useful. By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --- Strata/DL/Imperative/Cmd.lean | 2 +- Strata/DL/Imperative/CmdSemantics.lean | 4 +- Strata/DL/Imperative/HasVars.lean | 4 +- .../DL/Imperative/KleeneSemanticsProps.lean | 22 + Strata/DL/Imperative/KleeneStmt.lean | 8 + Strata/DL/Imperative/KleeneStmtSemantics.lean | 36 +- Strata/DL/Imperative/SemanticsProps.lean | 1 - Strata/DL/Imperative/Stmt.lean | 74 ++-- Strata/DL/Imperative/StmtEval.lean | 7 +- Strata/DL/Imperative/StmtSemantics.lean | 382 +++++++++-------- Strata/Languages/Boole/Verify.lean | 2 - .../Core/DDMTransform/FormatCore.lean | 8 +- .../Languages/Core/DDMTransform/Grammar.lean | 1 - .../Core/DDMTransform/Translate.lean | 5 +- Strata/Languages/Core/Procedure.lean | 6 +- Strata/Languages/Core/Statement.lean | 24 +- Strata/Languages/Core/StatementSemantics.lean | 9 +- .../Core/StatementSemanticsProps.lean | 178 ++++++-- Strata/Languages/Core/StatementType.lean | 17 +- Strata/Languages/Core/WF.lean | 4 +- .../Laurel/LaurelToCoreTranslator.lean | 6 +- Strata/Languages/Python/PythonToCore.lean | 8 +- Strata/Transform/CallElimCorrect.lean | 2 +- Strata/Transform/CoreSpecification.lean | 2 + Strata/Transform/DetToKleene.lean | 2 +- Strata/Transform/DetToKleeneCorrect.lean | 297 +++++++------ Strata/Transform/ProcBodyVerifyCorrect.lean | 99 +++-- Strata/Transform/ProcedureInlining.lean | 2 +- Strata/Transform/Specification.lean | 41 +- .../Transform/StructuredToUnstructured.lean | 22 +- .../Backends/CBMC/GOTO/ToCProverGOTO.lean | 2 +- StrataTest/DL/Imperative/FormatStmtTest.lean | 6 +- StrataTest/DL/Imperative/StepStmtTest.lean | 401 ++++++++++++++++-- StrataTest/Transform/ProcedureInlining.lean | 7 +- docs/verso/LangDefDoc.lean | 3 +- 35 files changed, 1117 insertions(+), 577 deletions(-) diff --git a/Strata/DL/Imperative/Cmd.lean b/Strata/DL/Imperative/Cmd.lean index df62a0b4c4..24da7fce49 100644 --- a/Strata/DL/Imperative/Cmd.lean +++ b/Strata/DL/Imperative/Cmd.lean @@ -183,7 +183,7 @@ instance (P : PureExpr) : HasVarsImp P (Cmds P) where definedVars := Cmds.definedVars modifiedVars := Cmds.modifiedVars -- order matters for Havoc, so needs to override the default - touchedVars := List.flatMap HasVarsImp.touchedVars + modifiedOrDefinedVars := List.flatMap HasVarsImp.modifiedOrDefinedVars --------------------------------------------------------------------- diff --git a/Strata/DL/Imperative/CmdSemantics.lean b/Strata/DL/Imperative/CmdSemantics.lean index 11392f9073..a2da7a8607 100644 --- a/Strata/DL/Imperative/CmdSemantics.lean +++ b/Strata/DL/Imperative/CmdSemantics.lean @@ -44,7 +44,7 @@ when the command signals a failure. /-- ### Well-Formedness of `SemanticStore`s -/ -def isDefined {P : PureExpr} (σ : SemanticStore P) (vs : List P.Ident) : Prop := +@[expose] def isDefined {P : PureExpr} (σ : SemanticStore P) (vs : List P.Ident) : Prop := ∀ v, v ∈ vs → (σ v).isSome = true def isNotDefined {P : PureExpr} (σ : SemanticStore P) (vs : List P.Ident) : Prop := @@ -239,7 +239,7 @@ def WellFormedSemanticEvalVal {P : PureExpr} [HasVal P] @[expose] def WellFormedSemanticEvalVar {P : PureExpr} [HasFvar P] (δ : SemanticEval P) : Prop := (∀ e v σ, HasFvar.getFvar e = some v → δ σ e = σ v) -def WellFormedSemanticEvalExprCongr {P : PureExpr} [HasVarsPure P P.Expr] (δ : SemanticEval P) +@[expose] def WellFormedSemanticEvalExprCongr {P : PureExpr} [HasVarsPure P P.Expr] (δ : SemanticEval P) : Prop := ∀ e σ σ', (∀ x ∈ HasVarsPure.getVars e, σ x = σ' x) → δ σ e = δ σ' e /-- diff --git a/Strata/DL/Imperative/HasVars.lean b/Strata/DL/Imperative/HasVars.lean index 865196658f..5cc92a66c8 100644 --- a/Strata/DL/Imperative/HasVars.lean +++ b/Strata/DL/Imperative/HasVars.lean @@ -21,7 +21,7 @@ class HasVarsPure (P : PureExpr) (α : Type) where class HasVarsImp (P : PureExpr) (α : Type) where definedVars : α → List P.Ident modifiedVars : α → List P.Ident - touchedVars : α → List P.Ident + modifiedOrDefinedVars : α → List P.Ident := λ e ↦ definedVars e ++ modifiedVars e --------------------------------------------------------------------- @@ -42,7 +42,7 @@ class HasVarsTrans definedVarsTrans : (String → Option PT) → α → List P.Ident modifiedVarsTrans : (String → Option PT) → α → List P.Ident getVarsTrans : (String → Option PT) → α → List P.Ident - touchedVarsTrans : (String → Option PT) → α → List P.Ident + modifiedOrDefinedVarsTrans : (String → Option PT) → α → List P.Ident allVarsTrans : (String → Option PT) → α → List P.Ident := λ π a ↦ modifiedVarsTrans π a ++ getVarsTrans π a diff --git a/Strata/DL/Imperative/KleeneSemanticsProps.lean b/Strata/DL/Imperative/KleeneSemanticsProps.lean index fa3b6a579d..11b8b1a667 100644 --- a/Strata/DL/Imperative/KleeneSemanticsProps.lean +++ b/Strata/DL/Imperative/KleeneSemanticsProps.lean @@ -36,6 +36,28 @@ theorem eval_tt_is_tt /-! ## Kleene small-step helpers -/ +omit [HasVal P] [HasBoolVal P] in +theorem kleene_block_inner_star + (σ_parent : SemanticStore P) + (inner inner' : KleeneConfig P (Cmd P)) + (h : StepKleeneStar P (EvalCmd P) inner inner') : + StepKleeneStar P (EvalCmd P) (.block σ_parent inner) (.block σ_parent inner') := by + induction h with + | refl => exact .refl _ + | step _ mid _ hstep _ ih => exact .step _ _ _ (.step_block_body hstep) ih + +omit [HasVal P] [HasBoolVal P] in +/-- Lift an inner execution through a block wrapper to terminal (with projection). -/ +theorem kleene_block_terminal + (σ_parent : SemanticStore P) + (inner : KleeneConfig P (Cmd P)) (ρ' : Env P) + (h : StepKleeneStar P (EvalCmd P) inner (.terminal ρ')) : + StepKleeneStar P (EvalCmd P) (.block σ_parent inner) + (.terminal { ρ' with store := projectStore σ_parent ρ'.store }) := + ReflTrans_Transitive _ _ _ _ + (kleene_block_inner_star σ_parent inner (.terminal ρ') h) + (.step _ _ _ .step_block_done (.refl _)) + omit [HasVal P] [HasBoolVal P] in theorem kleene_seq_inner_star (inner inner' : KleeneConfig P (Cmd P)) (s2 : KleeneStmt P (Cmd P)) diff --git a/Strata/DL/Imperative/KleeneStmt.lean b/Strata/DL/Imperative/KleeneStmt.lean index f7c82f8497..faa049dd3f 100644 --- a/Strata/DL/Imperative/KleeneStmt.lean +++ b/Strata/DL/Imperative/KleeneStmt.lean @@ -41,6 +41,11 @@ inductive KleeneStmt (P : PureExpr) (Cmd : Type) : Type where | choice (s1 s2 : KleeneStmt P Cmd) /-- Execute `s` an arbitrary number of times (possibly zero). -/ | loop (s : KleeneStmt P Cmd) + /-- Execute `s` in a scoped block: variables initialized inside are + projected away on exit (matching the deterministic `.block` semantics). + There is no label unlike Imperative.Stmt.block because KleeneStmt doesn't + have .exit. -/ + | block (s : KleeneStmt P Cmd) deriving Inhabited abbrev KleeneStmt.init {P : PureExpr} (name : P.Ident) (ty : P.Ty) (expr : P.Expr) (md : MetaData P) := @@ -62,6 +67,7 @@ def KleeneStmt.definedVars [HasVarsImp P C] (s : KleeneStmt P C) : List P.Ident | .seq s1 s2 => KleeneStmt.definedVars s1 ++ KleeneStmt.definedVars s2 | .choice s1 s2 => KleeneStmt.definedVars s1 ++ KleeneStmt.definedVars s2 | .loop s => KleeneStmt.definedVars s + | .block s => KleeneStmt.definedVars s def KleeneStmts.definedVars [HasVarsImp P C] (ss : List (KleeneStmt P C)) : List P.Ident := match ss with @@ -77,6 +83,7 @@ def KleeneStmt.modifiedVars [HasVarsImp P C] (s : KleeneStmt P C) : List P.Ident | .seq s1 s2 => KleeneStmt.modifiedVars s1 ++ KleeneStmt.modifiedVars s2 | .choice s1 s2 => KleeneStmt.modifiedVars s1 ++ KleeneStmt.modifiedVars s2 | .loop s => KleeneStmt.modifiedVars s + | .block s => KleeneStmt.modifiedVars s def KleeneStmts.modifiedVars [HasVarsImp P C] (ss : List (KleeneStmt P C)) : List P.Ident := match ss with @@ -101,6 +108,7 @@ def formatKleeneStmt (P : PureExpr) (s : KleeneStmt P C) | .seq s1 s2 => f!"({formatKleeneStmt P s1}) ; ({formatKleeneStmt P s2})" | .choice s1 s2 => f!"({formatKleeneStmt P s1}) | ({formatKleeneStmt P s2})" | .loop s => f!"({formatKleeneStmt P s})*" + | .block s => f!"block({formatKleeneStmt P s})" instance [ToFormat P.Ident] [ToFormat P.Expr] [ToFormat P.Ty] [ToFormat C] : ToFormat (KleeneStmt P C) where diff --git a/Strata/DL/Imperative/KleeneStmtSemantics.lean b/Strata/DL/Imperative/KleeneStmtSemantics.lean index 7b70ba065b..4152be0a2f 100644 --- a/Strata/DL/Imperative/KleeneStmtSemantics.lean +++ b/Strata/DL/Imperative/KleeneStmtSemantics.lean @@ -17,7 +17,7 @@ public section /-! # Small-step semantics for non-deterministic statements A configuration is either executing a `KleeneStmt`, sequencing two parts -(left config + right continuation), or terminated. +(left config + right continuation), a block context, or terminated. -/ /-- Configurations for small-step execution of `KleeneStmt`. -/ @@ -28,6 +28,9 @@ inductive KleeneConfig (P : PureExpr) (CmdT : Type) : Type where | seq : KleeneConfig P CmdT → KleeneStmt P CmdT → KleeneConfig P CmdT /-- Execution has finished. -/ | terminal : Env P → KleeneConfig P CmdT + /-- A block context for scoping. The `SemanticStore P` is the parent store; + on exit, variables init'd inside are projected away. -/ + | block : SemanticStore P → KleeneConfig P CmdT → KleeneConfig P CmdT /-! ## Configuration accessors -/ @@ -35,16 +38,19 @@ inductive KleeneConfig (P : PureExpr) (CmdT : Type) : Type where | .stmt _ ρ => ρ.store | .seq inner _ => inner.getStore | .terminal ρ => ρ.store + | .block _ inner => inner.getStore @[expose] def KleeneConfig.getEval : KleeneConfig P CmdT → SemanticEval P | .stmt _ ρ => ρ.eval | .seq inner _ => inner.getEval | .terminal ρ => ρ.eval + | .block _ inner => inner.getEval @[expose] def KleeneConfig.getEnv : KleeneConfig P CmdT → Env P | .stmt _ ρ => ρ | .seq inner _ => inner.getEnv | .terminal ρ => ρ + | .block _ inner => inner.getEnv /-! ## Single-step relation -/ @@ -89,11 +95,21 @@ inductive StepKleene (.stmt (.loop s) ρ) (.terminal ρ) - /-- A loop can execute one iteration then continue looping. -/ + /-- A loop can execute one iteration then continue looping. + Each iteration's body runs in its own block scope, sequenced with the + recursive loop step. When the body's block terminates, projection drops + any variables initialized inside the body, so the next iteration starts + with the same `isSome`-domain as the loop entry. -/ | step_loop_step : StepKleene EvalCmd (.stmt (.loop s) ρ) - (.seq (.stmt s ρ) (.loop s)) + (.seq (.block ρ.store (.stmt s ρ)) (.loop s)) + + /-- A block statement enters a block context, saving the parent store. -/ + | step_block : + StepKleene EvalCmd + (.stmt (.block s) ρ) + (.block ρ.store (.stmt s ρ)) /-- A seq context steps its inner config forward. -/ | step_seq_inner : @@ -110,6 +126,20 @@ inductive StepKleene (.seq (.terminal ρ') s2) (.stmt s2 ρ') + /-- A block context steps its inner config forward. -/ + | step_block_body : + StepKleene EvalCmd inner inner' → + ---- + StepKleene EvalCmd + (.block σ_parent inner) + (.block σ_parent inner') + + /-- When a block's inner config reaches terminal, project the store. -/ + | step_block_done : + StepKleene EvalCmd + (.block σ_parent (.terminal ρ')) + (.terminal { ρ' with store := projectStore σ_parent ρ'.store }) + end /-! ## Multi-step relation -/ diff --git a/Strata/DL/Imperative/SemanticsProps.lean b/Strata/DL/Imperative/SemanticsProps.lean index 7a8f8b21a8..772aa9c4bb 100644 --- a/Strata/DL/Imperative/SemanticsProps.lean +++ b/Strata/DL/Imperative/SemanticsProps.lean @@ -137,7 +137,6 @@ private theorem step_hasFailure_monotone | step_seq_exit => exact hf | step_block_body _ ih => exact ih hf | step_block_done => exact hf - | step_block_exit_none => exact hf | step_block_exit_match _ => exact hf | step_block_exit_mismatch _ => exact hf diff --git a/Strata/DL/Imperative/Stmt.lean b/Strata/DL/Imperative/Stmt.lean index c60e02312c..821ecf0d9d 100644 --- a/Strata/DL/Imperative/Stmt.lean +++ b/Strata/DL/Imperative/Stmt.lean @@ -43,10 +43,9 @@ inductive Stmt (P : PureExpr) (Cmd : Type) : Type where | loop (guard : ExprOrNondet P) (measure : Option P.Expr) (invariants : List (String × P.Expr)) (body : List (Stmt P Cmd)) (md : MetaData P) - /-- An exit statement that transfers control out of the nearest enclosing - block with the given label. If no label is provided, exits the nearest - enclosing block. -/ - | exit (label : Option String) (md : MetaData P) + /-- An exit statement that transfers control out of the enclosing block + with the given label. -/ + | exit (label : String) (md : MetaData P) /-- A function declaration within a statement block. -/ | funcDecl (decl : PureFunc P) (md : MetaData P) /-- A type declaration within a statement block. -/ @@ -80,7 +79,7 @@ def Stmt.inductionOn {P : PureExpr} {Cmd : Type} (body : List (Stmt P Cmd)) (md : MetaData P), (∀ s, s ∈ body → motive s) → motive (Stmt.loop guard measure invariant body md)) - (exit_case : ∀ (label : Option String) (md : MetaData P), + (exit_case : ∀ (label : String) (md : MetaData P), motive (Stmt.exit label md)) (funcDecl_case : ∀ (decl : PureFunc P) (md : MetaData P), motive (Stmt.funcDecl decl md)) @@ -304,31 +303,40 @@ mutual /-- Get all variables modified/defined by the statement `s`. Note that we need a separate function because order matters here for sub-blocks -/ -@[simp] -def Stmt.touchedVars [HasVarsImp P C] (s : Stmt P C) : List P.Ident := +def Stmt.modifiedOrDefinedVars [HasVarsImp P C] (s : Stmt P C) : List P.Ident := match s with - | .block _ bss _ => Block.touchedVars bss - | .ite _ tbss ebss _ => Block.touchedVars tbss ++ Block.touchedVars ebss + | .block _ bss _ => Block.modifiedOrDefinedVars bss + | .ite _ tbss ebss _ => Block.modifiedOrDefinedVars tbss ++ Block.modifiedOrDefinedVars ebss | _ => Stmt.definedVars s ++ Stmt.modifiedVars s -@[simp] -def Block.touchedVars [HasVarsImp P C] (ss : Block P C) : List P.Ident := +def Block.modifiedOrDefinedVars [HasVarsImp P C] (ss : Block P C) : List P.Ident := match ss with | [] => [] - | s :: srest => Stmt.touchedVars s ++ Block.touchedVars srest + | s :: srest => Stmt.modifiedOrDefinedVars s ++ Block.modifiedOrDefinedVars srest +end + +mutual +/-- Get all variables touched (modified, defined, or read) by the statement `s`. -/ +def Stmt.touchedVars [HasVarsImp P C] [HasVarsPure P P.Expr] [HasVarsPure P C] + (s : Stmt P C) : List P.Ident := + Stmt.modifiedOrDefinedVars s ++ Stmt.getVars s + +def Block.touchedVars [HasVarsImp P C] [HasVarsPure P P.Expr] [HasVarsPure P C] + (ss : Block P C) : List P.Ident := + Block.modifiedOrDefinedVars ss ++ Block.getVars ss end instance (P : PureExpr) [HasVarsImp P C] : HasVarsImp P (Stmt P C) where definedVars := Stmt.definedVars modifiedVars := Stmt.modifiedVars -- order matters for Havoc, so needs to override the default - touchedVars := Stmt.touchedVars + modifiedOrDefinedVars := Stmt.modifiedOrDefinedVars instance (P : PureExpr) [HasVarsImp P C] : HasVarsImp P (Block P C) where definedVars := Block.definedVars modifiedVars := Block.modifiedVars -- order matters for Havoc, so needs to override the default - touchedVars := Block.touchedVars + modifiedOrDefinedVars := Block.modifiedOrDefinedVars --------------------------------------------------------------------- @@ -356,9 +364,7 @@ def formatStmt (P : PureExpr) (s : Stmt P C) let beforeBody := nestD f!"{line}{guard}{line}({measure}){line}{invFmt}" let children := group f!"{beforeBody}{line}{body}" f!"{md}while{children}" - | .exit label md => match label with - | some l => f!"{md}exit {l}" - | none => f!"{md}exit" + | .exit label md => f!"{md}exit {label}" | .funcDecl _ md => f!"{md}funcDecl " | .typeDecl tc md => f!"{md}type {tc.name} (arity {tc.numargs})" @@ -390,29 +396,24 @@ instance [ToFormat P.Ident] [ToFormat P.Expr] [ToFormat P.Ty] [ToFormat C] by an enclosing `block` — either within `s` itself or with a label in `labels` (representing blocks that enclose `s` externally). -When `s.exitsCoveredByBlocks []`, execution of `s` can never produce `.exiting`. - -The labels have type `Option String` (not `String`) so that `exit` without -destination block label can be considered as covered even when it is surrounded -by unlabeled blocks (`[None]`). -/ +When `s.exitsCoveredByBlocks []`, execution of `s` can never produce `.exiting`. -/ -@[expose] def Stmt.exitsCoveredByBlocks : List (Option String) → Stmt P CmdT → Prop +@[expose] def Stmt.exitsCoveredByBlocks : List String → Stmt P CmdT → Prop | _, .cmd _ => True - | labels, .block l ss _ => Block.exitsCoveredByBlocks (.some l :: labels) ss + | labels, .block l ss _ => Block.exitsCoveredByBlocks (l :: labels) ss | labels, .ite _ tss ess _ => Block.exitsCoveredByBlocks labels tss ∧ Block.exitsCoveredByBlocks labels ess | labels, .loop _ _ _ body _ => Block.exitsCoveredByBlocks labels body - | labels, .exit none _ => labels.length > 0 - | labels, .exit (some l) _ => .some l ∈ labels + | labels, .exit l _ => l ∈ labels | _, .funcDecl _ _ => True | _, .typeDecl _ _ => True where - Block.exitsCoveredByBlocks : List (Option String) → List (Stmt P CmdT) → Prop + Block.exitsCoveredByBlocks : List String → List (Stmt P CmdT) → Prop | _, [] => True | labels, s :: ss => Stmt.exitsCoveredByBlocks labels s ∧ Block.exitsCoveredByBlocks labels ss theorem block_exitsCoveredByBlocks_append {P : PureExpr} {CmdT : Type} - (labels : List (Option String)) (ss₁ ss₂ : List (Stmt P CmdT)) + (labels : List String) (ss₁ ss₂ : List (Stmt P CmdT)) (h₁ : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels ss₁) (h₂ : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels ss₂) : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels (ss₁ ++ ss₂) := by @@ -424,7 +425,7 @@ theorem block_exitsCoveredByBlocks_append can only help. -/ theorem exitsCoveredByBlocks_weaken {P : PureExpr} {CmdT : Type} - (labels₁ labels₂ : List (Option String)) + (labels₁ labels₂ : List String) (hsub : ∀ l, l ∈ labels₁ → l ∈ labels₂) : (∀ (s : Stmt P CmdT), s.exitsCoveredByBlocks labels₁ → s.exitsCoveredByBlocks labels₂) ∧ @@ -449,8 +450,8 @@ theorem exitsCoveredByBlocks_weaken | cmd _ => intros; trivial | block l ss _ ih => intro labels₁ labels₂ hsub h - show Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks (.some l :: labels₂) ss - exact ih (.some l :: labels₁) (.some l :: labels₂) + show Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks (l :: labels₂) ss + exact ih (l :: labels₁) (l :: labels₂) (fun x hx => by cases hx with | head => exact .head _ | tail _ hm => exact .tail _ (hsub x hm)) @@ -461,14 +462,9 @@ theorem exitsCoveredByBlocks_weaken | loop _ _ _ body _ ih => intro labels₁ labels₂ hsub h exact ih labels₁ labels₂ hsub h - | exit label _ => + | exit l _ => intro labels₁ labels₂ hsub h - cases label with - | none => - show labels₂.length > 0 - exact List.length_pos_iff_exists_mem.mpr - (let ⟨x, hx⟩ := List.length_pos_iff_exists_mem.mp h; ⟨x, hsub x hx⟩) - | some l => exact hsub (.some l) h + exact hsub l h | funcDecl _ _ => intros; trivial | typeDecl _ _ => intros; trivial | nil => intros; trivial @@ -480,7 +476,7 @@ theorem exitsCoveredByBlocks_weaken for any labels (since `.cmd` has no exit statements). -/ theorem all_cmd_exitsCoveredByBlocks {P : PureExpr} {CmdT : Type} - (labels : List (Option String)) (ss : List (Stmt P CmdT)) + (labels : List String) (ss : List (Stmt P CmdT)) (h : ∀ s ∈ ss, ∃ c, s = Stmt.cmd c) : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels ss := by induction ss with diff --git a/Strata/DL/Imperative/StmtEval.lean b/Strata/DL/Imperative/StmtEval.lean index 9acf45668e..f09895a74c 100644 --- a/Strata/DL/Imperative/StmtEval.lean +++ b/Strata/DL/Imperative/StmtEval.lean @@ -23,7 +23,7 @@ inductive RunConfig (P : PureExpr) (CmdT : Type) (S : Type) where | stmt : Stmt P CmdT → S → RunConfig P CmdT S | stmts : List (Stmt P CmdT) → S → RunConfig P CmdT S | terminal : S → RunConfig P CmdT S - | exiting : Option String → S → RunConfig P CmdT S + | exiting : String → S → RunConfig P CmdT S | block : String → RunConfig P CmdT S → RunConfig P CmdT S | seq : RunConfig P CmdT S → List (Stmt P CmdT) → RunConfig P CmdT S @@ -96,10 +96,9 @@ def runStep [BEq P.Expr] [HasBool P] | .block label inner => match inner with | .terminal ρ' => .terminal (ops.popScope ρ') - | .exiting .none ρ' => .terminal (ops.popScope ρ') - | .exiting (.some l) ρ' => + | .exiting l ρ' => if l == label then .terminal (ops.popScope ρ') - else .exiting (.some l) (ops.popScope ρ') + else .exiting l (ops.popScope ρ') | _ => .block label (runStep ops inner) def runStmt [BEq P.Expr] [HasBool P] diff --git a/Strata/DL/Imperative/StmtSemantics.lean b/Strata/DL/Imperative/StmtSemantics.lean index 3b9da68ab7..68a7dd2993 100644 --- a/Strata/DL/Imperative/StmtSemantics.lean +++ b/Strata/DL/Imperative/StmtSemantics.lean @@ -66,12 +66,14 @@ inductive Config (P : PureExpr) (CmdT : Type) : Type where /-- A terminal configuration, indicating that execution has finished. -/ | terminal : Env P → Config P CmdT /-- An exiting configuration, indicating that an exit statement was encountered. - The optional label identifies which block to exit to. -/ - | exiting : Option String → Env P → Config P CmdT + The label identifies which block to exit to. -/ + | exiting : String → Env P → Config P CmdT /-- A block context: execute the inner config, then consume matching exits. The label is `Option String` — `none` denotes an unnamed block that only - catches unlabeled exits. -/ - | block : Option String → Config P CmdT → Config P CmdT + catches unlabeled exits. The `SemanticStore P` is the parent store at + block entry; on exit, the result is projected through it so that + variables initialized inside the block are not visible outside. -/ + | block : Option String → SemanticStore P → Config P CmdT → Config P CmdT /-- A sequence context: execute the first statement (as a sub-config), then continue with the remaining statements. -/ | seq : Config P CmdT → List (Stmt P CmdT) → Config P CmdT @@ -86,7 +88,7 @@ variable {P : PureExpr} {CmdT : Type} | .stmts _ ρ => ρ | .terminal ρ => ρ | .exiting _ ρ => ρ - | .block _ inner => inner.getEnv + | .block _ _ inner => inner.getEnv | .seq inner _ => inner.getEnv /-- Extract the store from a configuration. -/ @@ -130,7 +132,7 @@ where | .stmts ss _, label => Stmt.noMatchingAssert.Stmts.noMatchingAssert ss label | .terminal _, _ => True | .exiting _ _, _ => True - | .block _ inner, label => inner.noMatchingAssert label + | .block _ _ inner, label => inner.noMatchingAssert label | .seq inner ss, label => inner.noMatchingAssert label ∧ Stmt.noMatchingAssert.Stmts.noMatchingAssert ss label @@ -140,20 +142,31 @@ def Config.noFuncDecl : Config P CmdT → Prop | .stmts ss _ => Block.noFuncDecl ss = true | .terminal _ => True | .exiting _ _ => True - | .block _ inner => Config.noFuncDecl inner + | .block _ _ inner => Config.noFuncDecl inner | .seq inner ss => Config.noFuncDecl inner ∧ Block.noFuncDecl ss = true -/-- Extend `exitsCoveredByBlocks` to configurations. -/ -@[expose] def Config.exitsCoveredByBlocks : List (Option String) → Config P CmdT → Prop +/-- Extend `exitsCoveredByBlocks` to configurations. + + The label list has type `List String` (matching `Stmt.exit`'s mandatory-label + AST). An anonymous (`.none`) `Config.block` (introduced by the loop/if's body + wrapper) does NOT contribute a label — labeled exits cannot match `.none`, + and unlabeled exits do not exist as user statements. -/ +@[expose] def Config.exitsCoveredByBlocks : List String → Config P CmdT → Prop | labels, .stmt s _ => s.exitsCoveredByBlocks labels | labels, .stmts ss _ => Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels ss | _, .terminal _ => True - | labels, .exiting none _ => labels.length > 0 - | labels, .exiting (some l) _ => .some l ∈ labels - | labels, .block l inner => Config.exitsCoveredByBlocks (l :: labels) inner + | labels, .exiting l _ => l ∈ labels + | labels, .block none _ inner => Config.exitsCoveredByBlocks labels inner + | labels, .block (some l) _ inner => Config.exitsCoveredByBlocks (l :: labels) inner | labels, .seq inner ss => Config.exitsCoveredByBlocks labels inner ∧ Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels ss +/-- Project an inner store through a parent store: keep the inner value only + for variables that were already defined in the parent. Variables that were + not defined in the parent (i.e., init'd inside the block) become `none`. -/ +@[expose] def projectStore (σ_parent σ_inner : SemanticStore P) : SemanticStore P := + fun x => if (σ_parent x).isSome then σ_inner x else none + /-! ## Single-step relation -/ section @@ -184,11 +197,13 @@ inductive StepStmt /-- A labeled block steps to a block context that wraps its body as `.stmts`. The AST label `label : String` is lifted into `.some label` for the - `Config.block` wrapper (whose label is `Option String`). -/ + `Config.block` wrapper (whose label is `Option String`). + The parent store `ρ.store` is saved so that block-local variables + can be popped on exit. -/ | step_block : StepStmt EvalCmd extendEval (.stmt (.block label ss _) ρ) - (.block (.some label) (.stmts ss ρ)) + (.block (.some label) ρ.store (.stmts ss ρ)) /-- If the condition of an `ite` statement evaluates to true, step to the then branch. -/ @@ -231,9 +246,11 @@ inductive StepStmt labeled pairs `(String × P.Expr)`; only the expression part is evaluated. - The body+recursion is wrapped in an unnamed `.block`, so an unlabeled - `exit` inside the body terminates the loop (and nothing else), while a - labeled `exit` propagates past the loop. -/ + The body alone is wrapped in an unnamed `.block`, sequenced with the + recursive loop. This means each iteration runs the body in its own + block scope: variables `init`'d inside body are projected away at the + end of each iteration, allowing the next iteration's body to re-`init` + the same names. -/ | step_loop_enter {hasInvFailure : Bool} : ρ.eval ρ.store g = .some HasBool.tt → (∀ le ∈ inv, ρ.eval ρ.store le.2 = .some HasBool.tt ∨ @@ -243,8 +260,10 @@ inductive StepStmt ---- StepStmt EvalCmd extendEval (.stmt (.loop (.det g) m inv body md) ρ) - (.block .none (.stmts (body ++ [.loop (.det g) m inv body md]) - { ρ with hasFailure := ρ.hasFailure || hasInvFailure })) + (.seq + (.block .none ρ.store (.stmts body + { ρ with hasFailure := ρ.hasFailure || hasInvFailure })) + [.loop (.det g) m inv body md]) /-- If a loop guard is false, terminate the loop. As with `step_loop_enter`, invariants must be boolean-valued and any `ff` result flips `hasFailure`. -/ @@ -261,16 +280,18 @@ inductive StepStmt /-- Non-deterministic loop: enter the body. Same invariant-boolean condition as the deterministic case. As with the det variant, the - body is wrapped in an unnamed `.block` so that an unlabeled `exit` - terminates just the loop. -/ + body alone is wrapped in an unnamed `.block` and sequenced with the + recursive loop, giving each iteration its own block scope. -/ | step_loop_nondet_enter {hasInvFailure : Bool} : (∀ le ∈ inv, ρ.eval ρ.store le.2 = .some HasBool.tt ∨ ρ.eval ρ.store le.2 = .some HasBool.ff) → (hasInvFailure ↔ ∃ le ∈ inv, ρ.eval ρ.store le.2 = .some HasBool.ff) → StepStmt EvalCmd extendEval (.stmt (.loop .nondet m inv body md) ρ) - (.block .none (.stmts (body ++ [.loop .nondet m inv body md]) - { ρ with hasFailure := ρ.hasFailure || hasInvFailure })) + (.seq + (.block .none ρ.store (.stmts body + { ρ with hasFailure := ρ.hasFailure || hasInvFailure })) + [.loop .nondet m inv body md]) /-- Non-deterministic loop: exit the loop. -/ | step_loop_nondet_exit {hasInvFailure : Bool} : @@ -340,39 +361,37 @@ inductive StepStmt StepStmt EvalCmd extendEval inner inner' → ---- StepStmt EvalCmd extendEval - (.block label inner) - (.block label inner') + (.block label σ_parent inner) + (.block label σ_parent inner') - /-- When a block's inner body reaches terminal, the block terminates. -/ + /-- When a block's inner body reaches terminal, the block terminates. + The resulting store is projected through the parent store: only variables + that existed before the block keep their (possibly updated) values; + variables initialized inside the block are discarded. -/ | step_block_done : StepStmt EvalCmd extendEval - (.block label (.terminal ρ')) - (.terminal ρ') - - /-- When a block's inner body exits with no label, the block consumes the exit - (regardless of the block's own label). -/ - | step_block_exit_none : - StepStmt EvalCmd extendEval - (.block label (.exiting .none ρ')) - (.terminal ρ') + (.block label σ_parent (.terminal ρ')) + (.terminal { ρ' with store := projectStore σ_parent ρ'.store }) - /-- When a block's inner body exits with a matching label, the block consumes it. -/ + /-- When a block's inner body exits with a matching label, the block consumes it. + Store is projected. -/ | step_block_exit_match : label = .some l → ---- StepStmt EvalCmd extendEval - (.block label (.exiting (.some l) ρ')) - (.terminal ρ') + (.block label σ_parent (.exiting l ρ')) + (.terminal { ρ' with store := projectStore σ_parent ρ'.store }) /-- When a block's inner body exits with a non-matching label, the exit propagates. - "Non-matching" covers both the unnamed-block (`.none`) case and any other - mismatched `some` label. -/ + Includes the case where the block's own label is `.none` (anonymous loop/ite + wrapper, which never matches a labeled exit) as well as any other mismatched + `.some` label. Store is projected since we're leaving this block. -/ | step_block_exit_mismatch : label ≠ .some l → ---- StepStmt EvalCmd extendEval - (.block label (.exiting (.some l) ρ')) - (.exiting (.some l) ρ') + (.block label σ_parent (.exiting l ρ')) + (.exiting l { ρ' with store := projectStore σ_parent ρ'.store }) end @@ -462,8 +481,9 @@ theorem seq_inner_star theorem block_inner_star (inner inner' : Config P CmdT) (label : Option String) + (σ_parent : SemanticStore P) (h : StepStmtStar P EvalCmd extendEval inner inner') : - StepStmtStar P EvalCmd extendEval (.block label inner) (.block label inner') := by + StepStmtStar P EvalCmd extendEval (.block label σ_parent inner) (.block label σ_parent inner') := by induction h with | refl => exact .refl _ | step _ mid _ hstep _ ih => exact .step _ _ _ (.step_block_body hstep) ih @@ -525,7 +545,7 @@ theorem seq_reaches_terminal /-- Invert a seq execution reaching exiting: either the inner exited (propagated), or the inner terminated and the tail exited. -/ theorem seq_reaches_exiting - {inner : Config P CmdT} {ss : List (Stmt P CmdT)} {lbl : Option String} {ρ' : Env P} + {inner : Config P CmdT} {ss : List (Stmt P CmdT)} {lbl : String} {ρ' : Env P} (hstar : StepStmtStar P EvalCmd extendEval (.seq inner ss) (.exiting lbl ρ')) : (StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ')) ∨ (∃ ρ₁, StepStmtStar P EvalCmd extendEval inner (.terminal ρ₁) ∧ @@ -550,16 +570,21 @@ theorem seq_reaches_exiting | step_seq_exit => exact .inl (htgt ▸ hrest) /-- Invert a block execution reaching terminal: the inner either - terminated or exited (caught by the block). -/ + terminated or exited (caught by the block). In both cases the inner + reaches a config whose env projects to `ρ'` via the parent store. -/ theorem block_reaches_terminal - {inner : Config P CmdT} {l : Option String} {ρ' : Env P} - (hstar : StepStmtStar P EvalCmd extendEval (.block l inner) (.terminal ρ')) : - StepStmtStar P EvalCmd extendEval inner (.terminal ρ') ∨ - (∃ lbl, StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ')) := by + {inner : Config P CmdT} {l : Option String} {σ_parent : SemanticStore P} {ρ' : Env P} + (hstar : StepStmtStar P EvalCmd extendEval (.block l σ_parent inner) (.terminal ρ')) : + (∃ ρ_inner, StepStmtStar P EvalCmd extendEval inner (.terminal ρ_inner) ∧ + ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store }) ∨ + (∃ lbl ρ_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ_inner) ∧ + ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store }) := by suffices ∀ src tgt, StepStmtStar P EvalCmd extendEval src tgt → - ∀ inner ρ', src = .block l inner → tgt = .terminal ρ' → - StepStmtStar P EvalCmd extendEval inner (.terminal ρ') ∨ - (∃ lbl, StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ')) from + ∀ inner ρ', src = .block l σ_parent inner → tgt = .terminal ρ' → + (∃ ρ_inner, StepStmtStar P EvalCmd extendEval inner (.terminal ρ_inner) ∧ + ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store }) ∨ + (∃ lbl ρ_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ_inner) ∧ + ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store }) from this _ _ hstar _ _ rfl rfl intro src tgt hstar_g induction hstar_g with @@ -569,29 +594,30 @@ theorem block_reaches_terminal cases hstep with | step_block_body h => match ih _ _ rfl htgt with - | .inl hterm => exact .inl (.step _ _ _ h hterm) - | .inr ⟨lbl, hexit⟩ => exact .inr ⟨lbl, .step _ _ _ h hexit⟩ - | step_block_done => subst htgt; exact .inl hrest - | step_block_exit_none => + | .inl ⟨ρ_inner, hterm, heq⟩ => exact .inl ⟨ρ_inner, .step _ _ _ h hterm, heq⟩ + | .inr ⟨lbl, ρ_inner, hexit, heq⟩ => exact .inr ⟨lbl, ρ_inner, .step _ _ _ h hexit, heq⟩ + | step_block_done => subst htgt; cases hrest with - | refl => exact .inr ⟨.none, .refl _⟩ + | refl => exact .inl ⟨_, .refl _, rfl⟩ | step _ _ _ h _ => cases h | step_block_exit_match => subst htgt; cases hrest with - | refl => exact .inr ⟨.some _, .refl _⟩ + | refl => exact .inr ⟨_, _, .refl _, rfl⟩ | step _ _ _ h _ => cases h | step_block_exit_mismatch => subst htgt; cases hrest with | step _ _ _ h _ => cases h /-- Invert a block execution reaching exiting: the inner must have - exited with a label that didn't match the block. -/ + exited with a label that didn't match the block. The env is projected. -/ theorem block_reaches_exiting - {inner : Config P CmdT} {l : Option String} {lbl : Option String} {ρ' : Env P} - (hstar : StepStmtStar P EvalCmd extendEval (.block l inner) (.exiting lbl ρ')) : - ∃ lbl_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl_inner ρ') := by + {inner : Config P CmdT} {l : Option String} {σ_parent : SemanticStore P} {lbl : String} {ρ' : Env P} + (hstar : StepStmtStar P EvalCmd extendEval (.block l σ_parent inner) (.exiting lbl ρ')) : + ∃ lbl_inner ρ_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl_inner ρ_inner) ∧ + ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store } := by suffices ∀ src tgt, StepStmtStar P EvalCmd extendEval src tgt → - ∀ inner lbl ρ', src = .block l inner → tgt = .exiting lbl ρ' → - ∃ lbl_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl_inner ρ') from + ∀ inner lbl ρ', src = .block l σ_parent inner → tgt = .exiting lbl ρ' → + ∃ lbl_inner ρ_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl_inner ρ_inner) ∧ + ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store } from this _ _ hstar _ _ _ rfl rfl intro src tgt hstar_g induction hstar_g with @@ -600,19 +626,14 @@ theorem block_reaches_exiting intro inner lbl ρ' hsrc htgt; subst hsrc cases hstep with | step_block_body h => - have ⟨lbl_inner, hexit⟩ := ih _ _ _ rfl htgt - exact ⟨lbl_inner, .step _ _ _ h hexit⟩ - | step_block_done => - subst htgt; cases hrest with | step _ _ _ h _ => cases h - | step_block_exit_none => - subst htgt; cases hrest with | step _ _ _ h _ => cases h - | step_block_exit_match => - subst htgt; cases hrest with | step _ _ _ h _ => cases h + have ⟨lbl_inner, ρ_inner, hexit, heq⟩ := ih _ _ _ rfl htgt + exact ⟨lbl_inner, ρ_inner, .step _ _ _ h hexit, heq⟩ | step_block_exit_mismatch => - subst htgt - cases hrest with - | refl => exact ⟨_, .refl _⟩ + subst htgt; cases hrest with + | refl => exact ⟨_, _, .refl _, rfl⟩ | step _ _ _ h _ => cases h + | step_block_done | step_block_exit_match => + subst htgt; cases hrest with | step _ _ _ h _ => cases h /-! ## Trace construction helpers -/ @@ -621,7 +642,7 @@ theorem block_reaches_exiting theorem step_block_enter (l : String) (body : List (Stmt P CmdT)) (md : MetaData P) (ρ : Env P) : StepStmtStar P EvalCmd extendEval - (.stmt (.block l body md) ρ) (.block (.some l) (.stmts body ρ)) := + (.stmt (.block l body md) ρ) (.block (.some l) ρ.store (.stmts body ρ)) := .step _ _ _ .step_block (.refl _) /-- If a prefix of a statement list terminates, the full list steps @@ -686,7 +707,7 @@ private def ConfigSE : Config P CmdT → Config P CmdT → Prop | .stmts ss₁ ρ₁, .stmts ss₂ ρ₂ => ss₁ = ss₂ ∧ ρ₁.store = ρ₂.store ∧ ρ₁.eval = ρ₂.eval | .terminal ρ₁, .terminal ρ₂ => ρ₁.store = ρ₂.store ∧ ρ₁.eval = ρ₂.eval | .exiting l₁ ρ₁, .exiting l₂ ρ₂ => l₁ = l₂ ∧ ρ₁.store = ρ₂.store ∧ ρ₁.eval = ρ₂.eval - | .block l₁ i₁, .block l₂ i₂ => l₁ = l₂ ∧ ConfigSE i₁ i₂ + | .block l₁ σ₁ i₁, .block l₂ σ₂ i₂ => l₁ = l₂ ∧ σ₁ = σ₂ ∧ ConfigSE i₁ i₂ | .seq i₁ ss₁, .seq i₂ ss₂ => ss₁ = ss₂ ∧ ConfigSE i₁ i₂ | _, _ => False @@ -746,47 +767,46 @@ private def step_simulation | _ => exact nomatch heq | step_block_body h => cases c₂ with - | block _ i₂ => + | block _ _ i₂ => have hrs := heq.1; subst hrs - have ⟨c₂', h₂, heq₂⟩ := step_simulation _ _ _ h heq.2 - exact ⟨_, .step_block_body h₂, ⟨rfl, heq₂⟩⟩ + have hσ := heq.2.1; subst hσ + have ⟨c₂', h₂, heq₂⟩ := step_simulation _ _ _ h heq.2.2 + exact ⟨_, .step_block_body h₂, ⟨rfl, rfl, heq₂⟩⟩ | _ => exact nomatch heq | step_block_done => cases c₂ with - | block _ i₂ => + | block _ _ i₂ => have hrs := heq.1; subst hrs + have hσ := heq.2.1; subst hσ cases i₂ with - | terminal ρ₂ => exact ⟨_, .step_block_done, ⟨heq.2.1, heq.2.2⟩⟩ - | _ => exact nomatch heq.2 - | _ => exact nomatch heq - | step_block_exit_none => - cases c₂ with - | block _ i₂ => - cases i₂ with - | exiting l₂ ρ₂ => - have hl := heq.2.1; cases hl - exact ⟨_, .step_block_exit_none, ⟨heq.2.2.1, heq.2.2.2⟩⟩ - | _ => exact nomatch heq.2 + | terminal ρ₂ => + have hse := heq.2.2 + exact ⟨_, .step_block_done, ⟨congrArg (projectStore _) hse.1, hse.2⟩⟩ + | _ => exact nomatch heq.2.2 | _ => exact nomatch heq | step_block_exit_match hl => cases c₂ with - | block _ i₂ => + | block _ _ i₂ => have hlb := heq.1; subst hlb + have hσ := heq.2.1; subst hσ cases i₂ with | exiting l₂ ρ₂ => - have hl₂ := heq.2.1; subst hl₂ - exact ⟨_, .step_block_exit_match hl, ⟨heq.2.2.1, heq.2.2.2⟩⟩ - | _ => exact nomatch heq.2 + have hl₂ := heq.2.2.1; subst hl₂ + have hse := heq.2.2.2 + exact ⟨_, .step_block_exit_match hl, ⟨congrArg (projectStore _) hse.1, hse.2⟩⟩ + | _ => exact nomatch heq.2.2 | _ => exact nomatch heq | step_block_exit_mismatch hl => cases c₂ with - | block _ i₂ => + | block _ _ i₂ => have hlb := heq.1; subst hlb + have hσ := heq.2.1; subst hσ cases i₂ with | exiting l₂ ρ₂ => - have hl₂ := heq.2.1; subst hl₂ - exact ⟨_, .step_block_exit_mismatch hl, ⟨rfl, heq.2.2.1, heq.2.2.2⟩⟩ - | _ => exact nomatch heq.2 + have hl₂ := heq.2.2.1; subst hl₂ + have hse := heq.2.2.2 + exact ⟨_, .step_block_exit_mismatch hl, ⟨rfl, congrArg (projectStore _) hse.1, hse.2⟩⟩ + | _ => exact nomatch heq.2.2 | _ => exact nomatch heq /-- The terminal state's store and eval are independent of the starting @@ -817,9 +837,30 @@ theorem smallStep_hasFailure_irrel /-! ## Well-paired exits: preservation and no-escape -/ +omit [HasBool P] [HasNot P] in +/-- Helper: when the inner of a block reaches `.exiting l` and the + block's label (if some) doesn't match `l`, then `l` must be in the outer + labels list. The conclusion is `l ∈ labels`, which is exactly the + `Config.exitsCoveredByBlocks` of `.exiting l ρ''` for any ρ''. -/ +private theorem block_exit_mismatch_unfold {labels : List String} + {label : Option String} {σ_parent : SemanticStore P} {l : String} {ρ' ρ'' : Env P} + (h : Config.exitsCoveredByBlocks labels + (.block label σ_parent (.exiting l ρ' : Config P CmdT))) + (hne : label ≠ .some l) : + Config.exitsCoveredByBlocks labels (.exiting l ρ'' : Config P CmdT) := by + show l ∈ labels + cases label with + | none => exact h + | some lb => + have h' : l ∈ lb :: labels := h + rw [List.mem_cons] at h' + rcases h' with hh | hh + · exact absurd (by rw [hh]) hne + · exact hh + /-- A single step preserves `Config.exitsCoveredByBlocks`. -/ private theorem step_preserves_exitsCoveredByBlocks - (labels : List (Option String)) + (labels : List String) (c₁ c₂ : Config P CmdT) (hstep : StepStmt P EvalCmd extendEval c₁ c₂) (hwp : c₁.exitsCoveredByBlocks labels) : @@ -839,27 +880,21 @@ private theorem step_preserves_exitsCoveredByBlocks | step_ite_nondet_false => intro _ hwp; exact hwp.2 | step_loop_enter _ _ => intro labels hwp - -- Goal: (.block .none (.stmts (body ++ [.loop ...]) ρ')) covers labels - -- ↔ .stmts (body ++ [...]) covers (none :: labels). + -- Goal: .seq (.block .none ρ.store (.stmts body ρ')) [.loop ...] covers labels. + -- The .block .none label doesn't extend the labels list (Config.exitsCoveredByBlocks's + -- .block none case just descends). simp only [Config.exitsCoveredByBlocks, Stmt.exitsCoveredByBlocks] at hwp ⊢ - have hbody := (exitsCoveredByBlocks_weaken (P := P) (CmdT := CmdT) - labels (.none :: labels) (fun l hl => .tail _ hl)).2 _ hwp - exact block_exitsCoveredByBlocks_append (P := P) (CmdT := CmdT) (.none :: labels) _ _ - hbody ⟨hbody, True.intro⟩ + exact ⟨hwp, hwp, True.intro⟩ | step_loop_exit => intro _ _; trivial | step_loop_nondet_enter => intro labels hwp simp only [Config.exitsCoveredByBlocks, Stmt.exitsCoveredByBlocks] at hwp ⊢ - have hbody := (exitsCoveredByBlocks_weaken (P := P) (CmdT := CmdT) - labels (.none :: labels) (fun l hl => .tail _ hl)).2 _ hwp - exact block_exitsCoveredByBlocks_append (P := P) (CmdT := CmdT) (.none :: labels) _ _ - hbody ⟨hbody, True.intro⟩ + exact ⟨hwp, hwp, True.intro⟩ | step_loop_nondet_exit => intro _ _; trivial | step_exit => intro labels hwp - -- hwp is about .stmt (.exit lbl md) but goal is about .exiting lbl - -- Both pattern-match on the Option lbl; case split to reduce. - revert hwp; cases ‹Option String› <;> exact id + -- hwp : l ∈ labels (from .stmt (.exit l)), goal: .exiting (.some l) covers labels = l ∈ labels + exact hwp | step_funcDecl => intro _ _; trivial | step_typeDecl => intro _ _; trivial | step_stmts_nil => intro _ _; trivial @@ -867,14 +902,17 @@ private theorem step_preserves_exitsCoveredByBlocks | step_seq_inner _ ih => intro labels hwp; exact ⟨ih labels hwp.1, hwp.2⟩ | step_seq_done => intro _ hwp; exact hwp.2 | step_seq_exit => intro _ hwp; exact hwp.1 - | step_block_body _ ih => intro labels hwp; exact ih _ hwp + | step_block_body _ ih => + intro labels hwp + rename_i inner inner' label σ_parent _ + cases label with + | none => exact ih labels hwp + | some l => exact ih (l :: labels) hwp | step_block_done => intro _ _; trivial - | step_block_exit_none => intro _ _; trivial | step_block_exit_match => intro _ _; trivial | step_block_exit_mismatch hne => intro labels hwp - simp only [Config.exitsCoveredByBlocks, List.mem_cons] at hwp ⊢ - exact hwp.resolve_left (fun h => hne (h ▸ rfl)) + exact block_exit_mismatch_unfold (P := P) (CmdT := CmdT) hwp hne /-- Well-paired statements cannot escape via `.exiting`: if all exits in `s` are caught by enclosing blocks @@ -882,21 +920,17 @@ private theorem step_preserves_exitsCoveredByBlocks theorem exitsCoveredByBlocks_noEscape (s : Stmt P CmdT) (hwp : s.exitsCoveredByBlocks []) : - ∀ (ρ : Env P) (lbl : Option String) (ρ' : Env P), + ∀ (ρ : Env P) (lbl : String) (ρ' : Env P), ¬ StepStmtStar P EvalCmd extendEval (.stmt s ρ) (.exiting lbl ρ') := by intro ρ lbl ρ' hstar -- Prove Config.exitsCoveredByBlocks [] is preserved, then show .exiting contradicts it. suffices ∀ c₁ c₂, - c₁.exitsCoveredByBlocks ([] : List (Option String)) → + c₁.exitsCoveredByBlocks ([] : List String) → StepStmtStar P EvalCmd extendEval c₁ c₂ → - c₂.exitsCoveredByBlocks ([] : List (Option String)) by + c₂.exitsCoveredByBlocks ([] : List String) by have hwp' := this _ _ (show Config.exitsCoveredByBlocks [] (.stmt s ρ) from hwp) hstar - -- Config.exitsCoveredByBlocks [] (.exiting lbl ρ') requires: - -- lbl = none → [].length > 0 (False) - -- lbl = some l → l ∈ [] (False) - cases lbl with - | none => exact absurd hwp' (by simp [Config.exitsCoveredByBlocks]) - | some l => exact absurd hwp' (by simp [Config.exitsCoveredByBlocks]) + -- Config.exitsCoveredByBlocks [] (.exiting lbl ρ') requires lbl ∈ [] (False). + exact absurd hwp' (by simp [Config.exitsCoveredByBlocks]) intro c₁ c₂ hwp_c hstar_c induction hstar_c with | refl => exact hwp_c @@ -909,17 +943,15 @@ theorem exitsCoveredByBlocks_noEscape theorem block_exitsCoveredByBlocks_noEscape (bss : List (Stmt P CmdT)) (hwp : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks [] bss) : - ∀ (ρ : Env P) (lbl : Option String) (ρ' : Env P), + ∀ (ρ : Env P) (lbl : String) (ρ' : Env P), ¬ StepStmtStar P EvalCmd extendEval (.stmts bss ρ) (.exiting lbl ρ') := by intro ρ lbl ρ' hstar suffices ∀ c₁ c₂, - c₁.exitsCoveredByBlocks ([] : List (Option String)) → + c₁.exitsCoveredByBlocks ([] : List String) → StepStmtStar P EvalCmd extendEval c₁ c₂ → - c₂.exitsCoveredByBlocks ([] : List (Option String)) by + c₂.exitsCoveredByBlocks ([] : List String) by have hwp' := this _ _ (show Config.exitsCoveredByBlocks [] (.stmts bss ρ) from hwp) hstar - cases lbl with - | none => exact absurd hwp' (by simp [Config.exitsCoveredByBlocks]) - | some l => exact absurd hwp' (by simp [Config.exitsCoveredByBlocks]) + exact absurd hwp' (by simp [Config.exitsCoveredByBlocks]) intro c₁ c₂ hwp_c hstar_c induction hstar_c with | refl => exact hwp_c @@ -930,20 +962,20 @@ theorem block_exitsCoveredByBlocks_noEscape and `cfg` is neither terminal nor exiting, then `cfg = .block l inner'` for some `inner'` with `inner →* inner'`. -/ theorem block_star_extract_inner - {l : Option String} {inner cfg : Config P CmdT} - (h_star : StepStmtStar P EvalCmd extendEval (.block l inner) cfg) + {l : Option String} {σ_parent : SemanticStore P} {inner cfg : Config P CmdT} + (h_star : StepStmtStar P EvalCmd extendEval (.block l σ_parent inner) cfg) (h_no_exit : ∀ lbl ρ', ¬ StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ')) (h_not_terminal : ∀ ρ', cfg ≠ .terminal ρ') (h_not_exiting : ∀ lbl ρ', cfg ≠ .exiting lbl ρ') : - ∃ inner', cfg = .block l inner' ∧ + ∃ inner', cfg = .block l σ_parent inner' ∧ StepStmtStar P EvalCmd extendEval inner inner' := by suffices ∀ c₁ c₂, StepStmtStar P EvalCmd extendEval c₁ c₂ → - ∀ inner₀, c₁ = .block l inner₀ → + ∀ inner₀, c₁ = .block l σ_parent inner₀ → (∀ lbl ρ', ¬ StepStmtStar P EvalCmd extendEval inner₀ (.exiting lbl ρ')) → (∀ ρ', c₂ ≠ .terminal ρ') → (∀ lbl ρ', c₂ ≠ .exiting lbl ρ') → - ∃ inner', c₂ = .block l inner' ∧ + ∃ inner', c₂ = .block l σ_parent inner' ∧ StepStmtStar P EvalCmd extendEval inner₀ inner' from this _ _ h_star _ rfl h_no_exit h_not_terminal h_not_exiting intro c₁ c₂ h_star @@ -961,7 +993,6 @@ theorem block_star_extract_inner cases hrest with | refl => exact absurd rfl (h_nt _) | step _ _ _ h _ => exact nomatch h - | step_block_exit_none => exact absurd (.refl _) (h_ne _ _) | step_block_exit_match => exact absurd (.refl _) (h_ne _ _) | step_block_exit_mismatch => exact absurd (.refl _) (h_ne _ _) @@ -1003,38 +1034,20 @@ private theorem step_preserves_eval_noFuncDecl exact ⟨rfl, hnofd.2⟩ | step_loop_enter => intro hnofd - refine ⟨rfl, ?_⟩ - simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd ⊢ - -- Need: Block.noFuncDecl (body ++ [loop]) from Block.noFuncDecl body - have h_append : ∀ (ss₁ ss₂ : List (Stmt P CmdT)), - Block.noFuncDecl ss₁ = true → Block.noFuncDecl ss₂ = true → - Block.noFuncDecl (ss₁ ++ ss₂) = true := by - intro ss₁; induction ss₁ with - | nil => intro _ _ h; exact h - | cons s ss ih => - intro ss₂ h₁ h₂ - simp only [Block.noFuncDecl] at h₁ ⊢ - cases hs : Stmt.noFuncDecl s - · simp [hs] at h₁ - · simp_all [Block.noFuncDecl] - exact h_append _ _ hnofd (by simp [Block.noFuncDecl, Stmt.noFuncDecl, hnofd]) + refine ⟨rfl, ?_, ?_⟩ + · -- Goal: inner Config has noFuncDecl + simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd ⊢ + exact hnofd + · -- Goal: rest = [loop ...] has Block.noFuncDecl + simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd ⊢ + simp [Block.noFuncDecl, Stmt.noFuncDecl, hnofd] | step_loop_exit => intro _; exact ⟨rfl, trivial⟩ | step_loop_nondet_enter => intro hnofd - refine ⟨rfl, ?_⟩ - simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd ⊢ - have h_append : ∀ (ss₁ ss₂ : List (Stmt P CmdT)), - Block.noFuncDecl ss₁ = true → Block.noFuncDecl ss₂ = true → - Block.noFuncDecl (ss₁ ++ ss₂) = true := by - intro ss₁; induction ss₁ with - | nil => intro _ _ h; exact h - | cons s ss ih => - intro ss₂ h₁ h₂ - simp only [Block.noFuncDecl] at h₁ ⊢ - cases hs : Stmt.noFuncDecl s - · simp [hs] at h₁ - · simp_all [Block.noFuncDecl] - exact h_append _ _ hnofd (by simp [Block.noFuncDecl, Stmt.noFuncDecl, hnofd]) + refine ⟨rfl, ?_, ?_⟩ + · simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd ⊢; exact hnofd + · simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd ⊢ + simp [Block.noFuncDecl, Stmt.noFuncDecl, hnofd] | step_loop_nondet_exit => intro _; exact ⟨rfl, trivial⟩ | step_exit => intro _; exact ⟨rfl, trivial⟩ | step_funcDecl => @@ -1054,7 +1067,6 @@ private theorem step_preserves_eval_noFuncDecl | step_seq_exit => intro _; exact ⟨rfl, trivial⟩ | step_block_body _ ih => intro hnofd; exact ih hnofd | step_block_done => intro _; exact ⟨rfl, trivial⟩ - | step_block_exit_none => intro _; exact ⟨rfl, trivial⟩ | step_block_exit_match => intro _; exact ⟨rfl, trivial⟩ | step_block_exit_mismatch => intro _; exact ⟨rfl, trivial⟩ @@ -1134,7 +1146,7 @@ structure AssertId where aid.label = label ∧ aid.expr = expr | .stmt (.loop _ _ inv _ _) _, aid => (aid.label, aid.expr) ∈ inv | .stmts ((.loop _ _ inv _ _) :: _) _, aid => (aid.label, aid.expr) ∈ inv - | .block _ inner, aid => isAtAssert inner aid + | .block _ _ inner, aid => isAtAssert inner aid | .seq inner _, aid => isAtAssert inner aid | _, _ => False @@ -1175,7 +1187,7 @@ private theorem noMatchingAssert_not_isAtAssert intro hat exact hno.1.1 label expr hat rfl | .terminal _ | .exiting _ _ => simp [isAtAssert] - | .block _ inner => exact noMatchingAssert_not_isAtAssert inner label expr hno + | .block _ _ inner => exact noMatchingAssert_not_isAtAssert inner label expr hno | .seq inner _ => exact noMatchingAssert_not_isAtAssert inner label expr hno.1 omit [HasFvar P] [HasBool P] [HasNot P] in @@ -1204,16 +1216,14 @@ private def step_preserves_noMatchingAssert | step_ite_nondet_true => exact hno.1 | step_ite_nondet_false => exact hno.2 | step_loop_enter => + -- New shape: .seq (.block .none ρ.store (.stmts body ρ')) [loop] + -- noMatchingAssert: inner covers, AND [loop] covers. simp only [Config.noMatchingAssert, Stmt.noMatchingAssert] at hno ⊢ - apply stmts_noMatchingAssert_append - · exact hno.2 - · exact ⟨hno, True.intro⟩ + exact ⟨hno.2, hno, True.intro⟩ | step_loop_exit => trivial | step_loop_nondet_enter => simp only [Config.noMatchingAssert, Stmt.noMatchingAssert] at hno ⊢ - apply stmts_noMatchingAssert_append - · exact hno.2 - · exact ⟨hno, True.intro⟩ + exact ⟨hno.2, hno, True.intro⟩ | step_loop_nondet_exit => trivial | step_exit => trivial | step_funcDecl => trivial @@ -1230,7 +1240,6 @@ private def step_preserves_noMatchingAssert have := step_preserves_noMatchingAssert (c₁ := _) (c₂ := _) (label := _) h hno exact this | step_block_done => trivial - | step_block_exit_none => trivial | step_block_exit_match => trivial | step_block_exit_mismatch => trivial @@ -1261,13 +1270,13 @@ theorem noMatchingAssert_implies_no_reachable_assert then the config must be `.block label inner` where `inner` is reachable from the block's body and satisfies `isAtAssert`. -/ theorem block_isAtAssert_inner - (label : String) (inner₀ cfg : Config P (Cmd P)) (a : AssertId P) - (hstar : StepStmtStar P (EvalCmd P) extendEval (.block label inner₀) cfg) + (label : String) (σ_parent : SemanticStore P) (inner₀ cfg : Config P (Cmd P)) (a : AssertId P) + (hstar : StepStmtStar P (EvalCmd P) extendEval (.block label σ_parent inner₀) cfg) (hat : isAtAssert P cfg a) : - ∃ inner, cfg = .block label inner ∧ + ∃ inner, cfg = .block label σ_parent inner ∧ StepStmtStar P (EvalCmd P) extendEval inner₀ inner ∧ isAtAssert P inner a := by - generalize hsrc : Config.block label inner₀ = src at hstar + generalize hsrc : Config.block label σ_parent inner₀ = src at hstar induction hstar generalizing inner₀ with | refl => subst hsrc; exact ⟨inner₀, rfl, .refl _, hat⟩ | step _ mid _ hstep hrest ih => @@ -1278,9 +1287,6 @@ theorem block_isAtAssert_inner | step_block_done => cases hrest with | refl => exact absurd hat (by simp [isAtAssert]) | step _ _ _ h _ => exact absurd h (by intro h; cases h) - | step_block_exit_none => cases hrest with - | refl => exact absurd hat (by simp [isAtAssert]) - | step _ _ _ h _ => exact absurd h (by intro h; cases h) | step_block_exit_match => cases hrest with | refl => exact absurd hat (by simp [isAtAssert]) | step _ _ _ h _ => exact absurd h (by intro h; cases h) @@ -1412,8 +1418,8 @@ theorem step_preserves_noFailure IsAtAssert (.stmt (.loop g m inv body md) ρ) ⟨lbl, e⟩) (h_IsAtAssert_seq : ∀ {inner ss a}, IsAtAssert inner a → IsAtAssert (.seq inner ss) a) - (h_IsAtAssert_block : ∀ {label inner a}, - IsAtAssert inner a → IsAtAssert (.block label inner) a) + (h_IsAtAssert_block : ∀ {label σ_parent inner a}, + IsAtAssert inner a → IsAtAssert (.block label σ_parent inner) a) (c₁ c₂ : Config P CmdT) (hv : ∀ a cfg, StepStmtStar P EvalCmd extendEval c₁ cfg → IsAtAssert cfg a → cfg.getEval cfg.getStore a.expr = some HasBool.tt) @@ -1448,7 +1454,7 @@ theorem step_preserves_noFailure | step_block_body h ih => exact ih (fun a cfg hr hat => - hv a (.block _ cfg) (block_inner_star P EvalCmd extendEval _ _ _ hr) (h_IsAtAssert_block hat)) hnf + hv a (.block _ _ cfg) (block_inner_star P EvalCmd extendEval _ _ _ _ hr) (h_IsAtAssert_block hat)) hnf | _ => intros; exact hnf theorem allAssertsValid_preserves_noFailure diff --git a/Strata/Languages/Boole/Verify.lean b/Strata/Languages/Boole/Verify.lean index d219d96c50..8e21563365 100644 --- a/Strata/Languages/Boole/Verify.lean +++ b/Strata/Languages/Boole/Verify.lean @@ -540,8 +540,6 @@ def toCoreStmt (s : BooleDDM.Statement SourceRange) : TranslateM Core.Statement return .block l (← withBVars [] (toCoreBlock b)) (← toCoreMetaData m) | .exit_statement m ⟨_, l⟩ => return .exit l (← toCoreMetaData m) - | .exit_unlabeled_statement m => - return .exit none (← toCoreMetaData m) | .typeDecl_statement m ⟨_, n⟩ ⟨_, args?⟩ => let params := match args? with | none => [] diff --git a/Strata/Languages/Core/DDMTransform/FormatCore.lean b/Strata/Languages/Core/DDMTransform/FormatCore.lean index 639c5f355f..0af86ae9b8 100644 --- a/Strata/Languages/Core/DDMTransform/FormatCore.lean +++ b/Strata/Languages/Core/DDMTransform/FormatCore.lean @@ -828,12 +828,8 @@ partial def stmtToCST {M} [Inhabited M] (s : Core.Statement) | .nondet => pure (.while_statement default (.condNondet default) measureCST invs bodyCST) | .exit label _md => do - match label with - | some l => - let labelAnn : Ann String M := ⟨default, l⟩ - pure (.exit_statement default labelAnn) - | none => - pure (.exit_unlabeled_statement default) + let labelAnn : Ann String M := ⟨default, label⟩ + pure (.exit_statement default labelAnn) | .funcDecl decl _md => funcDeclToStatement decl | .typeDecl tc _md => let nameAnn : Ann String M := ⟨default, tc.name⟩ diff --git a/Strata/Languages/Core/DDMTransform/Grammar.lean b/Strata/Languages/Core/DDMTransform/Grammar.lean index fe27348ebc..206b72e7d5 100644 --- a/Strata/Languages/Core/DDMTransform/Grammar.lean +++ b/Strata/Languages/Core/DDMTransform/Grammar.lean @@ -289,7 +289,6 @@ op call_statement (f : Ident, args : CommaSepBy CallArg) : Statement => op block (c : NewlineSepBy Statement) : Block => "{\n " indent(2, c) "\n}"; op block_statement (label : Ident, b : Block) : Statement => label ": " b:0; op exit_statement (label : Ident) : Statement => "exit " label ";"; -op exit_unlabeled_statement : Statement => "exit;"; category SpecElt; category Free; diff --git a/Strata/Languages/Core/DDMTransform/Translate.lean b/Strata/Languages/Core/DDMTransform/Translate.lean index 7461355762..9e6ed5a8f8 100644 --- a/Strata/Languages/Core/DDMTransform/Translate.lean +++ b/Strata/Languages/Core/DDMTransform/Translate.lean @@ -1335,10 +1335,7 @@ partial def translateStmt (p : Program) (bindings : TransBindings) (arg : Arg) : | q`Core.exit_statement, #[la] => let l ← translateIdent String la let md ← getOpMetaData op - return ([.exit (some l) md], bindings) - | q`Core.exit_unlabeled_statement, #[] => - let md ← getOpMetaData op - return ([.exit none md], bindings) + return ([.exit l md], bindings) | q`Core.funcDecl_statement, #[namea, _typeArgsa, bindingsa, returna, precondsa, bodya, _inlinea] => let name ← translateIdent Core.CoreIdent namea let inputs ← translateMonoDeclList bindings bindingsa diff --git a/Strata/Languages/Core/Procedure.lean b/Strata/Languages/Core/Procedure.lean index 154711b3c4..90b00cce92 100644 --- a/Strata/Languages/Core/Procedure.lean +++ b/Strata/Languages/Core/Procedure.lean @@ -351,7 +351,7 @@ instance : HasVarsProcTrans Expression Procedure where modifiedVarsTrans := Procedure.modifiedVarsTrans getVarsTrans := Procedure.getVarsTrans definedVarsTrans := λ _ _ ↦ [] -- procedures cannot define global variables - touchedVarsTrans := Procedure.modifiedVarsTrans + modifiedOrDefinedVarsTrans := Procedure.modifiedVarsTrans allVarsTrans := λ π p ↦ Procedure.getVarsTrans π p ++ Procedure.modifiedVarsTrans π p @@ -360,14 +360,14 @@ instance : HasVarsTrans Expression Statement Procedure where modifiedVarsTrans := Statement.modifiedVarsTrans getVarsTrans := Statement.getVarsTrans definedVarsTrans := Statement.definedVarsTrans - touchedVarsTrans := Statement.touchedVarsTrans + modifiedOrDefinedVarsTrans := Statement.modifiedOrDefinedVarsTrans allVarsTrans := Statement.allVarsTrans instance : HasVarsTrans Expression (List Statement) Procedure where modifiedVarsTrans := Statements.modifiedVarsTrans getVarsTrans := Statements.getVarsTrans definedVarsTrans := Statements.definedVarsTrans - touchedVarsTrans := Statements.touchedVarsTrans + modifiedOrDefinedVarsTrans := Statements.modifiedOrDefinedVarsTrans allVarsTrans := Statements.allVarsTrans end diff --git a/Strata/Languages/Core/Statement.lean b/Strata/Languages/Core/Statement.lean index 31a0dc97e4..d221db67d6 100644 --- a/Strata/Languages/Core/Statement.lean +++ b/Strata/Languages/Core/Statement.lean @@ -215,24 +215,24 @@ def Command.modifiedVars (c : Command) : List Expression.Ident := | .cmd c => c.modifiedVars | .call _ args _ => CallArg.getLhs args -def Command.touchedVars (c : Command) : List Expression.Ident := +def Command.modifiedOrDefinedVars (c : Command) : List Expression.Ident := Command.definedVars c ++ Command.modifiedVars c instance : HasVarsImp Expression Command where definedVars := Command.definedVars modifiedVars := Command.modifiedVars - touchedVars := Command.touchedVars + modifiedOrDefinedVars := Command.modifiedOrDefinedVars instance : HasVarsImp Expression Statement where definedVars := Stmt.definedVars modifiedVars := Stmt.modifiedVars - touchedVars := Stmt.touchedVars + modifiedOrDefinedVars := Stmt.modifiedOrDefinedVars instance : HasVarsImp Expression (List Statement) where definedVars := Block.definedVars modifiedVars := Block.modifiedVars -- order matters for Havoc, so needs to override the default - touchedVars := Block.touchedVars + modifiedOrDefinedVars := Block.modifiedOrDefinedVars --------------------------------------------------------------------- @@ -339,8 +339,8 @@ def Statements.definedVarsTrans Block.definedVars s mutual -/-- get all variables touched by the statement `s`. -/ -def Statement.touchedVarsTrans +/-- get all variables modified or defined by the statement `s` (write-set, transitive). -/ +def Statement.modifiedOrDefinedVarsTrans {ProcType : Type} [HasVarsProcTrans Expression ProcType] (π : String → Option ProcType) (s : Statement) @@ -348,26 +348,26 @@ def Statement.touchedVarsTrans match s with | .cmd cmd => Command.definedVarsTrans π cmd ++ Command.modifiedVarsTrans π cmd | .exit _ _ => [] - | .block _ bss _ => Statements.touchedVarsTrans π bss - | .ite _ tbss ebss _ => Statements.touchedVarsTrans π tbss ++ Statements.touchedVarsTrans π ebss - | .loop _ _ _ bss _ => Statements.touchedVarsTrans π bss + | .block _ bss _ => Statements.modifiedOrDefinedVarsTrans π bss + | .ite _ tbss ebss _ => Statements.modifiedOrDefinedVarsTrans π tbss ++ Statements.modifiedOrDefinedVarsTrans π ebss + | .loop _ _ _ bss _ => Statements.modifiedOrDefinedVarsTrans π bss | .funcDecl decl _ => [decl.name] -- Function declaration touches (defines) the function name | .typeDecl _ _ => [] -- Type declarations don't touch variables -def Statements.touchedVarsTrans +def Statements.modifiedOrDefinedVarsTrans {ProcType : Type} [HasVarsProcTrans Expression ProcType] (π : String → Option ProcType) (ss : Statements) : List Expression.Ident := match ss with | [] => [] - | s :: srest => Statement.touchedVarsTrans π s ++ Statements.touchedVarsTrans π srest + | s :: srest => Statement.modifiedOrDefinedVarsTrans π s ++ Statements.modifiedOrDefinedVarsTrans π srest end def Statement.allVarsTrans [HasVarsProcTrans Expression ProcType] (π : String → Option ProcType) (s : Statement) := - Statement.getVarsTrans π s ++ Statement.touchedVarsTrans π s + Statement.getVarsTrans π s ++ Statement.modifiedOrDefinedVarsTrans π s def Statements.allVarsTrans [HasVarsProcTrans Expression ProcType] diff --git a/Strata/Languages/Core/StatementSemantics.lean b/Strata/Languages/Core/StatementSemantics.lean index 513a72a11f..233cffd42d 100644 --- a/Strata/Languages/Core/StatementSemantics.lean +++ b/Strata/Languages/Core/StatementSemantics.lean @@ -375,7 +375,7 @@ def withOldBindings aid.label = label ∧ aid.expr = expr | .stmt (.loop _ _ inv _ _) _, aid => (aid.label, aid.expr) ∈ inv | .stmts ((.loop _ _ inv _ _) :: _) _, aid => (aid.label, aid.expr) ∈ inv - | .block _ inner, aid => coreIsAtAssert inner aid + | .block _ _ inner, aid => coreIsAtAssert inner aid | .seq inner _, aid => coreIsAtAssert inner aid | _, _ => False @@ -390,6 +390,13 @@ def withOldBindings structure WFEvalExtension (φ : CoreEval → Imperative.PureFunc Expression → CoreEval) : Prop where preserves_wfBool : ∀ δ σ decl, Imperative.WellFormedSemanticEvalBool δ → Imperative.WellFormedSemanticEvalBool (EvalPureFunc φ δ σ decl) + preserves_wfVar : ∀ δ σ decl, Imperative.WellFormedSemanticEvalVar δ → + Imperative.WellFormedSemanticEvalVar (EvalPureFunc φ δ σ decl) + preserves_wfCong : ∀ δ σ decl, WellFormedCoreEvalCong δ → + WellFormedCoreEvalCong (EvalPureFunc φ δ σ decl) + preserves_wfExprCongr : ∀ δ σ decl, + @Imperative.WellFormedSemanticEvalExprCongr Expression _ δ → + @Imperative.WellFormedSemanticEvalExprCongr Expression _ (EvalPureFunc φ δ σ decl) --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/StatementSemanticsProps.lean b/Strata/Languages/Core/StatementSemanticsProps.lean index c0d6e51ed2..273ad23d60 100644 --- a/Strata/Languages/Core/StatementSemanticsProps.lean +++ b/Strata/Languages/Core/StatementSemanticsProps.lean @@ -1762,9 +1762,9 @@ theorem EvalCmdDefMonotone' : theorem EvalCmdTouch [HasVal P] [HasFvar P] [HasBool P] [HasBoolVal P] [HasNot P] : EvalCmd P δ σ c σ' f → - TouchVars σ (HasVarsImp.touchedVars c) σ' := by + TouchVars σ (HasVarsImp.modifiedOrDefinedVars c) σ' := by intro Heval - induction Heval <;> simp [HasVarsImp.touchedVars, Cmd.definedVars, Cmd.modifiedVars] + induction Heval <;> simp [HasVarsImp.modifiedOrDefinedVars, Cmd.definedVars, Cmd.modifiedVars] case eval_init x' δ σ x v σ' σ₀ e Hsm Hup Hwf => apply TouchVars.init_some Hup constructor @@ -2211,10 +2211,10 @@ theorem CoreStepStar_rec CoreStepStar π φ c₂ c₃ → motive c₂ c₃ → motive c₁ c₃) {c₁ c₂ : CoreConfig} (h : CoreStepStar π φ c₁ c₂) : motive c₁ c₂ := by - suffices ∀ c₁ c₂, + suffices h_gen : ∀ c₁ c₂, Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) c₁ c₂ → motive c₁ c₂ by - exact this _ _ (CoreStepStar_to_StepStmtStar h) + exact h_gen _ _ (CoreStepStar_to_StepStmtStar h) intro c₁ c₂ h' induction h' with | refl => exact h_refl _ @@ -2249,11 +2249,11 @@ theorem core_seq_inner_star theorem core_block_inner_star {π : String → Option Procedure} {φ : CoreEval → PureFunc Expression → CoreEval} - (inner inner' : CoreConfig) (label : Option String) + (inner inner' : CoreConfig) (label : Option String) (σ_parent : SemanticStore Expression) (h : CoreStepStar π φ inner inner') : - CoreStepStar π φ (.block label inner) (.block label inner') := + CoreStepStar π φ (.block label σ_parent inner) (.block label σ_parent inner') := StepStmtStar_to_CoreStepStar - (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) inner inner' label + (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) inner inner' label σ_parent (CoreStepStar_to_StepStmtStar h)) /-- Lift `seq_reaches_terminal` from `StepStmtStar` to `CoreStepStar`. -/ @@ -2282,33 +2282,13 @@ theorem core_step_preserves_wfBool (hstep : CoreStep π φ c₁ c₂) : WellFormedSemanticEvalBool c₂.getEnv.eval := by induction hstep with - | step_cmd hcmd => - cases hcmd with - | cmd_sem _ => simp [Config.getEnv]; exact hwf - | @call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ => - simp only [Config.getEnv]; exact hwf + | step_cmd hcmd => cases hcmd with + | cmd_sem _ | call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ => + simp [Config.getEnv]; exact hwf | step_block => simp [Config.getEnv]; exact hwf - | step_ite_true _ _ => exact hwf - | step_ite_false _ _ => exact hwf - | step_loop_enter _ _ => exact hwf - | step_loop_exit _ _ => exact hwf - | step_ite_nondet_true => exact hwf - | step_ite_nondet_false => exact hwf - | step_loop_nondet_enter => exact hwf - | step_loop_nondet_exit => exact hwf - | step_exit => exact hwf | step_funcDecl => simp [Config.getEnv]; exact h_wf_ext.preserves_wfBool _ _ _ hwf - | step_typeDecl => exact hwf - | step_stmts_nil => exact hwf - | step_stmts_cons => exact hwf - | step_seq_inner _ ih => exact ih hwf - | step_seq_done => exact hwf - | step_seq_exit => exact hwf - | step_block_body _ ih => exact ih hwf - | step_block_done => exact hwf - | step_block_exit_none => exact hwf - | step_block_exit_match _ => exact hwf - | step_block_exit_mismatch _ => exact hwf + | step_seq_inner _ ih | step_block_body _ ih => exact ih hwf + | _ => exact hwf theorem core_wfBool_preserved (h_wf_ext : WFEvalExtension φ) @@ -2316,16 +2296,134 @@ theorem core_wfBool_preserved (hwf₀ : WellFormedSemanticEvalBool c₁.getEnv.eval) (hstar : CoreStepStar π φ c₁ c₂) : WellFormedSemanticEvalBool c₂.getEnv.eval := by - suffices ∀ c₁ c₂, WellFormedSemanticEvalBool c₁.getEnv.eval → + suffices h_gen : ∀ c₁ c₂, WellFormedSemanticEvalBool c₁.getEnv.eval → Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) c₁ c₂ → WellFormedSemanticEvalBool c₂.getEnv.eval from - this c₁ c₂ hwf₀ (CoreStepStar_to_StepStmtStar hstar) + h_gen c₁ c₂ hwf₀ (CoreStepStar_to_StepStmtStar hstar) intro c₁ c₂ hwf₀ h induction h with | refl => exact hwf₀ | step _ _ _ hstep _ ih => exact ih (core_step_preserves_wfBool π φ h_wf_ext _ _ hwf₀ hstep) +theorem core_step_preserves_wfVar + (h_wf_ext : WFEvalExtension φ) + (c₁ c₂ : CoreConfig) + (hwf : WellFormedSemanticEvalVar c₁.getEnv.eval) + (hstep : CoreStep π φ c₁ c₂) : + WellFormedSemanticEvalVar c₂.getEnv.eval := by + induction hstep with + | step_cmd hcmd => cases hcmd with + | cmd_sem _ | call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ => + simp [Config.getEnv]; exact hwf + | step_block => simp [Config.getEnv]; exact hwf + | step_funcDecl => simp [Config.getEnv]; exact h_wf_ext.preserves_wfVar _ _ _ hwf + | step_seq_inner _ ih | step_block_body _ ih => exact ih hwf + | _ => exact hwf + +theorem core_wfVar_preserved + (h_wf_ext : WFEvalExtension φ) + (c₁ c₂ : CoreConfig) + (hwf₀ : WellFormedSemanticEvalVar c₁.getEnv.eval) + (hstar : CoreStepStar π φ c₁ c₂) : + WellFormedSemanticEvalVar c₂.getEnv.eval := by + suffices h_gen : ∀ c₁ c₂, WellFormedSemanticEvalVar c₁.getEnv.eval → + Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) c₁ c₂ → + WellFormedSemanticEvalVar c₂.getEnv.eval from + h_gen c₁ c₂ hwf₀ (CoreStepStar_to_StepStmtStar hstar) + intro c₁ c₂ hwf₀ h + induction h with + | refl => exact hwf₀ + | step _ _ _ hstep _ ih => + exact ih (core_step_preserves_wfVar π φ h_wf_ext _ _ hwf₀ hstep) + +theorem core_step_preserves_wfCong + (h_wf_ext : WFEvalExtension φ) + (c₁ c₂ : CoreConfig) + (hwf : WellFormedCoreEvalCong c₁.getEnv.eval) + (hstep : CoreStep π φ c₁ c₂) : + WellFormedCoreEvalCong c₂.getEnv.eval := by + induction hstep with + | step_cmd hcmd => cases hcmd with + | cmd_sem _ | call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ => + simp [Config.getEnv]; exact hwf + | step_block => simp [Config.getEnv]; exact hwf + | step_funcDecl => simp [Config.getEnv]; exact h_wf_ext.preserves_wfCong _ _ _ hwf + | step_seq_inner _ ih | step_block_body _ ih => exact ih hwf + | _ => exact hwf + +theorem core_wfCong_preserved + (h_wf_ext : WFEvalExtension φ) + (c₁ c₂ : CoreConfig) + (hwf₀ : WellFormedCoreEvalCong c₁.getEnv.eval) + (hstar : CoreStepStar π φ c₁ c₂) : + WellFormedCoreEvalCong c₂.getEnv.eval := by + suffices h_gen : ∀ c₁ c₂, WellFormedCoreEvalCong c₁.getEnv.eval → + Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) c₁ c₂ → + WellFormedCoreEvalCong c₂.getEnv.eval from + h_gen c₁ c₂ hwf₀ (CoreStepStar_to_StepStmtStar hstar) + intro c₁ c₂ hwf₀ h + induction h with + | refl => exact hwf₀ + | step _ _ _ hstep _ ih => + exact ih (core_step_preserves_wfCong π φ h_wf_ext _ _ hwf₀ hstep) + +theorem core_step_preserves_wfExprCongr + (h_wf_ext : WFEvalExtension φ) + (c₁ c₂ : CoreConfig) + (hwf : @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₁.getEnv.eval) + (hstep : CoreStep π φ c₁ c₂) : + @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₂.getEnv.eval := by + induction hstep with + | step_cmd hcmd => cases hcmd with + | cmd_sem _ | call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ => + simp [Config.getEnv]; exact hwf + | step_block => simp [Config.getEnv]; exact hwf + | step_funcDecl => simp [Config.getEnv]; exact h_wf_ext.preserves_wfExprCongr _ _ _ hwf + | step_seq_inner _ ih | step_block_body _ ih => exact ih hwf + | _ => exact hwf + +theorem core_wfExprCongr_preserved + (h_wf_ext : WFEvalExtension φ) + (c₁ c₂ : CoreConfig) + (hwf₀ : @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₁.getEnv.eval) + (hstar : CoreStepStar π φ c₁ c₂) : + @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₂.getEnv.eval := by + suffices h_gen : ∀ c₁ c₂, + @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₁.getEnv.eval → + Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) c₁ c₂ → + @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₂.getEnv.eval from + h_gen c₁ c₂ hwf₀ (CoreStepStar_to_StepStmtStar hstar) + intro c₁ c₂ hwf₀ h + induction h with + | refl => exact hwf₀ + | step _ _ _ hstep _ ih => + exact ih (core_step_preserves_wfExprCongr π φ h_wf_ext _ _ hwf₀ hstep) + +/-! ## projectStore and expression evaluation -/ + +/-- If an expression evaluates in the projected store, it evaluates identically + in the full store. The projected store only removes variables, and expression + evaluation depends only on the variables it references. -/ +theorem eval_projectStore_to_full + {δ : CoreEval} {σ₀ σ : SemanticStore Expression} + {e : Expression.Expr} {v : Expression.Expr} + (h_eval : δ (projectStore σ₀ σ) e = some v) + (h_wfVar : WellFormedSemanticEvalVar δ) + (h_wfCong : WellFormedCoreEvalCong δ) + (h_wfExprCongr : WellFormedSemanticEvalExprCongr δ) : + δ σ e = some v := by + have h_def := EvalExpressionIsDefined h_wfCong h_wfVar + (show (δ (projectStore σ₀ σ) e).isSome from by rw [h_eval]; simp) + have h_agree : ∀ x ∈ HasVarsPure.getVars e, (projectStore σ₀ σ) x = σ x := by + intro x hx + have h_x_def : (projectStore σ₀ σ x).isSome = true := h_def x hx + simp only [projectStore] at h_x_def ⊢ + split + · rfl + · next h_neg => simp [h_neg] at h_x_def + rw [← h_wfExprCongr e (projectStore σ₀ σ) σ h_agree]; exact h_eval + /-! ## Assert-only blocks preserve store -/ theorem stmts_allAssert_preserves_store @@ -2348,12 +2446,12 @@ theorem stmts_allAssert_preserves_store | step_stmts_cons => have ⟨ρ₁, h_s, h_r⟩ := core_seq_reaches_terminal h_rest have h_store₁ : ρ₁.store = ρ.store := by - suffices ∀ (c₁ c₂ : CoreConfig), + suffices h_gen : ∀ (c₁ c₂ : CoreConfig), CoreStepStar π φ c₁ c₂ → c₁ = .stmt (Statement.assert l e md) ρ → c₂ = .terminal ρ₁ → ρ₁.store = ρ.store by - exact this _ _ h_s rfl rfl + exact h_gen _ _ h_s rfl rfl intro c₁ c₂ hstar heq₁ heq₂ subst heq₁ cases hstar with @@ -2391,8 +2489,8 @@ private theorem coreIsAtAssert_seq_of_inner (h : coreIsAtAssert inner a) : coreIsAtAssert (.seq inner ss) a := h private theorem coreIsAtAssert_block_of_inner - {label} {inner : CoreConfig} {a} - (h : coreIsAtAssert inner a) : coreIsAtAssert (.block label inner) a := h + {label} {σ_parent} {inner : CoreConfig} {a} + (h : coreIsAtAssert inner a) : coreIsAtAssert (.block label σ_parent inner) a := h private theorem evalCommand_failure_implies_assert_ff {π : String → Option Procedure} {φ : CoreEval → PureFunc Expression → CoreEval} @@ -2415,7 +2513,7 @@ theorem core_noFailure_preserved (hf₀ : c₁.getEnv.hasFailure = Bool.false) (hstar : CoreStepStar π φ c₁ c₂) : c₂.getEnv.hasFailure = Bool.false := by - suffices ∀ c₁ c₂, + suffices h_gen : ∀ c₁ c₂, (∀ (a : AssertId Expression) (cfg : CoreConfig), CoreStepStar π φ c₁ cfg → coreIsAtAssert cfg a → @@ -2423,7 +2521,7 @@ theorem core_noFailure_preserved c₁.getEnv.hasFailure = Bool.false → Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) c₁ c₂ → c₂.getEnv.hasFailure = Bool.false from - this c₁ c₂ hvalid hf₀ (CoreStepStar_to_StepStmtStar hstar) + h_gen c₁ c₂ hvalid hf₀ (CoreStepStar_to_StepStmtStar hstar) intro c₁ c₂ hvalid hf₀ h induction h with | refl => exact hf₀ diff --git a/Strata/Languages/Core/StatementType.lean b/Strata/Languages/Core/StatementType.lean index 3f631bab46..979b6ad95b 100644 --- a/Strata/Languages/Core/StatementType.lean +++ b/Strata/Languages/Core/StatementType.lean @@ -181,20 +181,13 @@ where -- Add source location to error messages. .error (errorWithSourceLoc e md) - | .exit label md => do try + | .exit l md => do try match op with | .some _ => - match label with - | .none => - if labels.isEmpty then - .error <| md.toDiagnosticF f!"{s}: exit occurs outside any block." - else - .ok (s, Env, C) - | .some l => - if labels.contains l then - .ok (s, Env, C) - else - .error <| md.toDiagnosticF f!"{s}: exit label \"{l}\" does not match any enclosing block." + if labels.contains l then + .ok (s, Env, C) + else + .error <| md.toDiagnosticF f!"{s}: exit label \"{l}\" does not match any enclosing block." | .none => .error <| md.toDiagnosticF f!"{s} occurs outside a procedure." catch e => -- Add source location to error messages. diff --git a/Strata/Languages/Core/WF.lean b/Strata/Languages/Core/WF.lean index 85fc2f110f..0b5f655441 100644 --- a/Strata/Languages/Core/WF.lean +++ b/Strata/Languages/Core/WF.lean @@ -69,7 +69,7 @@ structure WFifProp (Cmd : Type) (p : Program) (cond : ExprOrNondet Expression structure WFloopProp (Cmd : Type) (p : Program) (guard : ExprOrNondet Expression) (measure : Option Expression.Expr) (invariant : List (String × Expression.Expr)) (b : Block) : Prop where -structure WFexitProp (p : Program) (label : Option String) : Prop where +structure WFexitProp (p : Program) (label : String) : Prop where /-- Well-formedness for local function declarations. Checks that function parameter names are unique. @@ -94,7 +94,7 @@ def WFStatementProp (p : Program) (stmt : Statement) : Prop := match stmt with | .loop (guard : ExprOrNondet Expression) (measure : Option Expression.Expr) (invariant : List (String × Expression.Expr)) (body : Block) _ => WFloopProp (CmdExt Expression) p guard measure invariant body - | .exit (label : Option String) _ => WFexitProp p label + | .exit (label : String) _ => WFexitProp p label | .funcDecl decl _ => WFfuncDeclProp p decl | .typeDecl _ _ => True -- Type declarations are always well-formed diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index 1a9c78e081..66f57af768 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -492,11 +492,11 @@ def translateStmt (stmt : StmtExprMd) | .Return valueOpt => match valueOpt with | none => - return [.exit (some "$body") md] + return [.exit "$body" md] | some _ => emitDiagnostic $ md.toDiagnostic "Return statement with value should have been eliminated by EliminateValueReturns pass" DiagnosticType.StrataBug modify fun s => { s with coreProgramHasSuperfluousErrors := true } - return [.exit (some "$body") md] + return [.exit "$body" md] | .While cond invariants decreasesExpr body => let condExpr ← translateExpr cond let invExprs ← invariants.mapM (fun i => do return ("", ← translateExpr i)) @@ -504,7 +504,7 @@ def translateStmt (stmt : StmtExprMd) let bodyStmts ← translateStmt body return [Imperative.Stmt.loop (.det condExpr) decreasingExprCore invExprs bodyStmts md] | .Exit target => - return [Imperative.Stmt.exit (some target) md] + return [Imperative.Stmt.exit target md] | .Hole _ _ => -- Hole in statement position: treat as havoc (no-op). -- This can occur when an unmodeled call's Block is flattened. diff --git a/Strata/Languages/Python/PythonToCore.lean b/Strata/Languages/Python/PythonToCore.lean index cceb2c563e..4a77ea4c35 100644 --- a/Strata/Languages/Python/PythonToCore.lean +++ b/Strata/Languages/Python/PythonToCore.lean @@ -318,7 +318,7 @@ def noneOrExpr (translation_ctx : TranslationContext) (fname n : String) (e: Cor def handleCallThrow (jmp_target : String) : Core.Statement := let cond := .app () (.op () "ExceptOrNone..isExceptOrNone_mk_code" none) (.fvar () "maybe_except" none) - .ite (.det cond) [.exit (some jmp_target) .empty] [] .empty + .ite (.det cond) [.exit jmp_target .empty] [] .empty def deduplicateTypeAnnotations (l : List (String × Option String)) : List (String × String) := Id.run do let mut m : Map String String := [] @@ -623,7 +623,7 @@ partial def exceptHandlersToCore (jmp_targets: List String) (translation_ctx: Tr | .none => [.set "exception_ty_matches" (.boolConst () false) md] let cond := .fvar () "exception_ty_matches" none - let body_if_matches := body.val.toList.flatMap (λ s => (PyStmtToCore jmp_targets.tail! translation_ctx s).fst) ++ [.exit (some jmp_targets[1]!) md] + let body_if_matches := body.val.toList.flatMap (λ s => (PyStmtToCore jmp_targets.tail! translation_ctx s).fst) ++ [.exit jmp_targets[1]! md] set_ex_ty_matches ++ [.ite (.det cond) body_if_matches [] md] partial def handleFunctionCall (lhs: List Core.Expression.Ident) @@ -723,8 +723,8 @@ partial def PyStmtToCore (jmp_targets: List String) (translation_ctx : Translati ([.ite (.det (PyExprToCore guard_ctx test).expr) (ArrPyStmtToCore translation_ctx then_b.val).fst (ArrPyStmtToCore translation_ctx else_b.val).fst md], none) | .Return _ v => match v.val with - | .some v => ([.set "ret" (PyExprToCore translation_ctx v).expr md, .exit (some jmp_targets[0]!) md], none) -- TODO: need to thread return value name here. For now, assume "ret" - | .none => ([.exit (some jmp_targets[0]!) md], none) + | .some v => ([.set "ret" (PyExprToCore translation_ctx v).expr md, .exit jmp_targets[0]! md], none) -- TODO: need to thread return value name here. For now, assume "ret" + | .none => ([.exit jmp_targets[0]! md], none) | .For _ tgt itr body _ _ => -- Do one unrolling: let guard := .app () (Core.coreOpExpr (.bool .Not)) (.eq () (.app () (.op () "dict_str_any_length" none) (PyExprToCore default itr).expr) (.intConst () 0)) diff --git a/Strata/Transform/CallElimCorrect.lean b/Strata/Transform/CallElimCorrect.lean index 2166049b8a..5b7c165ca7 100644 --- a/Strata/Transform/CallElimCorrect.lean +++ b/Strata/Transform/CallElimCorrect.lean @@ -3461,7 +3461,7 @@ theorem callElimStatementCorrect [LawfulBEq Expression.Expr] : simp [Imperative.isDefinedOver, Imperative.HasVarsTrans.allVarsTrans, Statement.allVarsTrans, - Statement.touchedVarsTrans, + Statement.modifiedOrDefinedVarsTrans, Command.definedVarsTrans, Command.definedVars, Command.modifiedVarsTrans, diff --git a/Strata/Transform/CoreSpecification.lean b/Strata/Transform/CoreSpecification.lean index 2b5e4fa475..aef7675338 100644 --- a/Strata/Transform/CoreSpecification.lean +++ b/Strata/Transform/CoreSpecification.lean @@ -60,6 +60,8 @@ open Core Imperative structure ProcEnvWF (proc : Procedure) (ρ : Env Expression) : Prop where wfVar : WellFormedSemanticEvalVar ρ.eval wfBool : WellFormedSemanticEvalBool ρ.eval + wfCong : WellFormedCoreEvalCong ρ.eval + wfExprCongr : WellFormedSemanticEvalExprCongr ρ.eval storeDefined : ∀ id ∈ procVerifyInitIdents proc, (ρ.store id).isSome -- When a procedure is called, the value of "old g" must be equal to "g" -- for in-out parameters. diff --git a/Strata/Transform/DetToKleene.lean b/Strata/Transform/DetToKleene.lean index 0a021535c9..a4d59777e8 100644 --- a/Strata/Transform/DetToKleene.lean +++ b/Strata/Transform/DetToKleene.lean @@ -27,7 +27,7 @@ def StmtToKleeneStmt {P : PureExpr} [Imperative.HasBool P] [HasNot P] Option (Imperative.KleeneStmt P (Cmd P)) := match st with | .cmd cmd => some (.cmd cmd) - | .block _ bss _ => BlockToKleeneStmt bss + | .block _ bss _ => do let b ← BlockToKleeneStmt bss; return .block b | .ite cond tss ess md => do let t ← BlockToKleeneStmt tss let e ← BlockToKleeneStmt ess diff --git a/Strata/Transform/DetToKleeneCorrect.lean b/Strata/Transform/DetToKleeneCorrect.lean index fac861335a..a28684733d 100644 --- a/Strata/Transform/DetToKleeneCorrect.lean +++ b/Strata/Transform/DetToKleeneCorrect.lean @@ -38,6 +38,7 @@ abbrev Lang.det (extendEval : ExtendEval P) : Lang P := def isAtKleeneAssert : KleeneConfig P (Cmd P) → AssertId P → Prop | .stmt (.cmd (.assert label expr _)) _, a => a.label = label ∧ a.expr = expr | .seq inner _, a => isAtKleeneAssert inner a + | .block _ inner, a => isAtKleeneAssert inner a | _, _ => False abbrev Lang.kleene : Lang P where @@ -137,15 +138,19 @@ private theorem block_transform_some omit [HasFvar P] [HasVal P] [HasBoolVal P] in private theorem stmtToKleene_some_exitsCovered - (labels : List (Option String)) + (labels : List String) (st : Stmt P (Cmd P)) (ns : KleeneStmt P (Cmd P)) (ht : StmtToKleeneStmt st = some ns) : Stmt.exitsCoveredByBlocks (P := P) (CmdT := Cmd P) labels st := by match st with | .cmd _ => simp [Stmt.exitsCoveredByBlocks] | .block l bss _ => - simp [Stmt.exitsCoveredByBlocks]; rw [StmtToKleeneStmt.eq_2] at ht - exact blockHelper (l :: labels) bss ns ht + simp [StmtToKleeneStmt] at ht + match hb : BlockToKleeneStmt bss, ht with + | some b, ht => + simp at ht; subst ht + simp [Stmt.exitsCoveredByBlocks] + exact blockHelper (l :: labels) bss b hb | .ite cond tss ess md => match cond with | .det _ => @@ -170,7 +175,7 @@ private theorem stmtToKleene_some_exitsCovered | .exit _ _ => simp [StmtToKleeneStmt.eq_6] at ht | .funcDecl _ _ => simp [StmtToKleeneStmt.eq_7] at ht where - blockHelper (labels : List (Option String)) (bss : List (Stmt P (Cmd P))) (ns : KleeneStmt P (Cmd P)) + blockHelper (labels : List String) (bss : List (Stmt P (Cmd P))) (ns : KleeneStmt P (Cmd P)) (ht : BlockToKleeneStmt bss = some ns) : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks (P := P) (CmdT := Cmd P) labels bss := by match bss with @@ -190,8 +195,12 @@ private theorem stmtToKleene_some_noFuncDecl match st with | .cmd _ => simp [Stmt.noFuncDecl] | .block _ bss _ => - simp [Stmt.noFuncDecl]; rw [StmtToKleeneStmt.eq_2] at ht - exact blockHelper bss ns ht + simp [StmtToKleeneStmt] at ht + match hb : BlockToKleeneStmt bss, ht with + | some b, ht => + simp at ht; subst ht + simp [Stmt.noFuncDecl] + exact blockHelper bss b hb | .ite cond tss ess md => match cond with | .det _ => @@ -263,42 +272,31 @@ omit [HasVal P] [HasBoolVal P] in exit: the inner reaches terminal with a strictly shorter derivation. -/ private theorem blockT_reaches_terminal_noExit (extendEval : ExtendEval P) - {inner : Config P (Cmd P)} {l : Option String} {ρ' : Env P} - (hstar : ReflTransT (StepStmt P (EvalCmd P) extendEval) (.block l inner) (.terminal ρ')) + {inner : Config P (Cmd P)} {l : Option String} {σ_parent : SemanticStore P} {ρ' : Env P} + (hstar : ReflTransT (StepStmt P (EvalCmd P) extendEval) (.block l σ_parent inner) (.terminal ρ')) (h_no_exit : ∀ lbl ρ_x, ¬ StepStmtStar P (EvalCmd P) extendEval inner (.exiting lbl ρ_x)) : - ∃ (h : ReflTransT (StepStmt P (EvalCmd P) extendEval) inner (.terminal ρ')), + ∃ (ρ_inner : Env P) (h : ReflTransT (StepStmt P (EvalCmd P) extendEval) inner (.terminal ρ_inner)), + ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store } ∧ h.len < hstar.len := by - suffices ∀ src tgt (hstar_g : ReflTransT (StepStmt P (EvalCmd P) extendEval) src tgt), - ∀ inner ρ', src = .block l inner → tgt = .terminal ρ' → - (∀ lbl ρ_x, - ¬ StepStmtStar P (EvalCmd P) extendEval inner (.exiting lbl ρ_x)) → - ∃ (h : ReflTransT (StepStmt P (EvalCmd P) extendEval) inner (.terminal ρ')), - h.len < hstar_g.len from - this _ _ hstar _ _ rfl rfl h_no_exit - intro src tgt hstar_g - induction hstar_g with - | refl => intro _ _ hsrc htgt _; subst hsrc; cases htgt - | step _ mid _ hstep hrest ih => - intro inner ρ' hsrc htgt h_ne; subst hsrc - cases hstep with - | step_block_body h => - have h_ne' : ∀ lbl ρ_x, ¬ StepStmtStar P (EvalCmd P) extendEval _ (.exiting lbl ρ_x) := - fun lbl ρ_x hx => h_ne lbl ρ_x (.step _ _ _ h hx) - have ⟨h_inner, hlen⟩ := ih _ _ rfl htgt h_ne' - exact ⟨.step _ _ _ h h_inner, by simp [ReflTransT.len]; omega⟩ - | step_block_done => - subst htgt - exact ⟨hrest, by simp [ReflTransT.len]⟩ - | step_block_exit_none => - subst htgt - exact absurd (.refl _) (h_ne _ _) - | step_block_exit_match => - subst htgt - exact absurd (.refl _) (h_ne _ _) - | step_block_exit_mismatch => - subst htgt - cases hrest with | step _ _ _ h _ => cases h + match hstar with + | .step _ (.block _ _ inner₁) _ (.step_block_body h) hrest => + have h_no_exit' : ∀ lbl ρ_x, + ¬ StepStmtStar P (EvalCmd P) extendEval inner₁ (.exiting lbl ρ_x) := by + intro lbl ρ_x hinner₁ + exact h_no_exit lbl ρ_x (.step _ _ _ h hinner₁) + have ⟨ρ_inner, hterm, heq, hlen⟩ := blockT_reaches_terminal_noExit extendEval hrest h_no_exit' + exact ⟨ρ_inner, .step _ _ _ h hterm, heq, by simp [ReflTransT.len]; omega⟩ + | .step _ _ _ .step_block_done hrest => + match hrest with + | .refl _ => exact ⟨_, .refl _, rfl, by simp [ReflTransT.len]⟩ + | .step _ _ _ h _ => exact nomatch h + | .step _ _ _ (.step_block_exit_match _) hrest => + exfalso + exact h_no_exit _ _ (.refl _) + | .step _ _ _ (.step_block_exit_mismatch _) hrest => + match hrest with + | .step _ _ _ h _ => exact nomatch h omit [HasVal P] [HasBoolVal P] in private theorem stmtsT_append_terminal @@ -367,7 +365,7 @@ private def loop_sim (hlen : hstarT.len ≤ n) : StepKleeneStar P (EvalCmd P) (.stmt (.loop (.seq (.cmd (.assume "guard" g md)) b)) ρ₀) (.terminal ρ') := by - induction n generalizing ρ₀ with + induction n generalizing ρ₀ ρ' with | zero => -- hstarT of length 0 = refl, impossible since src ≠ tgt. match hstarT, hlen with @@ -390,46 +388,69 @@ private def loop_sim subst h_no let ρ₀' : Env P := {ρ₀ with hasFailure := ρ₀.hasFailure || false} have hρ₀_eq : ρ₀' = ρ₀ := by simp [ρ₀', Bool.or_false] - -- hrest is (.block .none (.stmts (body ++ [loop]) ρ₀')) →*T .terminal ρ'. - -- Unwrap the block layer. The inner config cannot reach .exiting since - -- `hcov` ensures body has no escaping exits, and the trailing `[loop]` - -- also cannot exit. - have h_noescape_body : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks - (P := P) (CmdT := Cmd P) ([] : List (Option String)) (body ++ [.loop (.det g) m [] body md]) := - block_exitsCoveredByBlocks_append (P := P) (CmdT := Cmd P) [] body _ hcov - ⟨hcov, True.intro⟩ - have h_ne : ∀ lbl ρ_x, - ¬ StepStmtStar P (EvalCmd P) extendEval - (.stmts (body ++ [.loop (.det g) m [] body md]) ρ₀') (.exiting lbl ρ_x) := - block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval - (body ++ [.loop (.det g) m [] body md]) h_noescape_body ρ₀' - have ⟨hrest', hlen_inner⟩ := - blockT_reaches_terminal_noExit extendEval hrest h_ne - have ⟨ρ₁, hbody, hloop_stmtT, hlen_dec⟩ := - stmtsT_append_terminal extendEval body (.loop (.det g) m [] body md) ρ₀' ρ' hrest' hcov - -- Convert hbody from (...ρ₀') to (...ρ₀) via hρ₀_eq. - have hbody' : StepStmtStar P (EvalCmd P) extendEval (.stmts body ρ₀) (.terminal ρ₁) := - hρ₀_eq ▸ hbody - have kleene_body := sim_body ρ₀ ρ₁ hwfb hwfv hbody' - have heval_eq : ρ₁.eval = ρ₀.eval := - smallStep_noFuncDecl_preserves_eval_block P (EvalCmd P) extendEval - body ρ₀ ρ₁ hnofd_body hbody' - have hwfv₁ : WellFormedSemanticEvalVal ρ₁.eval := heval_eq ▸ hwfv - have h_assume := kleene_assume_terminal (P := P) (label := "guard") (md := md) hg hwfb - have h_iter : StepKleeneStar P (EvalCmd P) - (.stmt (.seq (.cmd (.assume "guard" g md)) b) ρ₀) (.terminal ρ₁) := - kleene_seq_terminal _ b ρ₀ ρ₀ ρ₁ h_assume kleene_body - have hloop_len : hloop_stmtT.len ≤ n := by - simp [ReflTransT.len] at hlen - have := hlen_dec - have := hlen_inner - omega - have kleene_loop := ih ρ₁ hwfv₁ hloop_stmtT hloop_len - exact .step _ _ _ .step_loop_step - (ReflTrans_Transitive _ _ _ _ - (kleene_seq_inner_star _ _ - (.loop (.seq (.cmd (.assume "guard" g md)) b)) h_iter) - (.step _ _ _ .step_seq_done kleene_loop)) + -- New shape: hrest : .seq (.block .none ρ₀'.store (.stmts body ρ₀')) [loop] →*T .terminal ρ'. + -- Step 1: Split via seqT_reaches_terminal: + have ⟨ρ_block, h_block_term, h_loop_stmts, hlen_seq⟩ := + seqT_reaches_terminal extendEval hrest + -- Step 2: Unwrap the block. Body cannot exit (by hcov). + have h_noescape_body : ∀ lbl ρ_x, + ¬ StepStmtStar P (EvalCmd P) extendEval (.stmts body ρ₀') (.exiting lbl ρ_x) := + block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval body hcov ρ₀' + have ⟨ρ_inner, h_inner_term, heq_ρ_block, hlen_inner⟩ := + blockT_reaches_terminal_noExit extendEval h_block_term h_noescape_body + -- Step 3: Decompose [loop] ρ_block via stmtsT_cons_terminal. + have ⟨ρ_x, h_loop_T_T, h_nil, hlen_cons⟩ := + stmtsT_cons_terminal extendEval h_loop_stmts + -- h_nil is .stmts [] ρ_x →*T .terminal ρ' — must be step_stmts_nil + refl. + have hρ_x_eq : ρ_x = ρ' := by + match h_nil with + | .step _ _ _ .step_stmts_nil hr2 => + match hr2 with + | .refl _ => rfl + | .step _ _ _ h _ => exact nomatch h + subst hρ_x_eq + -- Now: h_inner_term : .stmts body ρ₀' →*T .terminal ρ_inner + -- heq_ρ_block : ρ_block = { ρ_inner with store := projectStore ρ₀'.store ρ_inner.store } + -- h_loop_T_T : .stmt (.loop ...) ρ_block →*T .terminal ρ' + have h_assume : StepKleeneStar P (EvalCmd P) + (.stmt (.cmd (.assume "guard" g md)) ρ₀) (.terminal ρ₀) := + kleene_assume_terminal hg hwfb + have hterm_body_eq : StepStmtStar P (EvalCmd P) extendEval (.stmts body ρ₀) (.terminal ρ_inner) := + hρ₀_eq ▸ reflTransT_to_prop h_inner_term + have h_sim_body : StepKleeneStar P (EvalCmd P) (.stmt b ρ₀) (.terminal ρ_inner) := + sim_body ρ₀ ρ_inner hwfb hwfv hterm_body_eq + have h_kleene_assume_b : StepKleeneStar P (EvalCmd P) + (.stmt (.seq (.cmd (.assume "guard" g md)) b) ρ₀) (.terminal ρ_inner) := + kleene_seq_terminal _ b ρ₀ ρ₀ ρ_inner h_assume h_sim_body + have hwfv_inner : WellFormedSemanticEvalVal ρ_inner.eval := by + have := block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval body ρ₀ ρ_inner hnofd_body hterm_body_eq + rw [this]; exact hwfv + have hwfv_block : WellFormedSemanticEvalVal ρ_block.eval := by + rw [heq_ρ_block]; exact hwfv_inner + have h_kleene_loop : StepKleeneStar P (EvalCmd P) + (.stmt (.loop (.seq (.cmd (.assume "guard" g md)) b)) ρ_block) (.terminal _) := + ih ρ_block _ hwfv_block h_loop_T_T (by simp [ReflTransT.len] at hlen; omega) + -- Build Kleene execution: step_loop_step → .seq (.block ρ₀.store (.stmt (assume; b) ρ₀)) (.loop ...) + -- Then use seq+block to reach (.terminal ρ_block) via h_kleene_assume_b + project. + have heq_ρ_block_full : ρ_block = + { ρ_inner with store := projectStore ρ₀.store ρ_inner.store } := by + have : ρ₀'.store = ρ₀.store := by rw [hρ₀_eq] + rw [heq_ρ_block, this] + have h_block_to_ρ_block : StepKleeneStar P (EvalCmd P) + (.block ρ₀.store (.stmt (.seq (.cmd (.assume "guard" g md)) b) ρ₀)) + (.terminal ρ_block) := by + rw [heq_ρ_block_full] + exact kleene_block_terminal ρ₀.store _ ρ_inner h_kleene_assume_b + have h_seq_to_ρ' : StepKleeneStar P (EvalCmd P) + (.seq (.block ρ₀.store (.stmt (.seq (.cmd (.assume "guard" g md)) b) ρ₀)) + (.loop (.seq (.cmd (.assume "guard" g md)) b))) + (.terminal _) := + ReflTrans_Transitive _ _ _ _ + (ReflTrans_Transitive _ _ _ _ + (kleene_seq_inner_star _ _ (.loop _) h_block_to_ρ_block) + (.step _ _ _ .step_seq_done (.refl _))) + h_kleene_loop + exact .step _ _ _ .step_loop_step h_seq_to_ρ' /-- Kleene loop simulation: the loop body is executed zero or more times non-deterministically. -/ @@ -452,7 +473,7 @@ private def loop_sim_kleene (hlen : hstarT.len ≤ n) : StepKleeneStar P (EvalCmd P) (.stmt (.loop b) ρ₀) (.terminal ρ') := by - induction n generalizing ρ₀ with + induction n generalizing ρ₀ ρ' with | zero => match hstarT, hlen with | .step _ _ _ _ _, hlen => simp [ReflTransT.len] at hlen @@ -474,38 +495,58 @@ private def loop_sim_kleene subst h_no let ρ₀' : Env P := {ρ₀ with hasFailure := ρ₀.hasFailure || false} have hρ₀_eq : ρ₀' = ρ₀ := by simp [ρ₀', Bool.or_false] - -- Unwrap the .block .none wrapper; see loop_sim for details. - have h_noescape_body : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks - (P := P) (CmdT := Cmd P) ([] : List (Option String)) (body ++ [.loop .nondet m [] body md]) := - block_exitsCoveredByBlocks_append (P := P) (CmdT := Cmd P) [] body _ hcov - ⟨hcov, True.intro⟩ - have h_ne : ∀ lbl ρ_x, - ¬ StepStmtStar P (EvalCmd P) extendEval - (.stmts (body ++ [.loop .nondet m [] body md]) ρ₀') (.exiting lbl ρ_x) := - block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval - (body ++ [.loop .nondet m [] body md]) h_noescape_body ρ₀' - have ⟨hrest', hlen_inner⟩ := - blockT_reaches_terminal_noExit extendEval hrest h_ne - have ⟨ρ₁, hbody, hloop_stmtT, hlen_dec⟩ := - stmtsT_append_terminal extendEval body (.loop .nondet m [] body md) ρ₀' ρ' hrest' hcov - have hbody' : StepStmtStar P (EvalCmd P) extendEval (.stmts body ρ₀) (.terminal ρ₁) := - hρ₀_eq ▸ hbody - have kleene_body := sim_body ρ₀ ρ₁ hwfb hwfv hbody' - have heval_eq : ρ₁.eval = ρ₀.eval := - smallStep_noFuncDecl_preserves_eval_block P (EvalCmd P) extendEval - body ρ₀ ρ₁ hnofd_body hbody' - have hwfb₁ : WellFormedSemanticEvalBool ρ₁.eval := heval_eq ▸ hwfb - have hwfv₁ : WellFormedSemanticEvalVal ρ₁.eval := heval_eq ▸ hwfv - have hloop_len : hloop_stmtT.len ≤ n := by - simp [ReflTransT.len] at hlen - have := hlen_dec - have := hlen_inner - omega - have kleene_loop := ih ρ₁ hwfb₁ hwfv₁ hloop_stmtT hloop_len - exact .step _ _ _ .step_loop_step - (ReflTrans_Transitive _ _ _ _ - (kleene_seq_inner_star _ _ (.loop b) kleene_body) - (.step _ _ _ .step_seq_done kleene_loop)) + -- New shape: hrest : .seq (.block .none ρ₀'.store (.stmts body ρ₀')) [loop] →*T .terminal ρ' + have ⟨ρ_block, h_block_term, h_loop_stmts, hlen_seq⟩ := + seqT_reaches_terminal extendEval hrest + have h_noescape_body : ∀ lbl ρ_x, + ¬ StepStmtStar P (EvalCmd P) extendEval (.stmts body ρ₀') (.exiting lbl ρ_x) := + block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval body hcov ρ₀' + have ⟨ρ_inner, h_inner_term, heq_ρ_block, hlen_inner⟩ := + blockT_reaches_terminal_noExit extendEval h_block_term h_noescape_body + have ⟨ρ_x, h_loop_T_T, h_nil, hlen_cons⟩ := + stmtsT_cons_terminal extendEval h_loop_stmts + have hρ_x_eq : ρ_x = ρ' := by + match h_nil with + | .step _ _ _ .step_stmts_nil hr2 => + match hr2 with + | .refl _ => rfl + | .step _ _ _ h _ => exact nomatch h + subst hρ_x_eq + have hterm_body_eq : StepStmtStar P (EvalCmd P) extendEval (.stmts body ρ₀) (.terminal ρ_inner) := + hρ₀_eq ▸ reflTransT_to_prop h_inner_term + have h_sim_body : StepKleeneStar P (EvalCmd P) (.stmt b ρ₀) (.terminal ρ_inner) := + sim_body ρ₀ ρ_inner hwfb hwfv hterm_body_eq + have hwfv_inner : WellFormedSemanticEvalVal ρ_inner.eval := by + have := block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval body ρ₀ ρ_inner hnofd_body hterm_body_eq + rw [this]; exact hwfv + have hwfb_inner : WellFormedSemanticEvalBool ρ_inner.eval := by + have := block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval body ρ₀ ρ_inner hnofd_body hterm_body_eq + rw [this]; exact hwfb + have hwfv_block : WellFormedSemanticEvalVal ρ_block.eval := by + rw [heq_ρ_block]; exact hwfv_inner + have hwfb_block : WellFormedSemanticEvalBool ρ_block.eval := by + rw [heq_ρ_block]; exact hwfb_inner + have h_kleene_loop : StepKleeneStar P (EvalCmd P) + (.stmt (.loop b) ρ_block) (.terminal _) := + ih ρ_block _ hwfb_block hwfv_block h_loop_T_T (by simp [ReflTransT.len] at hlen; omega) + have heq_ρ_block_full : ρ_block = + { ρ_inner with store := projectStore ρ₀.store ρ_inner.store } := by + have : ρ₀'.store = ρ₀.store := by rw [hρ₀_eq] + rw [heq_ρ_block, this] + have h_block_to_ρ_block : StepKleeneStar P (EvalCmd P) + (.block ρ₀.store (.stmt b ρ₀)) + (.terminal ρ_block) := by + rw [heq_ρ_block_full] + exact kleene_block_terminal ρ₀.store _ ρ_inner h_sim_body + have h_seq_to_ρ' : StepKleeneStar P (EvalCmd P) + (.seq (.block ρ₀.store (.stmt b ρ₀)) (.loop b)) + (.terminal _) := + ReflTrans_Transitive _ _ _ _ + (ReflTrans_Transitive _ _ _ _ + (kleene_seq_inner_star _ _ (.loop _) h_block_to_ρ_block) + (.step _ _ _ .step_seq_done (.refl _))) + h_kleene_loop + exact .step _ _ _ .step_loop_step h_seq_to_ρ' /-! ## Core simulation by strong induction on statement/block size -/ @@ -561,18 +602,24 @@ private theorem simulation | step _ _ _ h _ => exact nomatch h | .block _l bss _md => - rw [StmtToKleeneStmt.eq_2] at ht - cases hstar with - | step _ _ _ h1 r1 => cases h1 with - | step_block => - match block_reaches_terminal P (EvalCmd P) extendEval r1 with - | .inl hterm => - have : Block.sizeOf bss ≤ n := by - simp_all [Stmt.sizeOf]; omega - exact ih.2 bss ns this ht ρ₀ ρ' hwfb hwfv hterm - | .inr ⟨lbl, hexit⟩ => - exact absurd hexit (block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval bss - (stmtToKleene_some_exitsCovered.blockHelper [] bss ns ht) ρ₀ lbl ρ') + simp [StmtToKleeneStmt] at ht + match hb : BlockToKleeneStmt bss, ht with + | some b, ht => + simp at ht; subst ht + cases hstar with + | step _ _ _ h1 r1 => cases h1 with + | step_block => + match block_reaches_terminal P (EvalCmd P) extendEval r1 with + | .inl ⟨ρ_inner, hterm, heq_ρ'⟩ => + have hsz_bss : Block.sizeOf bss ≤ n := by + simp_all [Stmt.sizeOf]; omega + subst heq_ρ' + exact .step _ _ _ .step_block + (kleene_block_terminal ρ₀.store _ ρ_inner + (ih.2 bss b hsz_bss hb ρ₀ ρ_inner hwfb hwfv hterm)) + | .inr ⟨lbl, ρ_inner, hexit, _⟩ => + exact absurd hexit (block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval bss + (stmtToKleene_some_exitsCovered.blockHelper [] bss b hb) ρ₀ lbl ρ_inner) | .ite cond tss ess md => match cond with diff --git a/Strata/Transform/ProcBodyVerifyCorrect.lean b/Strata/Transform/ProcBodyVerifyCorrect.lean index cf64ee7633..515f44dee2 100644 --- a/Strata/Transform/ProcBodyVerifyCorrect.lean +++ b/Strata/Transform/ProcBodyVerifyCorrect.lean @@ -25,7 +25,7 @@ open Core Core.ProcBodyVerify Imperative Lambda Transform Core.WF private theorem coreIsAtAssert_not_terminal (ρ : Env Expression) (a : AssertId Expression) : ¬ coreIsAtAssert (.terminal ρ) a := by simp [coreIsAtAssert] -private theorem coreIsAtAssert_not_exiting (lbl : Option String) (ρ : Env Expression) (a : AssertId Expression) : +private theorem coreIsAtAssert_not_exiting (lbl : String) (ρ : Env Expression) (a : AssertId Expression) : ¬ coreIsAtAssert (.exiting lbl ρ) a := by simp [coreIsAtAssert] /-! ## Input Environment Reconstruction, from the prefix statements of ProcBodyVerify @@ -660,14 +660,14 @@ theorem procBodyVerify_procedureCorrect ∃ ρ_init, StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) (.stmt verifyStmt ρ_init) - (.block verifyLabel (.seq (.block bodyLabel cfg) postAsserts)) := by + (.block (.some verifyLabel) ρ_init.store (.seq (.block (.some bodyLabel) ρ₀.store cfg) postAsserts)) := by intro ρ₀ h_wf cfg h_body obtain ⟨ρ_init, h_prefix⟩ := h_prefix_trace ρ₀ h_wf exact ⟨ρ_init, by rw [h_eq] exact ReflTrans_Transitive _ _ _ _ (step_block_enter Expression (EvalCommand π φ) (EvalPureFunc φ) verifyLabel _ #[] ρ_init) - (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ verifyLabel + (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some verifyLabel) ρ_init.store (ReflTrans_Transitive _ _ _ _ (by rw [List.append_assoc] exact stmts_prefix_terminal_append Expression (EvalCommand π φ) (EvalPureFunc φ) @@ -677,27 +677,27 @@ theorem procBodyVerify_procedureCorrect (seq_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ postAsserts (ReflTrans_Transitive _ _ _ _ (step_block_enter Expression (EvalCommand π φ) (EvalPureFunc φ) bodyLabel _ #[] ρ₀) - (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ bodyLabel + (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some bodyLabel) ρ₀.store (CoreStepStar_to_StepStmtStar h_body)))))))⟩ /- Helper: coreIsAtAssert and getEval/getStore are preserved through the verifyStmt wrapping (block > seq > block). -/ - have h_wrapped_assert : ∀ (cfg : CoreConfig) (a : AssertId Expression), + have h_wrapped_assert : ∀ (σ_v σ_b : SemanticStore Expression) (cfg : CoreConfig) (a : AssertId Expression), coreIsAtAssert cfg a → - coreIsAtAssert (.block verifyLabel (.seq (.block bodyLabel cfg) postAsserts)) a := by - intro cfg a h + coreIsAtAssert (.block (.some verifyLabel) σ_v (.seq (.block (.some bodyLabel) σ_b cfg) postAsserts)) a := by + intro σ_v σ_b cfg a h simp only [coreIsAtAssert] exact h - have h_wrapped_eval : ∀ (cfg : CoreConfig), - Config.getEval (.block verifyLabel (.seq (.block bodyLabel cfg) postAsserts)) = + have h_wrapped_eval : ∀ (σ_v σ_b : SemanticStore Expression) (cfg : CoreConfig), + Config.getEval (.block (.some verifyLabel) σ_v (.seq (.block (.some bodyLabel) σ_b cfg) postAsserts)) = Config.getEval cfg := by - intro cfg; simp [Config.getEval, Config.getEnv] + intro σ_v σ_b cfg; simp [Config.getEval, Config.getEnv] - have h_wrapped_store : ∀ (cfg : CoreConfig), - Config.getStore (.block verifyLabel (.seq (.block bodyLabel cfg) postAsserts)) = + have h_wrapped_store : ∀ (σ_v σ_b : SemanticStore Expression) (cfg : CoreConfig), + Config.getStore (.block (.some verifyLabel) σ_v (.seq (.block (.some bodyLabel) σ_b cfg) postAsserts)) = Config.getStore cfg := by - intro cfg; simp [Config.getStore, Config.getEnv] + intro σ_v σ_b cfg; simp [Config.getStore, Config.getEnv] -- Unfold h_correct for easier application have h_correct' : ∀ (a : AssertId Expression) (ρ_init : Env Expression) @@ -716,10 +716,10 @@ theorem procBodyVerify_procedureCorrect coreIsAtAssert cfg a → cfg.getEval cfg.getStore a.expr = some HasBool.tt := by intro ρ₀ h_wf a cfg h_body h_assert - obtain ⟨_, h_vt⟩ := h_embed_body ρ₀ h_wf cfg h_body - have h_v := h_correct' a _ - (.block verifyLabel (.seq (.block bodyLabel cfg) postAsserts)) - h_vt (h_wrapped_assert cfg a h_assert) + obtain ⟨ρ_init, h_vt⟩ := h_embed_body ρ₀ h_wf cfg h_body + have h_v := h_correct' a ρ_init + (.block (.some verifyLabel) ρ_init.store (.seq (.block (.some bodyLabel) ρ₀.store cfg) postAsserts)) + h_vt (h_wrapped_assert ρ_init.store ρ₀.store cfg a h_assert) rw [h_wrapped_eval, h_wrapped_store] at h_v exact h_v @@ -733,9 +733,9 @@ theorem procBodyVerify_procedureCorrect (h_body : StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) (.stmt (Stmt.block "" proc.body #[]) ρ₀) cfg) (h_assert : coreIsAtAssert cfg a) - -- Extract first step: .stmt (block "" body #[]) ρ₀ → .block "" (.stmts body ρ₀) + -- Extract first step: .stmt (block "" body #[]) ρ₀ → .block (.some "") ρ₀.store (.stmts body ρ₀) have h_block_star : StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) - (.block "" (.stmts proc.body ρ₀)) cfg := by + (.block (.some "") ρ₀.store (.stmts proc.body ρ₀)) cfg := by cases h_body with | refl => simp [coreIsAtAssert] at h_assert | step _ _ _ hstep hrest => cases hstep; exact hrest @@ -778,12 +778,16 @@ theorem procBodyVerify_procedureCorrect Core.core_wfBool_preserved π φ h_wf_ext (.stmts proc.body ρ₀) (.terminal ρ') h_wf.wfBool h_term + -- After the body block terminates via step_block_done, the store is projected. + -- We define the projected env. + let ρ_proj : Env Expression := { ρ' with store := projectStore ρ₀.store ρ'.store } + have h_to_post : StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) - (.stmt verifyStmt ρ_init) (.block verifyLabel (.stmts postAsserts ρ')) := by + (.stmt verifyStmt ρ_init) (.block (.some verifyLabel) ρ_init.store (.stmts postAsserts ρ_proj)) := by rw [h_eq] exact ReflTrans_Transitive _ _ _ _ (step_block_enter Expression (EvalCommand π φ) (EvalPureFunc φ) verifyLabel _ #[] ρ_init) - (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ verifyLabel + (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some verifyLabel) ρ_init.store (ReflTrans_Transitive _ _ _ _ (by rw [List.append_assoc] exact stmts_prefix_terminal_append Expression (EvalCommand π φ) (EvalPureFunc φ) @@ -794,21 +798,38 @@ theorem procBodyVerify_procedureCorrect (seq_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ postAsserts (ReflTrans_Transitive _ _ _ _ (step_block_enter Expression (EvalCommand π φ) (EvalPureFunc φ) bodyLabel _ #[] ρ₀) - (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ bodyLabel + (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some bodyLabel) ρ₀.store (CoreStepStar_to_StepStmtStar h_term)))) (ReflTrans_Transitive _ _ _ _ (seq_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ postAsserts (.step _ _ _ .step_block_done (.refl _))) (.step _ _ _ .step_seq_done (.refl _))))))) - -- Show every postcondition assert evaluates to true - -- by induction on the suffix of postAsserts + + have h_proj_store_agree : ∀ x, (ρ₀.store x).isSome → + ρ_proj.store x = ρ'.store x := by + intro x hx + simp only [ρ_proj, projectStore] + simp [hx] + + have h_proj_eval : ρ_proj.eval = ρ'.eval := rfl + have h_proj_hasFailure : ρ_proj.hasFailure = ρ'.hasFailure := rfl + have h_wfVar_term : WellFormedSemanticEvalVar ρ'.eval := + Core.core_wfVar_preserved π φ h_wf_ext + (.stmts proc.body ρ₀) (.terminal ρ') h_wf.wfVar h_term + have h_wfCong_term : Core.WellFormedCoreEvalCong ρ'.eval := + Core.core_wfCong_preserved π φ h_wf_ext + (.stmts proc.body ρ₀) (.terminal ρ') h_wf.wfCong h_term + have h_wfExprCongr_term : WellFormedSemanticEvalExprCongr ρ'.eval := + Core.core_wfExprCongr_preserved π φ h_wf_ext + (.stmts proc.body ρ₀) (.terminal ρ') h_wf.wfExprCongr h_term + have h_all_post_valid : ∀ s ∈ postAsserts, ∀ l e md, s = Statement.assert l e md → ρ'.eval ρ'.store e = some HasBool.tt := by suffices h_sfx : ∀ (sfx : List Statement), (∀ s ∈ sfx, ∃ l e md, s = Statement.assert l e md) → StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) - (.stmt verifyStmt ρ_init) (.block verifyLabel (.stmts sfx ρ')) → + (.stmt verifyStmt ρ_init) (.block (.some verifyLabel) ρ_init.store (.stmts sfx ρ_proj)) → ∀ s ∈ sfx, ∀ l e md, s = Statement.assert l e md → ρ'.eval ρ'.store e = some HasBool.tt by @@ -822,33 +843,35 @@ theorem procBodyVerify_procedureCorrect have ⟨lh, eh, mdh, h_hd_eq⟩ := h_all_assert hd (.head _) subst h_hd_eq have h_at_head : coreIsAtAssert - (.block verifyLabel (.stmts (Statement.assert lh eh mdh :: tl) ρ')) + (.block (.some verifyLabel) ρ_init.store (.stmts (Statement.assert lh eh mdh :: tl) ρ_proj)) ⟨lh, eh⟩ := by simp only [coreIsAtAssert]; exact ⟨trivial, trivial⟩ - have h_head_eval := h_correct' ⟨lh, eh⟩ ρ_init _ h_trace h_at_head - simp only [Config.getEval, Config.getStore] at h_head_eval + have h_head_eval_proj := h_correct' ⟨lh, eh⟩ ρ_init _ h_trace h_at_head + simp only [Config.getEval, Config.getStore] at h_head_eval_proj + have h_head_eval : ρ'.eval ρ'.store eh = some HasBool.tt := + eval_projectStore_to_full h_head_eval_proj h_wfVar_term h_wfCong_term h_wfExprCongr_term cases h_mem with | head _ => injection h_s_eq with h1; injection h1 with h2 injection h2 with _ h3; subst h3; exact h_head_eval | tail _ h_in_tl => have h_assert_step : StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) - (.stmt (Statement.assert lh eh mdh) ρ') (.terminal ρ') := by + (.stmt (Statement.assert lh eh mdh) ρ_proj) (.terminal ρ_proj) := by have h1 : StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) - (.stmt (Statement.assert lh eh mdh) ρ') - (.terminal ⟨ρ'.store, ρ'.eval, ρ'.hasFailure || false⟩) := + (.stmt (Statement.assert lh eh mdh) ρ_proj) + (.terminal ⟨ρ_proj.store, ρ_proj.eval, ρ_proj.hasFailure || false⟩) := .step _ _ _ - (.step_cmd (@EvalCommand.cmd_sem π φ ρ'.eval ρ'.store - (Cmd.assert lh eh mdh) ρ'.store false - (EvalCmd.eval_assert_pass h_head_eval h_wfb_term))) + (.step_cmd (@EvalCommand.cmd_sem π φ ρ_proj.eval ρ_proj.store + (Cmd.assert lh eh mdh) ρ_proj.store false + (EvalCmd.eval_assert_pass h_head_eval_proj (by rw [h_proj_eval]; exact h_wfb_term)))) (.refl _) - have h2 : (⟨ρ'.store, ρ'.eval, ρ'.hasFailure || false⟩ : Env Expression) = ρ' := by - cases ρ'; simp [Bool.or_false] + have h2 : (⟨ρ_proj.store, ρ_proj.eval, ρ_proj.hasFailure || false⟩ : Env Expression) = ρ_proj := by + cases ρ'; simp [ρ_proj, Bool.or_false] rw [h2] at h1; exact h1 have h_trace_tl := ReflTrans_Transitive _ _ _ _ h_trace - (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ verifyLabel + (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some verifyLabel) ρ_init.store (stmts_cons_step Expression (EvalCommand π φ) (EvalPureFunc φ) - (Statement.assert lh eh mdh) tl ρ' ρ' h_assert_step)) + (Statement.assert lh eh mdh) tl ρ_proj ρ_proj h_assert_step)) exact ih (fun s' hs' => h_all_assert s' (.tail _ hs')) h_trace_tl s h_in_tl l e md h_s_eq -- Prove postconditions hold and hasFailure is false diff --git a/Strata/Transform/ProcedureInlining.lean b/Strata/Transform/ProcedureInlining.lean index 38629b6399..752e626aa6 100644 --- a/Strata/Transform/ProcedureInlining.lean +++ b/Strata/Transform/ProcedureInlining.lean @@ -64,7 +64,7 @@ def Statement.replaceLabels | .some s' => s' match s with | .block lbl b m => .block (app lbl) (Block.replaceLabels b map) m - | .exit lbl m => .exit (lbl.map app) m + | .exit lbl m => .exit (app lbl) m | .ite cond thenb elseb m => .ite cond (Block.replaceLabels thenb map) (Block.replaceLabels elseb map) m | .loop g measure inv body m => diff --git a/Strata/Transform/Specification.lean b/Strata/Transform/Specification.lean index 14fae6d005..67f05c5045 100644 --- a/Strata/Transform/Specification.lean +++ b/Strata/Transform/Specification.lean @@ -91,7 +91,7 @@ structure Lang (P : PureExpr) [HasFvar P] [HasBool P] [HasNot P] where /-- Terminal configuration. -/ terminalCfg : Env P → CfgT /-- Exiting configuration. -/ - exitingCfg : Option String → Env P → CfgT + exitingCfg : String → Env P → CfgT /-- Assert detection in configurations. -/ isAtAssert : CfgT → AssertId P → Prop /-- Extract env from a configuration. -/ @@ -287,18 +287,32 @@ theorem seq_cons {s : Stmt P CmdT} {ss : List (Stmt P CmdT)} exact h₂ ρ₁ ρ' hmid (hwfb_preserved ρ₁ hterm_s) hf₁ (.inr ⟨lbl, hexit_ss⟩) omit [HasVal P] in -/-- Lift a `TripleBlock` to a `Triple` by wrapping in a block. -/ +/-- A postcondition is well-formed if it is stable under `projectStore`. -/ +def PostWF (Post : Env P → Prop) : Prop := + ∀ ρ σ_parent, Post ρ → ρ.hasFailure = false → + Post { ρ with store := projectStore σ_parent ρ.store } ∧ + ({ ρ with store := projectStore σ_parent ρ.store } : Env P).hasFailure = false + +omit [HasVal P] in +/-- Lift a `TripleBlock` to a `Triple` by wrapping in a block. + The postcondition `Post` is required to be stable under `projectStore` + (it only references variables defined before the block). -/ theorem TripleBlock.toTriple {ss : List (Stmt P CmdT)} {l : String} {md : MetaData P} {Pre Post : Env P → Prop} - (h : TripleBlock evalCmd extendEval Pre ss Post) : + (h : TripleBlock evalCmd extendEval Pre ss Post) + (hpost_proj : PostWF Post) : Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre (.block l ss md) Post := by intro ρ₀ ρ' hpre hwfb hf₀ hstar cases hstar with | step _ _ _ hstep hrest => cases hstep with | step_block => match block_reaches_terminal P evalCmd extendEval hrest with - | .inl hterm => exact h ρ₀ ρ' hpre hwfb hf₀ (.inl hterm) - | .inr ⟨lbl, hexit_inner⟩ => exact h ρ₀ ρ' hpre hwfb hf₀ (.inr ⟨lbl, hexit_inner⟩) + | .inl ⟨ρ_inner, hterm, heq⟩ => + have ⟨hpost, hf⟩ := h ρ₀ ρ_inner hpre hwfb hf₀ (.inl hterm) + subst heq; exact hpost_proj ρ_inner _ hpost hf + | .inr ⟨lbl, ρ_inner, hexit, heq⟩ => + have ⟨hpost, hf⟩ := h ρ₀ ρ_inner hpre hwfb hf₀ (.inr ⟨lbl, hexit⟩) + subst heq; exact hpost_proj ρ_inner _ hpost hf omit [HasVal P] in /-- Lift a `Triple` to a `TripleBlock` for a singleton list. -/ @@ -335,9 +349,10 @@ theorem Triple.toTripleBlock {s : Stmt P CmdT} omit [HasVal P] in /-- Empty block is skip. -/ -theorem skip (l : String) (md : MetaData P) (Pre : Env P → Prop) : +theorem skip (l : String) (md : MetaData P) (Pre : Env P → Prop) + (hpre_proj : PostWF Pre) : Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre (.block l [] md) Pre := - TripleBlock.toTriple evalCmd extendEval isAtAssertFn (skip_block evalCmd extendEval Pre) + TripleBlock.toTriple evalCmd extendEval isAtAssertFn (skip_block evalCmd extendEval Pre) hpre_proj omit [HasVal P] in /-- If-then-else rule. -/ @@ -397,7 +412,7 @@ theorem hoareTriple_implies_assertValid cases hstep with | step_block => have ⟨inner, heq_cfg, hinner_star, hat_inner⟩ := - block_isAtAssert_inner P' extendEval _ _ _ _ hrest hat + block_isAtAssert_inner P' extendEval _ _ _ _ _ hrest hat subst heq_cfg cases hinner_star with | refl => exact absurd hat_inner (by simp [isAtAssert]) @@ -494,9 +509,9 @@ theorem allAssertsValid_implies_hoareTriple .step _ _ _ StepStmt.step_stmts_cons (.refl _) have h3 := seq_inner_star P' (EvalCmd P') extendEval _ _ [assert_stmt] hstar_st have h_inner := ReflTrans_Transitive _ _ _ _ (ReflTrans_Transitive _ _ _ _ h1 h2) h3 - have h_block := block_inner_star P' (EvalCmd P') extendEval _ _ block_label h_inner + have h_block := block_inner_star P' (EvalCmd P') extendEval _ _ (.some block_label) ρ₀.store h_inner have h_start : StepStmtStar P' (EvalCmd P') extendEval - (.stmt (.block block_label body block_md) ρ₀) (.block block_label (.stmts body ρ₀)) := + (.stmt (.block block_label body block_md) ρ₀) (.block (.some block_label) ρ₀.store (.stmts body ρ₀)) := .step _ _ _ StepStmt.step_block (.refl _) have h_full := ReflTrans_Transitive _ _ _ _ h_start h_block have h_result := hvalid a ρ₀ _ trivial h_full hat @@ -514,12 +529,12 @@ theorem allAssertsValid_implies_hoareTriple (.stmts [assert_stmt] ρ') (.seq (.stmt assert_stmt ρ') []) := .step _ _ _ StepStmt.step_stmts_cons (.refl _) have h_inner := ReflTrans_Transitive _ _ _ _ (ReflTrans_Transitive _ _ _ _ h1 h2) h3 - have h_block := block_inner_star P' (EvalCmd P') extendEval _ _ block_label h_inner + have h_block := block_inner_star P' (EvalCmd P') extendEval _ _ (.some block_label) ρ₀.store h_inner have h_start : StepStmtStar P' (EvalCmd P') extendEval - (.stmt (.block block_label body block_md) ρ₀) (.block block_label (.stmts body ρ₀)) := + (.stmt (.block block_label body block_md) ρ₀) (.block (.some block_label) ρ₀.store (.stmts body ρ₀)) := .step _ _ _ StepStmt.step_block (.refl _) have h_full := ReflTrans_Transitive _ _ _ _ h_start h_block - have h_at : isAtAssert P' (.block block_label (.seq (.stmt assert_stmt ρ') [])) ⟨post_label, post_expr⟩ := by + have h_at : isAtAssert P' (.block (.some block_label) ρ₀.store (.seq (.stmt assert_stmt ρ') [])) ⟨post_label, post_expr⟩ := by simp [isAtAssert, assert_stmt] have h_result := hvalid ⟨post_label, post_expr⟩ ρ₀ _ trivial h_full h_at dsimp [Config.getEval, Config.getStore, Config.getEnv] at h_result diff --git a/Strata/Transform/StructuredToUnstructured.lean b/Strata/Transform/StructuredToUnstructured.lean index eb8d3e9558..1ae2e9945a 100644 --- a/Strata/Transform/StructuredToUnstructured.lean +++ b/Strata/Transform/StructuredToUnstructured.lean @@ -146,27 +146,17 @@ match ss with transfer := .condGoto (HasFvar.mkFvar ident) bl kNext }) let (accumEntry, accumBlocks) ← flushCmds "before_loop$" accum .none lentry pure (accumEntry, accumBlocks ++ [b] ++ bbs ++ decreaseBlocks ++ bsNext) -| .exit l? _md :: _ => do - -- Find the continuation of the block labeled `l`, or the most recently-added - -- block if `l` is `.none`. +| .exit l _md :: _ => do + -- Find the continuation of the block labeled `l`. let bk := - match (l?, exitConts) with + match exitConts.lookup (.some l) with + | .some k => k -- Just keep going if this is an invalid exit. We assume a prior -- check to avoid this. - | (.none, []) => k - | (.none, (_, k) :: _) => k - | (.some l, _) => - match exitConts.lookup (.some l) with - | .some k => k - -- Just keep going if this is an invalid exit. We assume a prior - -- check to avoid this. - | .none => k + | .none => k -- Flush the accumulated commands, going to the continuation calculated above. -- Any statements after the `.exit` are skipped. - let exitName := - match l? with - | .some l => s!"block${l}$" - | .none => "block$" + let exitName := s!"block${l}$" flushCmds exitName accum .none bk def stmtsToCFGM diff --git a/StrataTest/Backends/CBMC/GOTO/ToCProverGOTO.lean b/StrataTest/Backends/CBMC/GOTO/ToCProverGOTO.lean index 7a168fc6b7..4f74eae46b 100644 --- a/StrataTest/Backends/CBMC/GOTO/ToCProverGOTO.lean +++ b/StrataTest/Backends/CBMC/GOTO/ToCProverGOTO.lean @@ -245,7 +245,7 @@ info: ok: #[LOCATION 0, /-- Test exit statement transformation -/ def ExampleStmt5 : List (Imperative.Stmt LExprTP (Imperative.Cmd LExprTP)) := [.cmd (.init (Lambda.Identifier.mk "x" ()) mty[bv32] (.det (.const { underlying := (), type := mty[bv32] } (.bitvecConst 32 0))) {}), - .exit (some "target_label") {}, + .exit "target_label" {}, .cmd (.set (Lambda.Identifier.mk "x" ()) (.det (.const { underlying := (), type := mty[bv32] } (.bitvecConst 32 10))) {}), .block "target_label" [.cmd (.set (Lambda.Identifier.mk "x" ()) (.det (.const { underlying := (), type := mty[bv32] } (.bitvecConst 32 20))) {})] diff --git a/StrataTest/DL/Imperative/FormatStmtTest.lean b/StrataTest/DL/Imperative/FormatStmtTest.lean index 96f40aca0e..3b4062c932 100644 --- a/StrataTest/DL/Imperative/FormatStmtTest.lean +++ b/StrataTest/DL/Imperative/FormatStmtTest.lean @@ -147,11 +147,7 @@ info: while -- 14. exit with label /-- info: exit target -/ -#guard_msgs in #eval! format (Stmt.exit (some "target") .empty : S) - --- 14b. exit without label -/-- info: exit -/ -#guard_msgs in #eval! format (Stmt.exit none .empty : S) +#guard_msgs in #eval! format (Stmt.exit "target" .empty : S) -- 15. funcDecl /-- info: funcDecl -/ diff --git a/StrataTest/DL/Imperative/StepStmtTest.lean b/StrataTest/DL/Imperative/StepStmtTest.lean index d10ec30778..ec26045867 100644 --- a/StrataTest/DL/Imperative/StepStmtTest.lean +++ b/StrataTest/DL/Imperative/StepStmtTest.lean @@ -104,42 +104,80 @@ def noCmd : EvalCmdParam MiniPureExpr CmdT := fun _ _ _ _ _ => False --------------------------------------------------------------------- -/-! ## Test: `loop { exit }` exactly exits the loop, not the outer block. +/-! ## Test: `block "L" { loop { exit "L" } }` exits the loop via labeled exit. -A minimal program `loop { exit }` is shown to step to `.terminal`. This -verifies that an unlabeled `exit` inside the body terminates just the -loop (and not the enclosing block). +The `exit "L"` propagates out of body's per-iteration block and the loop's +recursive step (mismatch propagates), reaching the labeled outer block. -/ -/-- The test program: a deterministic `while (true)` loop whose only body - statement is an unlabeled `exit`. -/ +/-- The test program: a labeled outer block containing a deterministic + `while (true)` loop whose body is `exit "L"`. -/ def prog : Stmt MiniPureExpr CmdT := - .loop (.det .tt) none [] [.exit none .empty] .empty + .block "L" + [.loop (.det .tt) none [] [.exit "L" .empty] .empty] + .empty /-- The test: `.stmt prog ρ₀ →* .terminal ρ₀` -/ theorem progReachesTerminal : StepStmtStar MiniPureExpr noCmd miniExtendEval (.stmt prog ρ₀) (.terminal ρ₀) := by - -- Each step explicitly named; Lean fills the rest. have htt : ρ₀.eval ρ₀.store HasBool.tt = some HasBool.tt := rfl - -- Step 1: step_loop_enter with hasInvFailure = false. + -- Step 1: step_block — enter the outer labeled block. + refine .step _ _ _ StepStmt.step_block ?_ + -- Step 2: step_block_body step_stmts_cons. + refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_stmts_cons) ?_ + -- Step 3: step_block_body (step_seq_inner step_loop_enter). refine .step _ _ _ - (StepStmt.step_loop_enter (hasInvFailure := false) htt ?inv_bool ?inv_iff - miniEval_wfBool) ?rest + (StepStmt.step_block_body + (StepStmt.step_seq_inner + (StepStmt.step_loop_enter (hasInvFailure := false) htt ?inv_bool ?inv_iff + miniEval_wfBool))) ?_ · intro _ hmem; nomatch hmem · constructor <;> intro h · cases h · rcases h with ⟨_, hmem, _⟩; nomatch hmem - -- Post-state: ρ₀' = {ρ₀ with hasFailure := ρ₀.hasFailure || false} definitionally equal to ρ₀. - -- Step 2: step_block_body (step_stmts_cons). - refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_stmts_cons) ?rest2 - -- Step 3: step_block_body (step_seq_inner step_exit). + -- Now: outer block (L) > seq > seq > body's block (.none) > stmts [exit "L"] + -- Step 4: descend into the inner seq, then into the body's block, + -- then through stmts_cons. + refine .step _ _ _ + (StepStmt.step_block_body + (StepStmt.step_seq_inner + (StepStmt.step_seq_inner + (StepStmt.step_block_body StepStmt.step_stmts_cons)))) ?_ + -- Step 5: fire the exit "L". + refine .step _ _ _ + (StepStmt.step_block_body + (StepStmt.step_seq_inner + (StepStmt.step_seq_inner + (StepStmt.step_block_body + (StepStmt.step_seq_inner StepStmt.step_exit))))) ?_ + -- Step 6: step_seq_exit (inner-most seq propagates the exiting). + refine .step _ _ _ + (StepStmt.step_block_body + (StepStmt.step_seq_inner + (StepStmt.step_seq_inner + (StepStmt.step_block_body StepStmt.step_seq_exit)))) ?_ + -- Step 7: body's `.block .none` mismatches "L" — propagate via step_block_exit_mismatch. + refine .step _ _ _ + (StepStmt.step_block_body + (StepStmt.step_seq_inner + (StepStmt.step_seq_inner + (StepStmt.step_block_exit_mismatch (by intro h; cases h))))) ?_ + -- Step 8-9: propagate exiting through outer seq layers. + refine .step _ _ _ + (StepStmt.step_block_body + (StepStmt.step_seq_inner StepStmt.step_seq_exit)) ?_ refine .step _ _ _ - (StepStmt.step_block_body (StepStmt.step_seq_inner StepStmt.step_exit)) ?rest3 - -- Step 4: step_block_body step_seq_exit. - refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_seq_exit) ?rest4 - -- Step 5: step_block_exit_none. - exact .step _ _ _ StepStmt.step_block_exit_none (.refl _) + (StepStmt.step_block_body StepStmt.step_seq_exit) ?_ + -- Step 10: outer block "L" matches the exit label. + -- The store projection equals ρ₀.store since no inits happened. + have hproj : projectStore (P := MiniPureExpr) ρ₀.store ρ₀.store = ρ₀.store := by + funext x + simp [projectStore] + intro h; rfl + conv => rhs; rw [show ρ₀ = { ρ₀ with store := projectStore ρ₀.store ρ₀.store } from by + simp [hproj]] + exact .step _ _ _ (StepStmt.step_block_exit_match rfl) (.refl _) --------------------------------------------------------------------- @@ -148,7 +186,7 @@ theorem progReachesTerminal : def progIteThen : Stmt MiniPureExpr CmdT := .block "L" - [.ite (.det .tt) [.exit none .empty] [] .empty] + [.ite (.det .tt) [.exit "L" .empty] [] .empty] .empty /-- The test: `.stmt progIteThen ρ₀ →* .terminal ρ₀` via the `then` branch. -/ @@ -156,29 +194,26 @@ theorem progIteThenReachesTerminal : StepStmtStar MiniPureExpr noCmd miniExtendEval (.stmt progIteThen ρ₀) (.terminal ρ₀) := by have htt : ρ₀.eval ρ₀.store HasBool.tt = some HasBool.tt := rfl - -- Step 1: step_block — enter the outer block. - refine .step _ _ _ StepStmt.step_block ?rest1 - -- Step 2: step_block_body (step_stmts_cons) — break the singleton stmts list. - refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_stmts_cons) ?rest2 - -- Step 3: step_block_body (step_seq_inner step_ite_true) — take the then branch. + refine .step _ _ _ StepStmt.step_block ?_ + refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_stmts_cons) ?_ refine .step _ _ _ (StepStmt.step_block_body - (StepStmt.step_seq_inner (StepStmt.step_ite_true htt miniEval_wfBool))) ?rest3 - -- Step 4: step_block_body (step_seq_inner step_stmts_cons) — destructure the then body. + (StepStmt.step_seq_inner (StepStmt.step_ite_true htt miniEval_wfBool))) ?_ refine .step _ _ _ - (StepStmt.step_block_body (StepStmt.step_seq_inner StepStmt.step_stmts_cons)) ?rest4 - -- Step 5: step_block_body (step_seq_inner (step_seq_inner step_exit)) — fire the exit. + (StepStmt.step_block_body (StepStmt.step_seq_inner StepStmt.step_stmts_cons)) ?_ refine .step _ _ _ (StepStmt.step_block_body - (StepStmt.step_seq_inner (StepStmt.step_seq_inner StepStmt.step_exit))) ?rest5 - -- Step 6: step_block_body (step_seq_inner step_seq_exit) — propagate past the inner seq. + (StepStmt.step_seq_inner (StepStmt.step_seq_inner StepStmt.step_exit))) ?_ refine .step _ _ _ (StepStmt.step_block_body - (StepStmt.step_seq_inner StepStmt.step_seq_exit)) ?rest6 - -- Step 7: step_block_body step_seq_exit — propagate past the outer seq. - refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_seq_exit) ?rest7 - -- Step 8: step_block_exit_none — the outer block catches the unlabeled exit. - exact .step _ _ _ StepStmt.step_block_exit_none (.refl _) + (StepStmt.step_seq_inner StepStmt.step_seq_exit)) ?_ + refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_seq_exit) ?_ + -- Outer block "L" matches the labeled exit; project store (identity here). + have hproj : projectStore (P := MiniPureExpr) ρ₀.store ρ₀.store = ρ₀.store := by + funext x; simp [projectStore]; intro _; rfl + conv => rhs; rw [show ρ₀ = { ρ₀ with store := projectStore ρ₀.store ρ₀.store } from by + simp [hproj]] + exact .step _ _ _ (StepStmt.step_block_exit_match rfl) (.refl _) --------------------------------------------------------------------- @@ -187,7 +222,7 @@ theorem progIteThenReachesTerminal : def progIteElse : Stmt MiniPureExpr CmdT := .block "L" - [.ite (.det .ff) [] [.exit none .empty] .empty] + [.ite (.det .ff) [] [.exit "L" .empty] .empty] .empty /-- The test: `.stmt progIteElse ρ₀ →* .terminal ρ₀` via the `else` branch. -/ @@ -210,7 +245,295 @@ theorem progIteElseReachesTerminal : (StepStmt.step_block_body (StepStmt.step_seq_inner StepStmt.step_seq_exit)) ?rest6 refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_seq_exit) ?rest7 - exact .step _ _ _ StepStmt.step_block_exit_none (.refl _) + -- Outer block "L" matches the labeled exit; project store (identity here). + have hproj : projectStore (P := MiniPureExpr) ρ₀.store ρ₀.store = ρ₀.store := by + funext x; simp [projectStore]; intro _; rfl + conv => rhs; rw [show ρ₀ = { ρ₀ with store := projectStore ρ₀.store ρ₀.store } from by + simp [hproj]] + exact .step _ _ _ (StepStmt.step_block_exit_match rfl) (.refl _) + +--------------------------------------------------------------------- + +/-- Now extend `Expr` to include a variable reference so we can test + that `getVars` picks up read variables. -/ +inductive Expr2 where + | tt + | ff + | not (e : Expr2) + | var (name : String) + deriving DecidableEq, Repr, Inhabited + +abbrev MiniPureExpr2 : PureExpr := + { Ident := String, + EqIdent := instDecidableEqString, + Expr := Expr2, + Ty := Ty, + ExprMetadata := Unit, + TyEnv := Unit, + TyContext := Unit, + EvalEnv := Unit } + +instance : HasBool MiniPureExpr2 where + tt := .tt + ff := .ff + tt_is_not_ff := by intro h; cases h + boolTy := .Bool + +instance : HasNot MiniPureExpr2 where + not := .not + +/-- Get free variables from `Expr2`. -/ +def Expr2.getVars : Expr2 → List String + | .var n => [n] + | .not e => e.getVars + | _ => [] + +/-- `HasVarsPure` for `Expr2`: only `.var` contributes a variable. -/ +instance : HasVarsPure MiniPureExpr2 Expr2 where + getVars := Expr2.getVars + +instance : HasVarsPure MiniPureExpr2 (Cmd MiniPureExpr2) where + getVars := Cmd.getVars + +/-- Test: `set x := var "y"` has `modifiedOrDefinedVars = ["x"]` (write-set only) + but `touchedVars = ["x", "y"]` (includes the read variable "y"). -/ +example : (Stmt.cmd (P := MiniPureExpr2) + (Cmd.set (P := MiniPureExpr2) "x" (.det (.var "y")) .empty)).modifiedOrDefinedVars + = ["x"] := by native_decide + +example : (Stmt.cmd (P := MiniPureExpr2) + (Cmd.set (P := MiniPureExpr2) "x" (.det (.var "y")) .empty)).touchedVars + = ["x", "y"] := by native_decide + +/-- Test: `init z : Bool := var "w"` has `modifiedOrDefinedVars = ["z"]` + but `touchedVars = ["z", "w"]`. -/ +example : (Stmt.cmd (P := MiniPureExpr2) + (Cmd.init (P := MiniPureExpr2) "z" .Bool (.det (.var "w")) .empty)).modifiedOrDefinedVars + = ["z"] := by native_decide + +example : (Stmt.cmd (P := MiniPureExpr2) + (Cmd.init (P := MiniPureExpr2) "z" .Bool (.det (.var "w")) .empty)).touchedVars + = ["z", "w"] := by native_decide + +/-- Test: Block touchedVars includes both read and write vars from all stmts. -/ +example : (Block.touchedVars (P := MiniPureExpr2) (C := Cmd MiniPureExpr2) + [.cmd (Cmd.init (P := MiniPureExpr2) "a" .Bool (.det (.var "b")) .empty), + .cmd (Cmd.set (P := MiniPureExpr2) "c" (.det (.var "d")) .empty)]) + = ["a", "c", "b", "d"] := by native_decide + +example : (Block.modifiedOrDefinedVars (P := MiniPureExpr2) (C := Cmd MiniPureExpr2) + [.cmd (Cmd.init (P := MiniPureExpr2) "a" .Bool (.det (.var "b")) .empty), + .cmd (Cmd.set (P := MiniPureExpr2) "c" (.det (.var "d")) .empty)]) + = ["a", "c"] := by native_decide + +--------------------------------------------------------------------- + +/-! ## Block scoping tests + +Verify that variables `init`'d inside a block are not visible after the +block exits. We step through a program and verify the terminal store +has `none` for block-local variables thanks to `projectStore`. -/ + +/-- A `HasFvar` instance for `MiniPureExpr` — needed by `EvalCmd`. -/ +instance : HasFvar MiniPureExpr where + mkFvar _ := .tt -- unused but required + getFvar _ := none -- no expression is a free variable reference + +/-- `WellFormedSemanticEvalVar` for `miniEval` — trivially holds since + `getFvar` always returns `none`. -/ +theorem miniEval_wfVar : WellFormedSemanticEvalVar (P := MiniPureExpr) miniEval := by + unfold WellFormedSemanticEvalVar + intro e v σ hfv + simp [HasFvar.getFvar] at hfv + +/-- The standard `EvalCmd` for `Cmd MiniPureExpr`. -/ +def stdEvalCmd : EvalCmdParam MiniPureExpr (Cmd MiniPureExpr) := + EvalCmd MiniPureExpr + +/-- A store where "x" is defined (maps to `.tt`), everything else is `none`. -/ +def storeWithX : SemanticStore MiniPureExpr := + fun v => if v == "x" then some .tt else none + +/-- Env with "x" defined. -/ +def ρ_x : Env MiniPureExpr := + { store := storeWithX, eval := miniEval, hasFailure := false } + +/-- Program: `block B { init y : Bool := tt }`. + After stepping, "y" should not be visible (projected away). -/ +def progBlockScope : Stmt MiniPureExpr (Cmd MiniPureExpr) := + .block "B" [.cmd (.init "y" .Bool (.det .tt) .empty)] .empty + +/-- Store that has both "x" and "y" defined. -/ +def storeWithXY : SemanticStore MiniPureExpr := + fun v => if v == "x" then some .tt + else if v == "y" then some .tt + else none + +/-- Helper: storeWithXY agrees with storeWithX on all variables except "y". -/ +private theorem storeWithXY_frame : + ∀ v : String, "y" ≠ v → storeWithXY v = storeWithX v := by + intro v hne + unfold storeWithXY storeWithX + simp only [beq_iff_eq] + split + · simp + · split + · rename_i heq; exact absurd heq.symm hne + · rfl + +/-- After the block exits, the store should have "x" defined but "y" = none. -/ +theorem blockScopeTest : + StepStmtStar MiniPureExpr stdEvalCmd miniExtendEval + (.stmt progBlockScope ρ_x) + (.terminal { store := storeWithX, eval := miniEval, hasFailure := false }) := by + -- Step 1: step_block — enter the block, saving ρ_x.store as σ_parent. + refine .step _ _ _ StepStmt.step_block ?_ + -- Step 2: step_block_body (step_stmts_cons) — process the singleton list. + refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_stmts_cons) ?_ + -- Step 3: step_block_body (step_seq_inner step_cmd) — evaluate `init y := tt`. + refine .step _ _ _ + (StepStmt.step_block_body + (StepStmt.step_seq_inner + (StepStmt.step_cmd + (EvalCmd.eval_init (P := MiniPureExpr) + (show miniEval storeWithX .tt = some .tt from rfl) + (InitState.init + (show storeWithX "y" = none from rfl) + (show storeWithXY "y" = some .tt from rfl) + storeWithXY_frame) + miniEval_wfVar)))) ?_ + -- Step 4: step_block_body (step_seq_done) — seq is done, go to stmts []. + refine .step _ _ _ + (StepStmt.step_block_body StepStmt.step_seq_done) ?_ + -- Step 5: step_block_body (step_stmts_nil) — empty list becomes terminal. + refine .step _ _ _ + (StepStmt.step_block_body StepStmt.step_stmts_nil) ?_ + -- Step 6: step_block_done — project store. + have hproj : projectStore (P := MiniPureExpr) storeWithX storeWithXY = storeWithX := by + ext v + simp [projectStore, storeWithX, storeWithXY] + split <;> simp_all + conv => rhs; rw [show Env.mk storeWithX miniEval false = + { (Env.mk storeWithXY miniEval false) with store := projectStore storeWithX storeWithXY } + from by simp [hproj]] + exact .step _ _ _ StepStmt.step_block_done (.refl _) + +/-- Directly verify that `projectStore` maps "y" to `none`. -/ +example : projectStore (P := MiniPureExpr) storeWithX storeWithXY "y" = none := by + simp [projectStore, storeWithX, Option.isSome] + +/-- Directly verify that `projectStore` preserves "x". -/ +example : projectStore (P := MiniPureExpr) storeWithX storeWithXY "x" = some .tt := by + simp [projectStore, storeWithX, storeWithXY, Option.isSome] + +--------------------------------------------------------------------- + +/-! ## Loop scoping tests + +Verify that variables `init`'d inside a loop body are scoped to each +iteration. The loop body is wrapped in an anonymous block, so after +each iteration the init'd variable is projected away. -/ + +/-- Program: `loop (nondet) { init y := tt }`. + The loop enters one iteration, inits y, then exits on the next iteration. + The anonymous block wrapper projects "y" away. -/ +def progLoopScope : Stmt MiniPureExpr (Cmd MiniPureExpr) := + .loop .nondet none [] [.cmd (.init "y" .Bool (.det .tt) .empty)] .empty + +/-- After stepping the loop through one iteration and exiting, the final + store should still be `storeWithX` (the variable "y" is projected away + by the per-iteration anonymous block). With the new semantics, each + iteration's body runs in its own block scope. -/ +theorem loopScopeTest : + StepStmtStar MiniPureExpr stdEvalCmd miniExtendEval + (.stmt progLoopScope ρ_x) + (.terminal { store := storeWithX, eval := miniEval, hasFailure := false }) := by + -- Step 1: step_loop_nondet_enter — produces: + -- .seq (.block .none ρ_x.store (.stmts [init y] ρ_x')) [loop ...] + refine .step _ _ _ + (StepStmt.step_loop_nondet_enter (hasInvFailure := false) ?_ ?_) ?_ + · intro _ hmem; nomatch hmem + · constructor <;> intro h + · cases h + · rcases h with ⟨_, hmem, _⟩; nomatch hmem + -- Step 2: step_seq_inner (step_block_body step_stmts_cons) + refine .step _ _ _ + (StepStmt.step_seq_inner + (StepStmt.step_block_body StepStmt.step_stmts_cons)) ?_ + -- Step 3: step_seq_inner (step_block_body (step_seq_inner step_cmd)) — init y + refine .step _ _ _ + (StepStmt.step_seq_inner + (StepStmt.step_block_body + (StepStmt.step_seq_inner + (StepStmt.step_cmd + (EvalCmd.eval_init (P := MiniPureExpr) + (show miniEval storeWithX .tt = some .tt from rfl) + (InitState.init + (show storeWithX "y" = none from rfl) + (show storeWithXY "y" = some .tt from rfl) + storeWithXY_frame) + miniEval_wfVar))))) ?_ + -- Step 4: step_seq_inner (step_block_body step_seq_done) — inner stmt terminal + refine .step _ _ _ + (StepStmt.step_seq_inner + (StepStmt.step_block_body StepStmt.step_seq_done)) ?_ + -- Step 5: step_seq_inner (step_block_body step_stmts_nil) + refine .step _ _ _ + (StepStmt.step_seq_inner + (StepStmt.step_block_body StepStmt.step_stmts_nil)) ?_ + -- Step 6: step_seq_inner step_block_done — body's block projects, dropping "y" + refine .step _ _ _ + (StepStmt.step_seq_inner StepStmt.step_block_done) ?_ + -- After projection, env's store is projectStore storeWithX storeWithXY = storeWithX + have hproj : projectStore (P := MiniPureExpr) storeWithX storeWithXY = storeWithX := by + funext v + simp [projectStore, storeWithX, storeWithXY] + split <;> simp_all + -- Step 7: step_seq_done — seq advances with projected env to [loop ...] + refine .step _ _ _ StepStmt.step_seq_done ?_ + -- Step 8: step_stmts_cons + refine .step _ _ _ StepStmt.step_stmts_cons ?_ + -- Step 9: step_seq_inner step_loop_nondet_exit + refine .step _ _ _ + (StepStmt.step_seq_inner + (StepStmt.step_loop_nondet_exit (hasInvFailure := false) ?_ ?_)) ?_ + · intro _ hmem; nomatch hmem + · constructor <;> intro h + · cases h + · rcases h with ⟨_, hmem, _⟩; nomatch hmem + -- Step 10: step_seq_done + refine .step _ _ _ StepStmt.step_seq_done ?_ + -- Step 11: step_stmts_nil — final terminal + -- The final env's store should be storeWithX after the projection. + -- Need to reconcile the env shape. + conv => rhs; rw [show Env.mk storeWithX miniEval false = + { Env.mk (projectStore storeWithX storeWithXY) miniEval false with + hasFailure := false || false } from by simp [hproj, Bool.or_false]] + exact .step _ _ _ StepStmt.step_stmts_nil (.refl _) + +--------------------------------------------------------------------- + +/-! ## Test: re-init inside an if-branch gets stuck + +`init x := tt; if tt { init x := ff }` gets stuck at the second `init x` +because `InitState` requires the variable to be undefined (`σ x = none`), +but after the first `init`, `x` is already `some .tt`. This confirms that +block scoping is necessary to re-use a variable name. -/ + +def progReinitStuck : List (Stmt MiniPureExpr (Cmd MiniPureExpr)) := + [.cmd (.init "x" .Bool (.det .tt) .empty), + .ite (.det .tt) [.cmd (.init "x" .Bool (.det .ff) .empty)] [] .empty] + +/-- After executing `init x := tt`, the inner `init x := ff` cannot step + because `InitState` requires `σ "x" = none` but `σ "x" = some .tt`. + We show no single step is possible from this configuration. -/ +theorem reinit_stuck : + ¬ ∃ c₂, StepStmt MiniPureExpr stdEvalCmd miniExtendEval + (.stmt (.cmd (.init "x" .Bool (.det .ff) .empty)) ρ_x) c₂ := by + intro ⟨c₂, hstep⟩ + match hstep with + | .step_cmd (.eval_init _ (.init h_none _ _) _) => + exact absurd h_none (by simp [ρ_x, storeWithX]) --------------------------------------------------------------------- diff --git a/StrataTest/Transform/ProcedureInlining.lean b/StrataTest/Transform/ProcedureInlining.lean index 2697471f1f..a7c7c08f4a 100644 --- a/StrataTest/Transform/ProcedureInlining.lean +++ b/StrataTest/Transform/ProcedureInlining.lean @@ -151,11 +151,8 @@ def alphaEquivStatement (s1 s2: Core.Statement) (map:IdMap) .error "invariant does not match" else alphaEquivBlock b1 b2 map - | .exit lbl1 _, .exit lbl2 _ => - match lbl1, lbl2 with - | some l1, some l2 => IdMap.updateLabel map l1 l2 - | none, none => .ok map - | _, _ => mk_err "exit label mismatch" + | .exit l1 _, .exit l2 _ => + IdMap.updateLabel map l1 l2 | .cmd c1, .cmd c2 => match c1, c2 with diff --git a/docs/verso/LangDefDoc.lean b/docs/verso/LangDefDoc.lean index e2aac86773..23ec99c16e 100644 --- a/docs/verso/LangDefDoc.lean +++ b/docs/verso/LangDefDoc.lean @@ -242,8 +242,7 @@ arrangements, including sequencing, alternation, and iteration. Sequencing statements occurs by grouping them into blocks. Loops can be annotated with optional invariants and decreasing measures, which can be used for deductive verification. An `exit` statement transfers control out of the nearest -enclosing block with a matching label, or, if no label is provided, the nearest -enclosing block. In addition, statements include +enclosing block with a matching label. In addition, statements include `funcDecl` for local function declarations (which extend the expression evaluator within a scope) and `typeDecl` for local type declarations. From a5d36ed967983057d9cf0929da176f00c689e82e Mon Sep 17 00:00:00 2001 From: Michael Tautschnig Date: Fri, 15 May 2026 22:43:24 +0200 Subject: [PATCH 04/28] Support SMT string literals and common string ops in translateTerm (#1109) translateSort already handles .prim .string, but translateTerm had no arm for .prim (.string _): any SMT string literal produced by the encoder would fall through to the catch-all and raise 'unsupported term'. Add the missing arm plus the two string operations already supported in Denote.lean so that the two translators agree on the end-to-end-supported subset. Specifically, add arms for: - .prim (.string s) -> (mkString, toExpr s) - .app .str_length [s] _ -> (mkInt, Int.ofNat s.length) - .app .str_concat as _ -> (mkString, leftAssocOp mkStringAppend as) mkStringAppend uses instHAppendOfAppend + instAppendString, which is the same instance chain Lean elaborates inferInstance to for HAppend String String String. Regression tests in StrataTest/DL/SMT/TranslateTests.lean cover all three arms; each fails on origin/main (catch-all throw observable via #guard_msgs mismatch) and passes with this change. I additionally verified under a Meta.check-enabled harness that the produced Expr type-checks in the kernel, so the (fst = mkString/mkInt, snd = ...) pairs are internally consistent. By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: Kiro Co-authored-by: keyboardDrummer-bot --- Strata/DL/SMT/Translate.lean | 46 +++++++++++++++++++ StrataTest/DL/SMT/TranslateTests.lean | 66 +++++++++++++++++++++++++++ 2 files changed, 112 insertions(+) diff --git a/Strata/DL/SMT/Translate.lean b/Strata/DL/SMT/Translate.lean index 465a61dd01..c6de9007fa 100644 --- a/Strata/DL/SMT/Translate.lean +++ b/Strata/DL/SMT/Translate.lean @@ -243,6 +243,30 @@ private def mkBitVecAppend (w v : Nat) : Expr := (mkBitVec w) (mkBitVec v) (mkBitVec (w + v)) (mkApp2 (.const ``BitVec.instHAppendHAddNat []) (toExpr w) (toExpr v)) +private def mkStringAppend : Expr := + mkApp4 (.const ``HAppend.hAppend [0, 0, 0]) + mkString mkString mkString + (mkApp2 (.const ``instHAppendOfAppend [0]) mkString + (.const ``instAppendString [])) + +/-- +Length of a string as an `Int` (via `Int.ofNat`), matching the semantics used +in `Denote.lean`. +-/ +private def mkStringLength (s : Expr) : Expr := + .app (.const ``Int.ofNat []) (.app (.const ``String.length []) s) + +/-- +Throw unless `α` is the Lean `String` type (as produced by `mkString`). Used +to guard string-theory operations so that a malformed SMT term such as +`(.app .str_length [.prim (.int 0)] ...)` is rejected up front, matching the +behaviour of `Denote.denoteTerm`. +-/ +private def expectString (α : Expr) : TranslateM Unit := + match α with + | .const ``String [] => return () + | _ => throw m!"Error: expected String type, got '{α}'" + def symbolToName (s : String) : Name := -- Quote the string if a natural translation to Name fails if s.toName == .anonymous then @@ -496,6 +520,28 @@ def translateTerm (t : SMT.Term) : TranslateM (Expr × Expr) := do let (α, x) ← translateTerm x let w ← getBitVecWidth α return (mkBitVec (w + i), mkApp3 (.const ``BitVec.zeroExtend []) (toExpr w) (toExpr (w + i)) x) + -- SMT-Lib theory of strings + | .prim (.string s) => + return (mkString, toExpr s) + | .app .str_length [s] _ => + let (α, s) ← translateTerm s + expectString α + return (mkInt, mkStringLength s) + | .app .str_concat as _ => + -- `Denote.leftAssoc` requires at least two operands and checks that each + -- operand has the expected type. Mirror that here rather than delegating + -- to `leftAssocOp`, which does neither. + let a :: b :: as := as + | throw m!"Error: str_concat expects at least two operands, got '{as.length}'" + let (α, a) ← translateTerm a + expectString α + let (β, b) ← translateTerm b + expectString β + let as ← as.mapM fun t => do + let (γ, e) ← translateTerm t + expectString γ + return e + return (mkString, as.foldl (mkApp2 mkStringAppend) (mkApp2 mkStringAppend a b)) | t => throw m!"Error: unsupported term '{repr t}'" where leftAssocOp (op : Expr) (as : List SMT.Term) : TranslateM (Expr × Expr) := do diff --git a/StrataTest/DL/SMT/TranslateTests.lean b/StrataTest/DL/SMT/TranslateTests.lean index 79810f8b13..43c7c93611 100644 --- a/StrataTest/DL/SMT/TranslateTests.lean +++ b/StrataTest/DL/SMT/TranslateTests.lean @@ -74,3 +74,69 @@ info: ∀ (α : Type → Type → Type) [inst : ∀ (α_1 α_2 : Type), Nonempty let inner := .app .ite [c, (.prim (.int 1)), (.prim (.int 2))] (.prim .int) let outer := .app .ite [c, inner, (.prim (.int 3))] (.prim .int) elabQuery {} [] (.app .eq [outer, (.prim (.int 1))] (.prim .bool)) + +-- SMT-Lib theory of strings: literals and the operations supported by +-- `Denote.lean` (`str_length`, `str_concat`). + +/-- info: "hi" = "hi" -/ +#guard_msgs in +#eval + elabQuery {} [] (.app .eq [(.prim (.string "hi")), (.prim (.string "hi"))] (.prim .bool)) + +/-- info: Int.ofNat "hello".length = 5 -/ +#guard_msgs in +#eval + elabQuery {} [] + (.app .eq [(.app .str_length [(.prim (.string "hello"))] (.prim .int)), (.prim (.int 5))] + (.prim .bool)) + +/-- info: "hi" ++ " there" = "hi there" -/ +#guard_msgs in +#eval + elabQuery {} [] + (.app .eq [(.app .str_concat [(.prim (.string "hi")), (.prim (.string " there"))] (.prim .string)), + (.prim (.string "hi there"))] + (.prim .bool)) + +/-- info: "a" ++ "b" ++ "c" = "abc" -/ +#guard_msgs in +#eval + elabQuery {} [] + (.app .eq + [(.app .str_concat + [(.prim (.string "a")), (.prim (.string "b")), (.prim (.string "c"))] + (.prim .string)), + (.prim (.string "abc"))] + (.prim .bool)) + +-- Malformed string terms are rejected up front, matching `Denote.denoteTerm`. +-- Using `.prim (.bool _)` (which translates to type `Prop`) for the +-- non-string operand keeps the expected error message stable independent of +-- how `.prim (.int _)` happens to be typed by the translator. + +/-- error: Error: expected String type, got 'Prop' -/ +#guard_msgs in +#eval + elabQuery {} [] + (.app .eq + [(.app .str_length [(.prim (.bool true))] (.prim .int)), + (.prim (.int 0))] + (.prim .bool)) + +/-- error: Error: str_concat expects at least two operands, got '1' -/ +#guard_msgs in +#eval + elabQuery {} [] + (.app .eq + [(.app .str_concat [(.prim (.string "hi"))] (.prim .string)), + (.prim (.string "hi"))] + (.prim .bool)) + +/-- error: Error: expected String type, got 'Prop' -/ +#guard_msgs in +#eval + elabQuery {} [] + (.app .eq + [(.app .str_concat [(.prim (.bool true)), (.prim (.string "hi"))] (.prim .string)), + (.prim (.string "hi"))] + (.prim .bool)) From 50b0e124ffe0b88a8d4572fc2411166b16964245 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mika=C3=ABl=20Mayer?= Date: Fri, 15 May 2026 15:59:05 -0500 Subject: [PATCH 05/28] feat: introduce Provenance type and migrate metadata from FileRange (#1140) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes #1139 Introduces a `Provenance` type that fully replaces `FileRange` and `SourceRange` as the canonical way to store source locations in metadata. This structurally eliminates the "SourceRange without file name" problem. The `Provenance` type has two constructors: - `Provenance.loc uri range` — a real source location (always requires both URI and range) - `Provenance.synthesized origin` — a node created programmatically, with a `SynthesizedOrigin` inductive type A `SynthesizedOrigin` inductive enforces that only canonical origins are used (`smtEncode`, `nondetIte`, `laurelParse`, `laurel`, `laurelToCore`, `structuredToUnstructured`), preventing typos and duplicates at the type level. Key changes: - The `.fileRange` variant is removed from `MetaDataElem.Value` — all metadata values now use `.provenance` exclusively - `MetaData.ofSourceRange` emits only a provenance element - `getProvenance` is the single source of truth for reading source locations from metadata - `setCallSiteFileRange` works directly with `Provenance` instead of roundtripping through `FileRange` - `getFileRange` delegates to `getProvenance` for extraction - `FileRange.unknown` and `SourceRange.none` eliminated from metadata construction - SMT DDM translator uses `smtAnn` combinator to reduce annotation boilerplate - SARIF output uses `getFileRange` (which reads provenance) `FileRange` remains as a utility struct for extraction and formatting (e.g., in `DiagnosticModel`), but is no longer a metadata value type. Existing tests pass unchanged. ## Follow-up - Migrate the B3, Boole, and Python grammar ASTs from using `SourceRange` as their annotation type parameter to `Provenance`. This would allow combining multiple files at the AST level and enable proper provenance tracking through translation passes. --- .../Backends/CBMC/GOTO/CoreToCProverGOTO.lean | 2 +- Strata/DL/Imperative/MetaData.lean | 81 ++++--- Strata/DL/SMT/DDMTransform/Translate.lean | 213 +++++++++--------- Strata/Languages/Boole/Verify.lean | 4 +- .../C_Simp/DDMTransform/Translate.lean | 5 +- .../Core/DDMTransform/Translate.lean | 5 +- Strata/Languages/Core/SarifOutput.lean | 15 +- Strata/Languages/Core/StatementEval.lean | 4 +- .../ConcreteToAbstractTreeTranslator.lean | 4 +- Strata/Languages/Laurel/Laurel.lean | 5 +- .../Laurel/LaurelToCoreTranslator.lean | 8 +- Strata/Languages/Laurel/TypeHierarchy.lean | 7 +- Strata/Languages/Python/PythonToCore.lean | 4 +- Strata/Languages/Python/PythonToLaurel.lean | 2 +- .../Transform/StructuredToUnstructured.lean | 17 +- Strata/Util/Provenance.lean | 63 ++++++ .../Languages/Core/Tests/SMTEncoderTests.lean | 3 +- .../Core/Tests/SarifOutputTests.lean | 8 +- 18 files changed, 265 insertions(+), 185 deletions(-) create mode 100644 Strata/Util/Provenance.lean diff --git a/Strata/Backends/CBMC/GOTO/CoreToCProverGOTO.lean b/Strata/Backends/CBMC/GOTO/CoreToCProverGOTO.lean index bd353e0895..a0ef4725c2 100644 --- a/Strata/Backends/CBMC/GOTO/CoreToCProverGOTO.lean +++ b/Strata/Backends/CBMC/GOTO/CoreToCProverGOTO.lean @@ -108,8 +108,8 @@ def convertMetaData (md : Imperative.MetaData Core.Expression) match elem.fld with | .label l => match elem.value with | .msg s => some ⟨.label l, .msg s⟩ - | .fileRange r => some ⟨.label l, .fileRange r⟩ | .switch b => some ⟨.label l, .switch b⟩ + | .provenance p => some ⟨.label l, .provenance p⟩ | .expr _ => none | .var _ => none diff --git a/Strata/DL/Imperative/MetaData.lean b/Strata/DL/Imperative/MetaData.lean index dff78ea614..f3d3a384d1 100644 --- a/Strata/DL/Imperative/MetaData.lean +++ b/Strata/DL/Imperative/MetaData.lean @@ -8,9 +8,10 @@ module public import Strata.DL.Imperative.PureExpr public import Strata.DL.Util.DecidableEq public import Strata.Util.FileRange +public import Strata.Util.Provenance namespace Imperative -open Strata +open Strata (DiagnosticModel DiagnosticType FileRange Provenance Uri SourceRange) public section @@ -69,23 +70,23 @@ instance [Repr P.Ident] : Repr (MetaDataElem.Field P) where | .label s => f!"MetaDataElem.Field.label {s}" Repr.addAppParen res prec -/-- A metadata value, which can be either an expression, a message, or a fileRange -/ +/-- A metadata value, which can be either an expression, a message, a switch, or a provenance. -/ inductive MetaDataElem.Value (P : PureExpr) where /-- Metadata value in the form of a structured expression. -/ | expr (e : P.Expr) /-- Metadata value in the form of an arbitrary string. -/ | msg (s : String) - /-- Metadata value in the form of a fileRange. -/ - | fileRange (r: FileRange) /-- Metadata value in the form of a boolean switch. -/ | switch (b : Bool) + /-- Metadata value in the form of a provenance (source location or synthesized origin). -/ + | provenance (p : Provenance) instance [ToFormat P.Expr] : ToFormat (MetaDataElem.Value P) where format f := match f with | .expr e => f!"{e}" | .msg s => f!"{s}" - | .fileRange r => f!"{r}" | .switch b => f!"{b}" + | .provenance p => f!"{p}" instance [Repr P.Expr] : Repr (MetaDataElem.Value P) where reprPrec v prec := @@ -93,16 +94,16 @@ instance [Repr P.Expr] : Repr (MetaDataElem.Value P) where match v with | .expr e => f!".expr {reprPrec e prec}" | .msg s => f!".msg {s}" - | .fileRange fr => f!".fileRange {fr}" | .switch b => f!".switch {repr b}" + | .provenance p => f!".provenance {repr p}" Repr.addAppParen res prec def MetaDataElem.Value.beq [BEq P.Expr] (v1 v2 : MetaDataElem.Value P) := match v1, v2 with | .expr e1, .expr e2 => e1 == e2 | .msg m1, .msg m2 => m1 == m2 - | .fileRange r1, .fileRange r2 => r1 == r2 | .switch b1, .switch b2 => b1 == b2 + | .provenance p1, .provenance p2 => p1 == p2 | _, _ => false instance [BEq P.Expr] : BEq (MetaDataElem.Value P) where @@ -178,7 +179,8 @@ instance [Repr P.Expr] [Repr P.Ident] : Repr (MetaDataElem P) where /-! ### Common metadata fields -/ @[match_pattern] -abbrev MetaData.fileRange : MetaDataElem.Field P := .label "fileRange" +abbrev MetaData.provenanceField : MetaDataElem.Field P := .label "provenance" + @[match_pattern] abbrev MetaData.reachCheck : MetaDataElem.Field P := .label "reachCheck" @[match_pattern] @@ -222,18 +224,31 @@ def MetaData.hasSatisfiabilityCheck {P : PureExpr} [BEq P.Ident] (md : MetaData | _ => false | none => false +/-- Get the provenance from metadata. -/ +def getProvenance {P : PureExpr} [BEq P.Ident] (md : MetaData P) : Option Provenance := do + let elem ← md.findElem Imperative.MetaData.provenanceField + match elem.value with + | .provenance p => some p + | _ => none + def getFileRange {P : PureExpr} [BEq P.Ident] (md: MetaData P) : Option FileRange := do - let fileRangeElement <- md.findElem Imperative.MetaData.fileRange - match fileRangeElement.value with - | .fileRange fileRange => - some fileRange - | _ => none + let p ← getProvenance md + p.toFileRange + +/-- Create metadata with a provenance element. -/ +def MetaData.ofProvenance {P : PureExpr} (p : Provenance) : MetaData P := + #[{ fld := MetaData.provenanceField, value := .provenance p }] + +/-- Create metadata from a source range and URI, storing provenance. -/ +def MetaData.ofSourceRange {P : PureExpr} (uri : Uri) (sr : SourceRange) : MetaData P := + MetaData.ofProvenance (Provenance.ofSourceRange uri sr) /-- Create a DiagnosticModel from metadata and a message. - Uses the file range from metadata if available, otherwise uses a default location. -/ + Uses provenance or file range from metadata if available, otherwise uses a default location. -/ def MetaData.toDiagnostic {P : PureExpr} [BEq P.Ident] (md : MetaData P) (msg : String) (type : DiagnosticType := DiagnosticType.UserError): DiagnosticModel := - match getFileRange md with - | some fr => DiagnosticModel.withRange fr msg type + match getProvenance md with + | some (.loc uri range) => DiagnosticModel.withRange { file := uri, range } msg type + | some (.synthesized _) => DiagnosticModel.fromMessage msg type | none => DiagnosticModel.fromMessage msg type /-- Create a DiagnosticModel from metadata and a Format message. -/ @@ -261,7 +276,16 @@ def getRelatedFileRanges {P : PureExpr} [BEq P.Ident] (md: MetaData P) : Array F md.filterMap fun elem => if elem.fld == Imperative.MetaData.relatedFileRange then match elem.value with - | .fileRange fr => some fr + | .provenance p => p.toFileRange + | _ => none + else none + +/-- Get all related provenances from metadata, in order. -/ +private def getRelatedProvenances {P : PureExpr} [BEq P.Ident] (md: MetaData P) : Array Provenance := + md.filterMap fun elem => + if elem.fld == Imperative.MetaData.relatedFileRange then + match elem.value with + | .provenance p => some p | _ => none else none @@ -270,20 +294,21 @@ def MetaData.eraseAllElems {P : PureExpr} [BEq P.Ident] (md : MetaData P) (fld : MetaDataElem.Field P) : MetaData P := md.filter (fun e => !(e.fld == fld)) -/-- Replace the primary file range with a new one, shifting existing related - file ranges and prepending the old primary range. -/ +/-- Replace the primary provenance with a new one, shifting existing related + provenances and prepending the old primary provenance. -/ def MetaData.setCallSiteFileRange {P : PureExpr} [BEq P.Ident] (md : MetaData P) (callSiteRange : MetaData P) : MetaData P := - match getFileRange callSiteRange, getFileRange md with - | some csRange, some origRange => - let existingRelated := getRelatedFileRanges md - let md := md.eraseElem MetaData.fileRange + match getProvenance callSiteRange, getProvenance md with + | some csProv, some origProv => + let existingRelated := getRelatedProvenances md + let md := md.eraseElem MetaData.provenanceField let md := md.eraseAllElems MetaData.relatedFileRange - let md := md.pushElem MetaData.fileRange (.fileRange csRange) - let md := md.pushElem MetaData.relatedFileRange (.fileRange origRange) - existingRelated.foldl (fun md fr => md.pushElem MetaData.relatedFileRange (.fileRange fr)) md - | some csRange, none => - md.pushElem MetaData.fileRange (.fileRange csRange) + let md := md.pushElem MetaData.provenanceField (.provenance csProv) + let md := md.pushElem MetaData.relatedFileRange (.provenance origProv) + existingRelated.foldl (fun md p => md.pushElem MetaData.relatedFileRange (.provenance p)) md + | some csProv, none => + let md := md.eraseElem MetaData.provenanceField + md.pushElem MetaData.provenanceField (.provenance csProv) | none, _ => md /-- Metadata field for property type classification (e.g., "divisionByZero"). -/ diff --git a/Strata/DL/SMT/DDMTransform/Translate.lean b/Strata/DL/SMT/DDMTransform/Translate.lean index 87b062a1bb..740314bc4c 100644 --- a/Strata/DL/SMT/DDMTransform/Translate.lean +++ b/Strata/DL/SMT/DDMTransform/Translate.lean @@ -7,6 +7,7 @@ module public import Strata.DL.SMT.DDMTransform.Parse public import Strata.DL.SMT.Term +public import Strata.Util.Provenance public import Strata.Util.Tactics import Strata.DDM.Elab.LoadedDialects @@ -16,87 +17,91 @@ public section namespace SMTDDM -private def mkQualifiedIdent (s:String):QualifiedIdent SourceRange := - .qualifiedIdentImplicit SourceRange.none (Ann.mk SourceRange.none s) +/-- Annotation used for all synthesized SMT DDM nodes. -/ +private abbrev smtProv : Provenance := .synthesized .smtEncode -private def mkSimpleSymbol (s:String):SimpleSymbol SourceRange := +/-- Wrap a value with the SMT provenance annotation. -/ +private abbrev smtAnn (v : α) : Ann α Provenance := Ann.mk smtProv v + +private def mkQualifiedIdent (s:String):QualifiedIdent Provenance := + .qualifiedIdentImplicit smtProv (smtAnn s) + +private def mkSimpleSymbol (s:String):SimpleSymbol Provenance := match List.find? (fun (_,sym) => sym = s) specialCharsInSimpleSymbol with | .some (name,_) => -- This needs hard-coded for now. (match name with - | "plus" => .simple_symbol_plus SourceRange.none - | "minus" => .simple_symbol_minus SourceRange.none - | "star" => .simple_symbol_star SourceRange.none - | "eq" => .simple_symbol_eq SourceRange.none - | "percent" => .simple_symbol_percent SourceRange.none - | "questionmark" => .simple_symbol_questionmark SourceRange.none - | "period" => .simple_symbol_period SourceRange.none - | "tilde" => .simple_symbol_tilde SourceRange.none - | "amp" => .simple_symbol_amp SourceRange.none - | "caret" => .simple_symbol_caret SourceRange.none - | "lt" => .simple_symbol_lt SourceRange.none - | "gt" => .simple_symbol_gt SourceRange.none - | "at" => .simple_symbol_at SourceRange.none - | "le" => .simple_symbol_le SourceRange.none - | "ge" => .simple_symbol_ge SourceRange.none - | "implies" => .simple_symbol_implies SourceRange.none + | "plus" => .simple_symbol_plus smtProv + | "minus" => .simple_symbol_minus smtProv + | "star" => .simple_symbol_star smtProv + | "eq" => .simple_symbol_eq smtProv + | "percent" => .simple_symbol_percent smtProv + | "questionmark" => .simple_symbol_questionmark smtProv + | "period" => .simple_symbol_period smtProv + | "tilde" => .simple_symbol_tilde smtProv + | "amp" => .simple_symbol_amp smtProv + | "caret" => .simple_symbol_caret smtProv + | "lt" => .simple_symbol_lt smtProv + | "gt" => .simple_symbol_gt smtProv + | "at" => .simple_symbol_at smtProv + | "le" => .simple_symbol_le smtProv + | "ge" => .simple_symbol_ge smtProv + | "implies" => .simple_symbol_implies smtProv | _ => panic! s!"Unknown simple symbol: {name}") | .none => - .simple_symbol_qid SourceRange.none (mkQualifiedIdent s) + .simple_symbol_qid smtProv (mkQualifiedIdent s) -private def mkSymbol (s:String):Symbol SourceRange := - .symbol SourceRange.none (mkSimpleSymbol s) +private def mkSymbol (s:String):Symbol Provenance := + .symbol smtProv (mkSimpleSymbol s) -private def mkIdentifier (s:String):SMTIdentifier SourceRange := - .iden_simple SourceRange.none (mkSymbol s) +private def mkIdentifier (s:String):SMTIdentifier Provenance := + .iden_simple smtProv (mkSymbol s) private def translateFromTermPrim (t:SMT.TermPrim): - Except String (SMTDDM.Term SourceRange) := do - let srnone := SourceRange.none + Except String (SMTDDM.Term Provenance) := do match t with | .bool b => - let ss:SimpleSymbol SourceRange := - if b then .simple_symbol_tt srnone else .simple_symbol_ff srnone - return (.qual_identifier srnone - (.qi_ident srnone (.iden_simple srnone (.symbol srnone ss)))) + let ss:SimpleSymbol Provenance := + if b then .simple_symbol_tt smtProv else .simple_symbol_ff smtProv + return (.qual_identifier smtProv + (.qi_ident smtProv (.iden_simple smtProv (.symbol smtProv ss)))) | .int i => let abs_i := if i < 0 then -i else i if i >= 0 then - return .spec_constant_term srnone (.sc_numeral srnone abs_i.toNat) + return .spec_constant_term smtProv (.sc_numeral smtProv abs_i.toNat) else -- SMT-LIB represents negative integers as (- N), i.e. unary minus -- applied to the absolute value. - let posTerm := Term.spec_constant_term srnone (.sc_numeral srnone abs_i.toNat) - return .qual_identifier_args srnone - (.qi_ident srnone (mkIdentifier "-")) - (Ann.mk srnone #[posTerm]) + let posTerm := Term.spec_constant_term smtProv (.sc_numeral smtProv abs_i.toNat) + return .qual_identifier_args smtProv + (.qi_ident smtProv (mkIdentifier "-")) + (smtAnn #[posTerm]) | .real dec => - return .spec_constant_term srnone (.sc_decimal srnone dec) + return .spec_constant_term smtProv (.sc_decimal smtProv dec) | .bitvec (n := n) bv => let bvty := mkSymbol (s!"bv{bv.toNat}") - let val:Index SourceRange := .ind_numeral srnone n - return (.qual_identifier srnone - (.qi_ident srnone (.iden_indexed srnone bvty (Ann.mk srnone #[val])))) + let val:Index Provenance := .ind_numeral smtProv n + return (.qual_identifier smtProv + (.qi_ident smtProv (.iden_indexed smtProv bvty (smtAnn #[val])))) | .string s => - return .spec_constant_term srnone (.sc_str srnone s) + return .spec_constant_term smtProv (.sc_str smtProv s) -- List of SMTSort to Array. -private def translateFromSMTSortList (l: List (SMTSort SourceRange)): - Array (SMTSort SourceRange) := +private def translateFromSMTSortList (l: List (SMTSort Provenance)): + Array (SMTSort Provenance) := l.toArray private def translateFromTermType (t:SMT.TermType): - Except String (SMTDDM.SMTSort SourceRange) := do - let srnone := SourceRange.none + Except String (SMTDDM.SMTSort Provenance) := do match t with | .prim tp => match tp with | .bitvec n => - let idx : Index SourceRange := .ind_numeral srnone n - return (.smtsort_ident srnone - (.iden_indexed srnone + let idx : Index Provenance := .ind_numeral smtProv n + return (.smtsort_ident smtProv + (.iden_indexed smtProv (mkSymbol "BitVec") - (Ann.mk srnone #[idx]))) + (smtAnn #[idx]))) | .trigger => throw "don't know how to translate a trigger type" | _ => @@ -107,122 +112,116 @@ private def translateFromTermType (t:SMT.TermType): | .string => .ok "String" | .regex => .ok "RegLan" | _ => throw "unreachable" - return .smtsort_ident srnone (mkIdentifier res) + return .smtsort_ident smtProv (mkIdentifier res) | .option ty => let argty ← translateFromTermType ty - return .smtsort_param srnone (mkIdentifier "Option") (Ann.mk srnone #[argty]) + return .smtsort_param smtProv (mkIdentifier "Option") (smtAnn #[argty]) | .constr id args => let argtys <- args.mapM translateFromTermType let argtys_array := translateFromSMTSortList argtys if argtys_array.isEmpty then - return .smtsort_ident srnone (mkIdentifier id) + return .smtsort_ident smtProv (mkIdentifier id) else - return .smtsort_param srnone (mkIdentifier id) (Ann.mk srnone argtys_array) + return .smtsort_param smtProv (mkIdentifier id) (smtAnn argtys_array) -- Helper: convert an Index to an SExpr -private def indexToSExpr (idx : SMTDDM.Index SourceRange) - : SMTDDM.SExpr SourceRange := - let srnone := SourceRange.none +private def indexToSExpr (idx : SMTDDM.Index Provenance) + : SMTDDM.SExpr Provenance := match idx with - | .ind_numeral _ n => .se_spec_const srnone (.sc_numeral srnone n) - | .ind_symbol _ sym => .se_symbol srnone sym + | .ind_numeral _ n => .se_spec_const smtProv (.sc_numeral smtProv n) + | .ind_symbol _ sym => .se_symbol smtProv sym -- Helper: convert an indexed identifier to an SExpr: (_ sym idx1 idx2 ...) -private def indexedIdentToSExpr (sym : SMTDDM.Symbol SourceRange) - (indices : Ann (Array (SMTDDM.Index SourceRange)) SourceRange) - : SMTDDM.SExpr SourceRange := - let srnone := SourceRange.none - let underscoreSym := SMTDDM.SExpr.se_symbol srnone (mkSymbol "_") +private def indexedIdentToSExpr (sym : SMTDDM.Symbol Provenance) + (indices : Ann (Array (SMTDDM.Index Provenance)) Provenance) + : SMTDDM.SExpr Provenance := + let underscoreSym := SMTDDM.SExpr.se_symbol smtProv (mkSymbol "_") let idxSExprs := indices.val.toList.map indexToSExpr - .se_ls srnone (Ann.mk srnone ((underscoreSym :: .se_symbol srnone sym :: idxSExprs).toArray)) + .se_ls smtProv (smtAnn ((underscoreSym :: .se_symbol smtProv sym :: idxSExprs).toArray)) -- Helper: convert an SMTSort to an SExpr for use in pattern attributes -private def sortToSExpr (s : SMTDDM.SMTSort SourceRange) - : Except String (SMTDDM.SExpr SourceRange) := do - let srnone := SourceRange.none +private def sortToSExpr (s : SMTDDM.SMTSort Provenance) + : Except String (SMTDDM.SExpr Provenance) := do match s with - | .smtsort_ident _ (.iden_simple _ sym) => return .se_symbol srnone sym + | .smtsort_ident _ (.iden_simple _ sym) => return .se_symbol smtProv sym | .smtsort_ident _ (.iden_indexed _ sym indices) => return indexedIdentToSExpr sym indices | .smtsort_param _ (.iden_simple _ sym) args => let argsSExpr ← args.val.toList.mapM sortToSExpr - return .se_ls srnone (Ann.mk srnone ((.se_symbol srnone sym :: argsSExpr).toArray)) + return .se_ls smtProv (smtAnn ((.se_symbol smtProv sym :: argsSExpr).toArray)) | _ => throw s!"Doesn't know how to convert sort {repr s} to SMTDDM.SExpr" termination_by SizeOf.sizeOf s decreasing_by cases args; simp_all; term_by_mem -- Helper: convert a QualIdentifier to an SExpr for use in pattern attributes -private def qiToSExpr (qi : SMTDDM.QualIdentifier SourceRange) - : Except String (SMTDDM.SExpr SourceRange) := do - let srnone := SourceRange.none +private def qiToSExpr (qi : SMTDDM.QualIdentifier Provenance) + : Except String (SMTDDM.SExpr Provenance) := do match qi with - | .qi_ident _ (.iden_simple _ sym) => pure (.se_symbol srnone sym) + | .qi_ident _ (.iden_simple _ sym) => pure (.se_symbol smtProv sym) | .qi_ident _ (.iden_indexed _ sym indices) => pure (indexedIdentToSExpr sym indices) | .qi_isort _ (.iden_simple _ sym) sort => let sortSExpr ← sortToSExpr sort - let asSym := SMTDDM.SExpr.se_symbol srnone (mkSymbol "as") - pure (.se_ls srnone (Ann.mk srnone #[asSym, .se_symbol srnone sym, sortSExpr])) + let asSym := SMTDDM.SExpr.se_symbol smtProv (mkSymbol "as") + pure (.se_ls smtProv (smtAnn #[asSym, .se_symbol smtProv sym, sortSExpr])) | _ => throw s!"Doesn't know how to convert QI {repr qi} to SMTDDM.SExpr" -- Helper function to convert a SMTDDM.Term to SExpr for use in pattern attributes -def termToSExpr (t : SMTDDM.Term SourceRange) - : Except String (SMTDDM.SExpr SourceRange) := do - let srnone := SourceRange.none +def termToSExpr (t : SMTDDM.Term Provenance) + : Except String (SMTDDM.SExpr Provenance) := do match t with | .qual_identifier _ qi => qiToSExpr qi | .qual_identifier_args _ qi args => let qiSExpr ← qiToSExpr qi let argsSExpr ← args.val.mapM termToSExpr - return .se_ls srnone (Ann.mk srnone ((qiSExpr :: argsSExpr.toList).toArray)) - | .spec_constant_term _ s => return .se_spec_const srnone s + return .se_ls smtProv (smtAnn ((qiSExpr :: argsSExpr.toList).toArray)) + | .spec_constant_term _ s => return .se_spec_const smtProv s | _ => throw s!"Doesn't know how to convert {repr t} to SMTDDM.SExpr" decreasing_by cases args; term_by_mem -partial def translateFromTerm (t:SMT.Term): Except String (SMTDDM.Term SourceRange) := do - let srnone := SourceRange.none +partial def translateFromTerm (t:SMT.Term): Except String (SMTDDM.Term Provenance) := do match t with | .prim p => translateFromTermPrim p | .var v => - return .qual_identifier srnone (.qi_ident srnone (.iden_simple srnone - (.symbol srnone (mkSimpleSymbol v.id)))) + return .qual_identifier smtProv (.qi_ident smtProv (.iden_simple smtProv + (.symbol smtProv (mkSimpleSymbol v.id)))) | .none _ | .some _ => throw "don't know how to translate none and some" | .app op args retTy => let args' <- args.mapM translateFromTerm let args_array := args'.toArray - let mk_qual_identifier (qi:QualIdentifier SourceRange) : SMTDDM.Term SourceRange := + let mk_qual_identifier (qi:QualIdentifier Provenance) : SMTDDM.Term Provenance := if args_array.isEmpty then - (.qual_identifier srnone qi) + (.qual_identifier smtProv qi) else - (.qual_identifier_args srnone qi (Ann.mk srnone args_array)) + (.qual_identifier_args smtProv qi (smtAnn args_array)) -- Datatype constructors need (as Name RetType) qualification for SMT-LIB match op with | .datatype_op .constructor name => let retSort ← translateFromTermType retTy - let qi := QualIdentifier.qi_isort srnone (mkIdentifier name) retSort + let qi := QualIdentifier.qi_isort smtProv (mkIdentifier name) retSort return mk_qual_identifier qi | .bv (.zero_extend n) => - let iden := SMTIdentifier.iden_indexed srnone (mkSymbol "zero_extend") - (Ann.mk srnone #[.ind_numeral srnone n]) - return mk_qual_identifier (.qi_ident srnone iden) + let iden := SMTIdentifier.iden_indexed smtProv (mkSymbol "zero_extend") + (smtAnn #[.ind_numeral smtProv n]) + return mk_qual_identifier (.qi_ident smtProv iden) | .str (.re_index n) => - let iden := SMTIdentifier.iden_indexed srnone (mkSymbol "re.^") - (Ann.mk srnone #[.ind_numeral srnone n]) - return mk_qual_identifier (.qi_ident srnone iden) + let iden := SMTIdentifier.iden_indexed smtProv (mkSymbol "re.^") + (smtAnn #[.ind_numeral smtProv n]) + return mk_qual_identifier (.qi_ident smtProv iden) | .str (.re_loop n₁ n₂) => - let iden := SMTIdentifier.iden_indexed srnone (mkSymbol "re.loop") - (Ann.mk srnone #[.ind_numeral srnone n₁, .ind_numeral srnone n₂]) - return mk_qual_identifier (.qi_ident srnone iden) + let iden := SMTIdentifier.iden_indexed smtProv (mkSymbol "re.loop") + (smtAnn #[.ind_numeral smtProv n₁, .ind_numeral smtProv n₂]) + return mk_qual_identifier (.qi_ident smtProv iden) | _ => - return mk_qual_identifier (.qi_ident srnone (mkIdentifier op.mkName)) + return mk_qual_identifier (.qi_ident smtProv (mkIdentifier op.mkName)) | .quant qkind args tr body => - let args_sorted:List (SMTDDM.SortedVar SourceRange) <- + let args_sorted:List (SMTDDM.SortedVar Provenance) <- args.mapM (fun ⟨name,ty⟩ => do let ty' <- translateFromTermType ty - return .sorted_var srnone (mkSymbol name) ty') + return .sorted_var smtProv (mkSymbol name) ty') let args_array := args_sorted.toArray if args_array.isEmpty then throw "empty quantifier" @@ -241,7 +240,7 @@ partial def translateFromTerm (t:SMT.Term): Except String (SMTDDM.Term SourceRan -- .app .triggers [.app .triggers group₁ .trigger, .app .triggers group₂ .trigger, ...] .trigger -- Each inner .app .triggers represents one :pattern group. -- If a trigger term is NOT .app .triggers, treat it as a single-term group. - let mut patternAttrs : Array (SMTDDM.Attribute SourceRange) := #[] + let mut patternAttrs : Array (SMTDDM.Attribute Provenance) := #[] for trigTerm in triggerTerms do let sexprs ← match trigTerm with | .app .triggers its _ => do @@ -250,22 +249,22 @@ partial def translateFromTerm (t:SMT.Term): Except String (SMTDDM.Term SourceRan | other => do let ddmTerm ← translateFromTerm other pure [← termToSExpr ddmTerm] - let attr : SMTDDM.Attribute SourceRange := - .att_kw srnone - (.kw_symbol srnone (mkSimpleSymbol "pattern")) - (Ann.mk srnone (some (.av_sel srnone (Ann.mk srnone sexprs.toArray)))) + let attr : SMTDDM.Attribute Provenance := + .att_kw smtProv + (.kw_symbol smtProv (mkSimpleSymbol "pattern")) + (smtAnn (some (.av_sel smtProv (smtAnn sexprs.toArray)))) patternAttrs := patternAttrs.push attr -- Wrap body with bang operator and pattern attributes - pure (.bang srnone body (Ann.mk srnone patternAttrs)) + pure (.bang smtProv body (smtAnn patternAttrs)) | _ => -- Unexpected trigger format - return body as-is pure body match qkind with | .all => - return .forall_smt srnone (Ann.mk srnone args_array) bodyWithPattern + return .forall_smt smtProv (smtAnn args_array) bodyWithPattern | .exist => - return .exists_smt srnone (Ann.mk srnone args_array) bodyWithPattern + return .exists_smt smtProv (smtAnn args_array) bodyWithPattern private def dummy_prg_for_toString := diff --git a/Strata/Languages/Boole/Verify.lean b/Strata/Languages/Boole/Verify.lean index 8e21563365..5c237ab6e5 100644 --- a/Strata/Languages/Boole/Verify.lean +++ b/Strata/Languages/Boole/Verify.lean @@ -161,9 +161,7 @@ private def constructorListToList : BooleDDM.ConstructorList SourceRange → Lis private def toCoreMetaData (sr : SourceRange) : TranslateM (Imperative.MetaData Core.Expression) := do let file := (← get).fileName - let uri : Uri := .file file - let fileRangeElt := ⟨Imperative.MetaData.fileRange, .fileRange ⟨uri, sr⟩⟩ - return #[fileRangeElt] + return Imperative.MetaData.ofSourceRange (.file file) sr private def mkCoreApp (op : Core.Expression.Expr) (args : List Core.Expression.Expr) : Core.Expression.Expr := Lambda.LExpr.mkApp () op args diff --git a/Strata/Languages/C_Simp/DDMTransform/Translate.lean b/Strata/Languages/C_Simp/DDMTransform/Translate.lean index 9a8b6ede54..5b1493e6e6 100644 --- a/Strata/Languages/C_Simp/DDMTransform/Translate.lean +++ b/Strata/Languages/C_Simp/DDMTransform/Translate.lean @@ -54,10 +54,7 @@ def TransM.error [Inhabited α] (msg : String) : TransM α := do /- Metadata -/ def sourceRangeToMetaData (ictx : InputContext) (sr : SourceRange) : Imperative.MetaData C_Simp.Expression := - let file := ictx.fileName - let uri : Uri := .file file - let fileRangeElt := ⟨ MetaData.fileRange, .fileRange ⟨ uri, sr ⟩ ⟩ - #[fileRangeElt] + Imperative.MetaData.ofSourceRange (.file ictx.fileName) sr def getOpMetaData (op : Operation) : TransM (Imperative.MetaData C_Simp.Expression) := return sourceRangeToMetaData (← StateT.get).inputCtx op.ann diff --git a/Strata/Languages/Core/DDMTransform/Translate.lean b/Strata/Languages/Core/DDMTransform/Translate.lean index 9e6ed5a8f8..3eeb98ac4d 100644 --- a/Strata/Languages/Core/DDMTransform/Translate.lean +++ b/Strata/Languages/Core/DDMTransform/Translate.lean @@ -51,10 +51,7 @@ def TransM.error [Inhabited α] (msg : String) : TransM α := do /- Metadata -/ def SourceRange.toMetaData (ictx : InputContext) (sr : SourceRange) : Imperative.MetaData Core.Expression := - let file := ictx.fileName - let uri: Uri := .file file - let fileRangeElt := ⟨ MetaData.fileRange, .fileRange ⟨ uri, sr ⟩ ⟩ - #[fileRangeElt] + Imperative.MetaData.ofSourceRange (.file ictx.fileName) sr def getOpMetaData (op : Operation) : TransM (Imperative.MetaData Core.Expression) := return op.ann.toMetaData (← StateT.get).inputCtx diff --git a/Strata/Languages/Core/SarifOutput.lean b/Strata/Languages/Core/SarifOutput.lean index b950aa5fa4..6e69cf014b 100644 --- a/Strata/Languages/Core/SarifOutput.lean +++ b/Strata/Languages/Core/SarifOutput.lean @@ -77,15 +77,12 @@ def outcomeToMessage (outcome : VCOutcome) : String := /-- Extract location information from metadata -/ def extractLocation (files : Map Strata.Uri Lean.FileMap) (md : Imperative.MetaData Expression) : Option Location := do - let fileRangeElem ← md.findElem Imperative.MetaData.fileRange - match fileRangeElem.value with - | .fileRange fr => - let fileMap ← files.find? fr.file - let startPos := fileMap.toPosition fr.range.start - let uri := match fr.file with - | .file path => path - pure { uri, startLine := startPos.line, startColumn := startPos.column } - | _ => none + let fr ← Imperative.getFileRange md + let fileMap ← files.find? fr.file + let startPos := fileMap.toPosition fr.range.start + let uri := match fr.file with + | .file path => path + pure { uri, startLine := startPos.line, startColumn := startPos.column } /-- Convert PropertyType to a property classification string for SARIF output -/ def propertyTypeToClassification : Imperative.PropertyType → String diff --git a/Strata/Languages/Core/StatementEval.lean b/Strata/Languages/Core/StatementEval.lean index 267dad9452..ce2b35a975 100644 --- a/Strata/Languages/Core/StatementEval.lean +++ b/Strata/Languages/Core/StatementEval.lean @@ -585,8 +585,8 @@ private def evalOneStmt (old_var_subst : SubstMap) | .nondet => let freshName : CoreIdent := ⟨s!"$__nondet_cond_{Ewn.env.pathConditions.length}", ()⟩ let freshVar : Expression.Expr := .fvar () freshName none - let initStmt := Statement.init freshName (.forAll [] (.tcons "bool" [])) .nondet Imperative.MetaData.empty - let iteStmt := Imperative.Stmt.ite (.det freshVar) then_ss else_ss Imperative.MetaData.empty + let initStmt := Statement.init freshName (.forAll [] (.tcons "bool" [])) .nondet (Imperative.MetaData.ofProvenance (.synthesized .nondetIte)) + let iteStmt := Imperative.Stmt.ite (.det freshVar) then_ss else_ss (Imperative.MetaData.ofProvenance (.synthesized .nondetIte)) evalSub Ewn [initStmt, iteStmt] nextSplitId | .det c => let cond' := Ewn.env.exprEval c diff --git a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean index 8d3dcdc460..cf8545d95d 100644 --- a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean @@ -45,8 +45,8 @@ private def getArgFileRange (arg : Arg) : TransM (Option FileRange) := do def getArgMetaData (arg : Arg) : TransM (Imperative.MetaData Core.Expression) := do return match (← get).uri with - | some uri => #[⟨Imperative.MetaData.fileRange, .fileRange (SourceRange.toFileRange uri arg.ann)⟩] - | none => #[⟨Imperative.MetaData.fileRange, .fileRange FileRange.unknown⟩] + | some uri => Imperative.MetaData.ofSourceRange uri arg.ann + | none => Imperative.MetaData.ofProvenance (.synthesized .laurelParse) def checkOp (op : Strata.Operation) (name : QualifiedIdent) (argc : Nat) : TransM Unit := do diff --git a/Strata/Languages/Laurel/Laurel.lean b/Strata/Languages/Laurel/Laurel.lean index a5cd11439c..86ae83d022 100644 --- a/Strata/Languages/Laurel/Laurel.lean +++ b/Strata/Languages/Laurel/Laurel.lean @@ -377,8 +377,9 @@ def Condition.mapCondition (f : AstNode StmtExpr → AstNode StmtExpr) (c : Cond /-- Build Core metadata from an optional source location. -/ def fileRangeToCoreMd (source : Option FileRange) : Imperative.MetaData Core.Expression := - let fr := source.getD FileRange.unknown - Imperative.MetaData.empty.pushElem Imperative.MetaData.fileRange (.fileRange fr) + match source with + | some fr => Imperative.MetaData.ofSourceRange fr.file fr.range + | none => Imperative.MetaData.ofProvenance (.synthesized .laurel) /-- Build Core metadata from an AstNode's source location. -/ def astNodeToCoreMd (node : AstNode α) : Imperative.MetaData Core.Expression := diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index 66f57af768..beb50ad9b0 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -44,7 +44,7 @@ open Lambda (LMonoTy LTy LExpr) public section private def mdWithUnknownLoc : Imperative.MetaData Core.Expression := - #[⟨Imperative.MetaData.fileRange, .fileRange FileRange.unknown⟩] + Imperative.MetaData.ofProvenance (.synthesized .laurelToCore) def isFieldName (fieldNames : List Identifier) (name : Identifier) : Bool := fieldNames.contains name @@ -316,8 +316,10 @@ def translateExpr (expr : StmtExprMd) all_goals (have := AstNode.sizeOf_val_lt expr; term_by_mem) def getNameFromMd (md : Imperative.MetaData Core.Expression): String := - let fileRange := (Imperative.getFileRange md).getD (dbg_trace "BUG: metadata without a filerange"; default) - s!"({fileRange.range.start})" + match Imperative.getProvenance md with + | some (.loc _ range) => s!"({range.start})" + | some (.synthesized _) => "(0)" + | none => "(unknown)" def defaultExprForType (ty : HighTypeMd) : TranslateM Core.Expression.Expr := do match ty.val with diff --git a/Strata/Languages/Laurel/TypeHierarchy.lean b/Strata/Languages/Laurel/TypeHierarchy.lean index 263875f606..411c61b95f 100644 --- a/Strata/Languages/Laurel/TypeHierarchy.lean +++ b/Strata/Languages/Laurel/TypeHierarchy.lean @@ -126,8 +126,11 @@ private def checkDiamondFieldAccess (model : SemanticModel) (target : StmtExprMd match (computeExprType model target).val with | .UserDefined typeName => if isDiamondInheritedField model typeName fieldName then - let fileRange := source.getD FileRange.unknown - [DiagnosticModel.withRange fileRange s!"fields that are inherited multiple times can not be accessed."] + match source with + | some fileRange => + [DiagnosticModel.withRange fileRange s!"fields that are inherited multiple times can not be accessed."] + | none => + [DiagnosticModel.fromMessage s!"fields that are inherited multiple times can not be accessed."] else [] | _ => [] diff --git a/Strata/Languages/Python/PythonToCore.lean b/Strata/Languages/Python/PythonToCore.lean index 4a77ea4c35..5641277d32 100644 --- a/Strata/Languages/Python/PythonToCore.lean +++ b/Strata/Languages/Python/PythonToCore.lean @@ -101,9 +101,7 @@ deriving Inhabited /-- Create metadata from a SourceRange for attaching to Core statements. -/ def sourceRangeToMetaData (filePath : String) (sr : SourceRange) : Imperative.MetaData Core.Expression := - let uri : Uri := .file filePath - let fileRangeElt := ⟨ Imperative.MetaData.fileRange, .fileRange ⟨ uri, sr ⟩ ⟩ - #[fileRangeElt] + Imperative.MetaData.ofSourceRange (.file filePath) sr ------------------------------------------------------------------------------- diff --git a/Strata/Languages/Python/PythonToLaurel.lean b/Strata/Languages/Python/PythonToLaurel.lean index 0622ad6473..0310fb473f 100644 --- a/Strata/Languages/Python/PythonToLaurel.lean +++ b/Strata/Languages/Python/PythonToLaurel.lean @@ -170,7 +170,7 @@ private def guardProp {p : Prop} [Decidable p] (msg : String) /-! ## Helper Functions -/ -/-- Create metadata from a SourceRange for attaching to Laurel statements. -/ +/-- Create a FileRange from a SourceRange for attaching to Laurel statements. -/ def sourceRangeToFileRange (filePath : String) (sr : SourceRange) : FileRange := let uri : Uri := .file filePath ⟨ uri, sr ⟩ diff --git a/Strata/Transform/StructuredToUnstructured.lean b/Strata/Transform/StructuredToUnstructured.lean index 1ae2e9945a..94b345d25f 100644 --- a/Strata/Transform/StructuredToUnstructured.lean +++ b/Strata/Transform/StructuredToUnstructured.lean @@ -43,6 +43,9 @@ def flushCmds let b := (l, { cmds := accum.reverse, transfer := tr?.getD (.goto k) }) pure (l, [b]) +private abbrev synthesizedMd {P : PureExpr} : MetaData P := + MetaData.ofProvenance (.synthesized .structuredToUnstructured) + /-- Translate a list of statements to basic blocks, accumulating commands -/ def stmtsToBlocks [HasBool P] [HasPassiveCmds P CmdT] [HasInit P CmdT] @@ -92,7 +95,7 @@ match ss with | .nondet => do let freshName ← StringGenState.gen "$__nondet_ite$" let ident := HasIdent.ident (P := P) freshName - let initCmd := HasInit.init ident HasBool.boolTy .nondet MetaData.empty + let initCmd := HasInit.init ident HasBool.boolTy .nondet synthesizedMd pure (HasFvar.mkFvar ident, [initCmd]) let (accumEntry, accumBlocks) ← flushCmds "ite$" (accum ++ extraCmds) (.some (.condGoto condExpr tl fl)) l @@ -111,13 +114,13 @@ match ss with let mLabel ← StringGenState.gen "loop_measure$" let mIdent := HasIdent.ident mLabel let mOldExpr := HasFvar.mkFvar mIdent - let initCmd := HasInit.init mIdent HasIntOrder.intTy .nondet MetaData.empty + let initCmd := HasInit.init mIdent HasIntOrder.intTy .nondet synthesizedMd let assumeCmd := HasPassiveCmds.assume s!"assume_{mLabel}" - (HasIntOrder.eq mOldExpr mExpr) MetaData.empty + (HasIntOrder.eq mOldExpr mExpr) synthesizedMd let lbCmd := HasPassiveCmds.assert s!"measure_lb_{mLabel}" - (HasNot.not (HasIntOrder.lt mOldExpr HasIntOrder.zero)) MetaData.empty + (HasNot.not (HasIntOrder.lt mOldExpr HasIntOrder.zero)) synthesizedMd let decCmd := HasPassiveCmds.assert s!"measure_decrease_{mLabel}" - (HasIntOrder.lt mExpr mOldExpr) MetaData.empty + (HasIntOrder.lt mExpr mOldExpr) synthesizedMd let ldec ← StringGenState.gen "measure_decrease$" let decBlock := (ldec, { cmds := [decCmd], transfer := .goto lentry }) pure ([initCmd, assumeCmd, lbCmd], ldec, [decBlock]) @@ -131,7 +134,7 @@ match ss with let assertLabel ← if srcLabel.isEmpty then StringGenState.gen "inv$" else pure srcLabel - pure (HasPassiveCmds.assert assertLabel i MetaData.empty)) + pure (HasPassiveCmds.assert assertLabel i synthesizedMd)) -- For nondet guards, introduce a fresh boolean variable match c with | .det e => @@ -141,7 +144,7 @@ match ss with | .nondet => do let freshName ← StringGenState.gen "$__nondet_loop$" let ident := HasIdent.ident (P := P) freshName - let initCmd := HasInit.init ident HasBool.boolTy .nondet MetaData.empty + let initCmd := HasInit.init ident HasBool.boolTy .nondet synthesizedMd let b := (lentry, { cmds := [initCmd] ++ invCmds ++ measureCmds, transfer := .condGoto (HasFvar.mkFvar ident) bl kNext }) let (accumEntry, accumBlocks) ← flushCmds "before_loop$" accum .none lentry diff --git a/Strata/Util/Provenance.lean b/Strata/Util/Provenance.lean new file mode 100644 index 0000000000..d5fc4d7bb0 --- /dev/null +++ b/Strata/Util/Provenance.lean @@ -0,0 +1,63 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.Util.FileRange + +public section +namespace Strata + +/-- Canonical synthesized provenance origins. -/ +inductive SynthesizedOrigin where + | smtEncode + | nondetIte + | laurelParse + | laurel + | laurelToCore + | structuredToUnstructured + deriving DecidableEq, Repr, Inhabited + +instance : Std.ToFormat SynthesizedOrigin where + format + | .smtEncode => "smt-encode" + | .nondetIte => "nondet-ite" + | .laurelParse => "laurel-parse" + | .laurel => "laurel" + | .laurelToCore => "laurel-to-core" + | .structuredToUnstructured => "structured-to-unstructured" + +/-- Provenance tracks where an AST node originated from — either a real source +location or a synthesized origin (e.g., from a translator or encoding pass). -/ +inductive Provenance where + /-- A real source location with file and byte range. -/ + | loc (uri : Uri) (range : SourceRange) + /-- A synthesized node with a description of what created it. -/ + | synthesized (origin : SynthesizedOrigin) + deriving DecidableEq, Repr, Inhabited + +namespace Provenance + +/-- Convert a Provenance to a FileRange, if it has a real location. -/ +def toFileRange : Provenance → Option FileRange + | .loc uri range => some { file := uri, range } + | .synthesized _ => none + +/-- Convert a FileRange to a Provenance. -/ +def ofFileRange (fr : FileRange) : Provenance := + .loc fr.file fr.range + +/-- Convert a SourceRange and Uri to a Provenance. -/ +def ofSourceRange (uri : Uri) (sr : SourceRange) : Provenance := + .loc uri sr + +instance : Std.ToFormat Provenance where + format + | .loc uri range => f!"{uri}:{range}" + | .synthesized origin => f!"" + +end Provenance +end Strata +end diff --git a/StrataTest/Languages/Core/Tests/SMTEncoderTests.lean b/StrataTest/Languages/Core/Tests/SMTEncoderTests.lean index e0bf1d3622..979e09a3d4 100644 --- a/StrataTest/Languages/Core/Tests/SMTEncoderTests.lean +++ b/StrataTest/Languages/Core/Tests/SMTEncoderTests.lean @@ -406,8 +406,7 @@ private def summaryMd (summary : String) : Imperative.MetaData Core.Expression : /-- Metadata carrying only a file range (no property summary); used to exercise `addLocationInfo`. -/ private def fileRangeMd (file : String) : Imperative.MetaData Core.Expression := - let fr : Strata.FileRange := ⟨.file file, Strata.SourceRange.none⟩ - Imperative.MetaData.empty.pushElem Imperative.MetaData.fileRange (.fileRange fr) + Imperative.MetaData.ofProvenance (Strata.Provenance.ofSourceRange (.file file) Strata.SourceRange.none) /-! Embedded double quotes in the property summary must be doubled (`""`). -/ /-- diff --git a/StrataTest/Languages/Core/Tests/SarifOutputTests.lean b/StrataTest/Languages/Core/Tests/SarifOutputTests.lean index 7ac1104fb9..98c8cac9b0 100644 --- a/StrataTest/Languages/Core/Tests/SarifOutputTests.lean +++ b/StrataTest/Languages/Core/Tests/SarifOutputTests.lean @@ -36,15 +36,13 @@ def makeMetadata (file : String) (_line _col : Nat) : MetaData Expression := let uri := Strata.Uri.file file -- Create a 1D range (byte offsets). For testing, we use simple offsets. let range : Strata.SourceRange := { start := ⟨0⟩, stop := ⟨10⟩ } - let fr : Strata.FileRange := { file := uri, range := range } - #[{ fld := Imperative.MetaData.fileRange, value := .fileRange fr }] + Imperative.MetaData.ofProvenance (Strata.Provenance.ofSourceRange uri range) /-- Create metadata with a specific byte offset for the file range start. -/ def makeMetadataAt (file : String) (startByte : Nat) : MetaData Expression := let uri := Strata.Uri.file file let range : Strata.SourceRange := { start := ⟨startByte⟩, stop := ⟨startByte + 10⟩ } - let fr : Strata.FileRange := { file := uri, range := range } - #[{ fld := Imperative.MetaData.fileRange, value := .fileRange fr }] + Imperative.MetaData.ofProvenance (Strata.Provenance.ofSourceRange uri range) /-- Create a simple FileMap for testing -/ def makeFileMap : Lean.FileMap := @@ -122,7 +120,7 @@ def makeVCResult (label : String) (outcome : VCOutcome) -- Test location extraction from metadata with wrong value type #guard let md : MetaData Expression := #[ - { fld := Imperative.MetaData.fileRange, value := .msg "not a fileRange" } + { fld := Imperative.MetaData.provenanceField, value := .msg "not a provenance" } ] let files := makeFilesMap "/test/file.st" (extractLocation files md == none) From 1d47569157ef886f95f2a32e5b298887d9baeb9e Mon Sep 17 00:00:00 2001 From: thanhnguyen-aws Date: Mon, 18 May 2026 08:38:13 -0700 Subject: [PATCH 06/28] Fix bug: ADT constructors do not change `Map` to `Array` when using useArrayTheory option. (#1145) *Description of changes:* **Bug:** When `useArrayTheory` is enabled, the SMT encoder correctly converts `Map` types to `Array` in variable declarations and function signatures, but it did *not* perform this conversion for fields inside ADT (algebraic data type) constructor declarations. This caused a type mismatch: a datatype field would be declared with type `Map` while the rest of the encoding used `Array`. **Fix:** Thread the `useArrayTheory` flag through the datatype emission pipeline: - `lMonoTyToTermType` now accepts `useArrayTheory` and converts `Map` to `Array` when enabled. - `datatypeConstructorsToSMT` passes the flag to `lMonoTyToTermType`. - `SMT.Context.emitDatatypes` accepts and forwards the flag. - `encodeCore` in `Verifier.lean` passes `options.useArrayTheory` to `emitDatatypes`. **Test:** Added a unit test in `SMTEncoderDatatypeTest.lean` that verifies a datatype with a `Map`-typed field emits `(Array Int Int)` when `useArrayTheory=true` and `(Map Int Int)` when `useArrayTheory=false`. By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: keyboardDrummer-bot --- Strata/Languages/Core/SMTEncoder.lean | 22 +++--- Strata/Languages/Core/Verifier.lean | 5 +- .../Core/Tests/SMTEncoderDatatypeTest.lean | 72 +++++++++++++++++-- 3 files changed, 83 insertions(+), 16 deletions(-) diff --git a/Strata/Languages/Core/SMTEncoder.lean b/Strata/Languages/Core/SMTEncoder.lean index 0668322f5c..59476c1de8 100644 --- a/Strata/Languages/Core/SMTEncoder.lean +++ b/Strata/Languages/Core/SMTEncoder.lean @@ -95,7 +95,7 @@ def SMT.Context.withTypeFactory (ctx : SMT.Context) (tf : @Lambda.TypeFactory Co Helper function to convert LMonoTy to TermType for datatype constructor fields. Handles monomorphic types and type variables (as `.constr tv []`). -/ -private def lMonoTyToTermType (ty : LMonoTy) : TermType := +private def lMonoTyToTermType (useArrayTheory : Bool := false) (ty : LMonoTy) : TermType := match ty with | .bitvec n => .bitvec n | .tcons "bool" [] => .bool @@ -103,14 +103,18 @@ private def lMonoTyToTermType (ty : LMonoTy) : TermType := | .tcons "real" [] => .real | .tcons "string" [] => .string | .tcons "regex" [] => .regex - | .tcons name args => .constr name (args.map lMonoTyToTermType) + | .tcons name args => + if name == "Map" && useArrayTheory then + .constr "Array" (args.map $ lMonoTyToTermType useArrayTheory) + else + .constr name (args.map $ lMonoTyToTermType useArrayTheory) | .ftvar tv => .constr tv [] /-- Convert a datatype's constructors to typed SMT constructors. -/ -private def datatypeConstructorsToSMT (d : LDatatype CoreLParams.IDMeta) : List SMTConstructor := +private def datatypeConstructorsToSMT (d : LDatatype CoreLParams.IDMeta) (useArrayTheory : Bool := false): List SMTConstructor := d.constrs.map fun c => let fields := c.args.map fun (name, fieldTy) => - (d.name ++ ".." ++ name.name, lMonoTyToTermType fieldTy) + (d.name ++ ".." ++ name.name, lMonoTyToTermType useArrayTheory fieldTy) { name := c.name.name, args := fields } /-- Ensures that all datatypes in the SMT encoding do not have arrow-typed @@ -133,7 +137,7 @@ Uses the TypeFactory ordering (already topologically sorted). Only emits datatypes that have been seen (added via addDatatype). Single-element blocks use declare-datatype, multi-element blocks use declare-datatypes. -/ -def SMT.Context.emitDatatypes (ctx : SMT.Context) : Strata.SMT.SolverM Unit := do +def SMT.Context.emitDatatypes (ctx : SMT.Context) (useArrayTheory : Bool := false): Strata.SMT.SolverM Unit := do match validateDatatypesForSMT ctx.typeFactory ctx.seenDatatypes with | .error msg => throw (IO.userError (toString msg)) | .ok () => pure () @@ -142,10 +146,10 @@ def SMT.Context.emitDatatypes (ctx : SMT.Context) : Strata.SMT.SolverM Unit := d match usedBlock with | [] => pure () | [d] => - let constructors := datatypeConstructorsToSMT d + let constructors := datatypeConstructorsToSMT d useArrayTheory Strata.SMT.Solver.declareDatatype d.name d.typeArgs constructors | _ => - let dts := usedBlock.map fun d => (d.name, d.typeArgs, datatypeConstructorsToSMT d) + let dts := usedBlock.map fun d => (d.name, d.typeArgs, datatypeConstructorsToSMT d useArrayTheory) Strata.SMT.Solver.declareDatatypes dts @[expose] abbrev BoundVars := List (String × TermType) @@ -639,7 +643,7 @@ partial def toSMTOp (E : Env) (fn : CoreIdent) (fnty : LMonoTy) (ctx : SMT.Conte -- `.bvar`s. Use substFvarsLifting to properly lift indices under binders. let bvars := (List.range formals.length).map (fun i => LExpr.bvar () i) let body := LExpr.substFvarsLifting body (formals.zip bvars) - let (term, ctx) ← toSMTTerm E bvs body ctx + let (term, ctx) ← toSMTTerm E bvs body ctx useArrayTheory .ok (ctx.addIF uf term, !ctx.ifs.contains ({ uf := uf, body := term })) -- For recursive functions, generate per-constructor axioms let recAxioms ← if func.isRecursive && isNew then @@ -664,7 +668,7 @@ partial def toSMTOp (E : Env) (fn : CoreIdent) (fnty : LMonoTy) (ctx : SMT.Conte let savedSubst := ctx.tySubst let ctx ← allAxioms.foldlM (fun acc_ctx (ax: LExpr CoreLParams.mono) => do let current_axiom_ctx := acc_ctx.addSubst smt_ty_inst - let (axiom_term, new_ctx) ← toSMTTerm E [] ax current_axiom_ctx + let (axiom_term, new_ctx) ← toSMTTerm E [] ax current_axiom_ctx useArrayTheory .ok (new_ctx.addAxiom axiom_term) ) ctx let ctx := ctx.restoreSubst savedSubst diff --git a/Strata/Languages/Core/Verifier.lean b/Strata/Languages/Core/Verifier.lean index 92a07e3934..c4b1fb0026 100644 --- a/Strata/Languages/Core/Verifier.lean +++ b/Strata/Languages/Core/Verifier.lean @@ -52,6 +52,7 @@ when needed for the validity check (line 64 for check-sat-assuming, line 77 for def encodeCore (ctx : Core.SMT.Context) (prelude : SolverM Unit) (assumptionTerms : List Term) (obligationTerm : Term) (md : Imperative.MetaData Core.Expression) + (useArrayTheory : Bool := false) (satisfiabilityCheck validityCheck : Bool) (label : String) (varDefinitions : List Core.VarDefinition := []) @@ -60,7 +61,7 @@ def encodeCore (ctx : Core.SMT.Context) (prelude : SolverM Unit) Solver.setLogic "ALL" prelude let _ ← ctx.sorts.mapM (fun s => Solver.declareSort s.name s.arity) - ctx.emitDatatypes + ctx.emitDatatypes useArrayTheory let varDefNames := varDefinitions.map (·.name) let varDeclNames := varDeclarations.map (·.name) let managedNames := varDefNames ++ varDeclNames @@ -219,7 +220,7 @@ def dischargeObligation Imperative.SMT.dischargeObligation (P := Core.Expression) (Strata.SMT.Encoder.encodeCore ctx (getSolverPrelude options.solver) - assumptionTerms obligationTerm md satisfiabilityCheck validityCheck + assumptionTerms obligationTerm md options.useArrayTheory satisfiabilityCheck validityCheck (label := label) (varDefinitions := varDefinitions) (varDeclarations := varDeclarations)) (typedVarToSMTFn ctx) vars diff --git a/StrataTest/Languages/Core/Tests/SMTEncoderDatatypeTest.lean b/StrataTest/Languages/Core/Tests/SMTEncoderDatatypeTest.lean index 1dd7ff5a6c..0f1d023365 100644 --- a/StrataTest/Languages/Core/Tests/SMTEncoderDatatypeTest.lean +++ b/StrataTest/Languages/Core/Tests/SMTEncoderDatatypeTest.lean @@ -71,13 +71,13 @@ def treeDatatype : LDatatype Unit := Convert an expression to full SMT string including datatype declarations. `blocks` is a list of mutual blocks (each block is a list of mutually recursive datatypes). -/ -def toSMTStringWithDatatypeBlocks (e : LExpr CoreLParams.mono) (blocks : List (List (LDatatype Unit))) : IO String := do +def toSMTStringWithDatatypeBlocks (e : LExpr CoreLParams.mono) (blocks : List (List (LDatatype Unit))) (useArrayTheory : Bool := false): IO String := do match Env.init.addDatatypes blocks with | .error msg => return s!"Error creating environment: {msg}" | .ok env => -- Set the TypeFactory for correct datatype emission ordering let ctx := SMT.Context.default.withTypeFactory env.datatypes - match toSMTTerm env [] e ctx with + match toSMTTerm env [] e ctx useArrayTheory with | .error err => return err.pretty | .ok (smt, ctx) => -- Emit the full SMT output including datatype declarations @@ -85,7 +85,7 @@ def toSMTStringWithDatatypeBlocks (e : LExpr CoreLParams.mono) (blocks : List (L let solver ← Strata.SMT.Solver.bufferWriter b match (← ((do -- First emit datatypes - ctx.emitDatatypes + ctx.emitDatatypes useArrayTheory -- Then encode the term let _ ← (Strata.SMT.Encoder.encodeTerm smt).run Strata.SMT.EncoderState.init pure () @@ -102,8 +102,8 @@ def toSMTStringWithDatatypeBlocks (e : LExpr CoreLParams.mono) (blocks : List (L Convert an expression to full SMT string including datatype declarations. Each datatype is treated as its own (non-mutual) block. -/ -def toSMTStringWithDatatypes (e : LExpr CoreLParams.mono) (datatypes : List (LDatatype Unit)) : IO String := - toSMTStringWithDatatypeBlocks e (datatypes.map (fun d => [d])) +def toSMTStringWithDatatypes (e : LExpr CoreLParams.mono) (datatypes : List (LDatatype Unit)) (useArrayTheory : Bool := false): IO String := + toSMTStringWithDatatypeBlocks e (datatypes.map (fun d => [d])) useArrayTheory /-! ## Test Cases with Guard Messages -/ @@ -511,6 +511,68 @@ info: (declare-datatype IntList ( [[intListDatatype]] listLenFunc +/-- Container = MkContainer (data: Map int int) -/ +def containerWithMapDatatype : LDatatype Unit := + { name := "Container" + typeArgs := [] + constrs := [ + { name := ⟨"MkContainer", ()⟩, + args := [(⟨"data", ()⟩, .tcons "Map" [.int, .int])], + testerName := "Container..isMkContainer" } + ] + constrs_ne := by decide } + +-- Test: ADT constructor field with Map type should emit Array when useArrayTheory=true +/-- +info: (declare-datatype Container ( + (MkContainer (Container..data (Array Int Int))))) +; c +(declare-const c Container) +-/ +#guard_msgs in +#eval format <$> toSMTStringWithDatatypes + (.fvar () (⟨"c", ()⟩) (.some (.tcons "Container" []))) + [containerWithMapDatatype] true + +-- Test: Same datatype without useArrayTheory should keep Map +/-- +info: (declare-datatype Container ( + (MkContainer (Container..data (Map Int Int))))) +; c +(declare-const c Container) +-/ +#guard_msgs in +#eval format <$> toSMTStringWithDatatypes + (.fvar () (⟨"c", ()⟩) (.some (.tcons "Container" []))) + [containerWithMapDatatype] + +-- Test: ADT testers with Map type should emit Array when useArrayTheory=true +/-- +info: (declare-datatype Container ( + (MkContainer (Container..data (Array Int Int))))) +; xs +(declare-const xs Container) +-/ +#guard_msgs in +#eval format <$> toSMTStringWithDatatypes + (.app () (.op () (⟨"Container..isMkContainer", ()⟩) (.some (.arrow (.tcons "Container" []) .bool))) + (.fvar () (⟨"xs", ()⟩) (.some (.tcons "Container" [])))) + [containerWithMapDatatype] true + +-- Test: ADT destructors with Map type should emit Array when useArrayTheory=true +/-- +info: (declare-datatype Container ( + (MkContainer (Container..data (Array Int Int))))) +; xs +(declare-const xs Container) +-/ +#guard_msgs in +#eval format <$> toSMTStringWithDatatypes + (.app () (.op () (⟨"Container..data", ()⟩) (.some (.arrow (.tcons "Container" []) (.tcons "Map" [.int, .int])))) + (.fvar () (⟨"xs", ()⟩) (.some (.tcons "Container" [])))) + [containerWithMapDatatype] true + + end DatatypeTests end Core From 75e806ee2edff78aa46fc5af00e53ff3e11c6731 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mika=C3=ABl=20Mayer?= Date: Mon, 18 May 2026 10:41:54 -0500 Subject: [PATCH 07/28] Core.formatProgram to produce round-trip-parseable output for all constructs (#1165) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes #1158 Supersedes #1036 ## Summary Fixes several issues with `Core.formatProgram` that prevented round-trip parsing: 1. **`inline function` formatted without space** — The `inline` grammar op now includes a trailing space, preventing `inlinefunction` concatenation. The formatter also now emits the `inline` attribute when present on functions. 2. **Quantifier variable names** — The formatter now uses the `prettyName` field from `LExpr.quant` instead of generating `__qN` names, preserving the original variable names through formatting. 3. **Overflow predicates** — Added grammar entries, formatter handling, parser entries, and Factory operations for all bitvector overflow predicates (`SNegOverflow`, `UNegOverflow`, `SAddOverflow`, `SSubOverflow`, `SMulOverflow`, `SDivOverflow`, `UAddOverflow`, `USubOverflow`, `UMulOverflow`). `SNegOverflow` and `UNegOverflow` use distinct grammar entries (`Bv.SNegOverflow` / `Bv.UNegOverflow`) to preserve their different semantics through roundtrip. The translate direction correctly dispatches overflow ops by type parameter (bv1/bv8/bv16/bv32/bv64), logging an error for unsupported widths. 4. **Array assignment (`lhsArray`)** — Implemented `m[k] := v` translation in both directions: the parser decomposes nested LHS into base identifier + indices and builds `map_update` expressions; the formatter detects the `map_update(var, idx, val)` pattern and produces `lhsArray` syntax. 5. **`Sequence.empty`** — Added grammar entry with explicit type annotation syntax (`Sequence.empty()`), plus translate and format handling, resolving the 0-ary polymorphic function limitation for this operation. Includes solver verification tests (cherry-picked from #1036) covering basic usage and various element types. 6. **Datatype roundtrip** — Verified that datatype formatting roundtrips correctly (the extra-parentheses issue noted earlier is resolved). 7. **Roundtrip test infrastructure** — Added `RoundtripTest.lean` that verifies parse → format → re-parse → re-format produces stable output for types, functions, procedures, inline functions, parameterized type arguments, datatypes, array assignments, and `Sequence.empty`. 8. **`getLFuncCall` reuse** — Refactored `lappToExpr` and `decomposeMapUpdate` to use `getLFuncCall` for decomposing nested applications, reducing code duplication with the existing utility. ## Testing - All existing tests pass (with expected output updates for the formatting improvements) - New roundtrip tests verify types, functions, procedures, inline functions, parameterized type arguments, datatypes, lhsArray, and Sequence.empty - Solver verification tests for Sequence.empty (from #1036) pass ## Remaining limitations - Bitvector operations with widths beyond 1/8/16/32/64 log an error and fall back to bv64 (requires grammar-level type entries per width) --------- Co-authored-by: Aaron Tomb --- ...evantAxioms.removeIrrelevantAxioms.core.st | 6 +- .../Languages/Core/DDMTransform/ASTtoCST.lean | 4 +- .../Core/DDMTransform/FormatCore.lean | 130 +++++++--- .../Languages/Core/DDMTransform/Grammar.lean | 18 +- .../Core/DDMTransform/Translate.lean | 118 ++++++++- Strata/Languages/Core/Factory.lean | 6 +- .../Languages/Core/Examples/AdvancedMaps.lean | 8 +- .../Core/Examples/AdvancedQuantifiers.lean | 4 +- .../Languages/Core/Examples/Axioms.lean | 16 +- .../Core/Examples/FunctionPreconditions.lean | 2 +- StrataTest/Languages/Core/Examples/Loops.lean | 1 + .../Languages/Core/Examples/Quantifiers.lean | 56 ++--- .../Examples/QuantifiersWithTypeAliases.lean | 16 +- StrataTest/Languages/Core/Examples/Seq.lean | 166 +++++++++++++ .../Core/Examples/SubstFvarsCaptureTests.lean | 4 +- .../Examples/TypeVarImplicitlyQuantified.lean | 8 +- .../Languages/Core/Tests/GeneratedLabels.lean | 16 +- .../Core/Tests/LambdaHigherOrderTests.lean | 2 +- .../Tests/MutualRecursiveFunctionTests.lean | 16 +- .../Core/Tests/ProgramEvalTests.lean | 100 ++++---- .../Core/Tests/QuantifierBvarIndexTest.lean | 4 +- .../Core/Tests/RecursiveFunctionTests.lean | 24 +- .../Languages/Core/Tests/RoundtripTest.lean | 235 ++++++++++++++++++ .../Core/Tests/TerminationCheckTests.lean | 104 ++++---- .../Languages/Core/Tests/TestASTtoCST.lean | 24 +- editors/emacs/core-st-mode.el | 16 +- .../vscode/syntaxes/core-st.tmLanguage.json | 2 +- 27 files changed, 836 insertions(+), 270 deletions(-) create mode 100644 StrataTest/Languages/Core/Tests/RoundtripTest.lean diff --git a/Examples/expected/IrrelevantAxioms.removeIrrelevantAxioms.core.st b/Examples/expected/IrrelevantAxioms.removeIrrelevantAxioms.core.st index 3b5e32dd3d..21fde32b64 100644 --- a/Examples/expected/IrrelevantAxioms.removeIrrelevantAxioms.core.st +++ b/Examples/expected/IrrelevantAxioms.removeIrrelevantAxioms.core.st @@ -1,11 +1,11 @@ program Core; function f (x : int) : int; -axiom [f_positive]: forall __q0 : int :: f(__q0) > 0; -axiom [f_monotone]: forall __q0 : int :: forall __q1 : int :: __q0 < __q1 ==> f(__q0) < f(__q1); +axiom [f_positive]: forall x : int :: f(x) > 0; +axiom [f_monotone]: forall x : int :: forall y : int :: x < y ==> f(x) < f(y); function g (x : int) : int; function h (x : int) : int; -axiom [h_def]: forall __q0 : int :: h(__q0) == f(__q0) + 1; +axiom [h_def]: forall x : int :: h(x) == f(x) + 1; procedure TestF (x : int, out result : int) spec { ensures [result_positive]: result > 0; diff --git a/Strata/Languages/Core/DDMTransform/ASTtoCST.lean b/Strata/Languages/Core/DDMTransform/ASTtoCST.lean index b74f973594..805805f413 100644 --- a/Strata/Languages/Core/DDMTransform/ASTtoCST.lean +++ b/Strata/Languages/Core/DDMTransform/ASTtoCST.lean @@ -195,7 +195,9 @@ def funcToCST {M} [Inhabited M] -- Convert preconditions let preconds ← precondsToSpecElts func.preconditions let bodyExpr ← lexprToExpr body 0 - let inline? : Ann (Option (Inline M)) M := ⟨default, none⟩ + let inline? : Ann (Option (Inline M)) M := + if func.attr.any (· == .inline) then ⟨default, some (.inline default)⟩ + else ⟨default, none⟩ pure (.command_fndef default name typeArgs b r preconds bodyExpr inline?) modify ToCSTContext.popScope -- Register function name as free variable. diff --git a/Strata/Languages/Core/DDMTransform/FormatCore.lean b/Strata/Languages/Core/DDMTransform/FormatCore.lean index 0af86ae9b8..0bc517fd8a 100644 --- a/Strata/Languages/Core/DDMTransform/FormatCore.lean +++ b/Strata/Languages/Core/DDMTransform/FormatCore.lean @@ -37,8 +37,6 @@ Known issues: translation in the latter's metadata field and recover them in the future. - Misc. formatting issues - -- Remove extra parentheses around constructors in datatypes, assignments, - etc. -- Remove extra indentation from the last brace of a block or the `end` keyword of a mutual block. -/ @@ -295,11 +293,21 @@ def handleZeroaryOps {M} [Inhabited M] (name : String) | .re .All => pure (.re_all default) | .re .AllChar => pure (.re_allchar default) | .re .None => pure (.re_none default) - -- TODO: seq_empty is not yet parseable (see Grammar.lean); handle here when added. | _ => do ToCSTM.logError "lopToExpr" "0-ary op not found" name pure (.re_none default) +/-- Convert a bitvector width to the corresponding CoreType, logging an error and + falling back to bv64 for unsupported widths. -/ +def bvTypeOfWidth {M} [Inhabited M] (caller : String) (w : Nat) : ToCSTM M (CoreType M) := + match w with + | 1 => pure (CoreType.bv1 default) | 8 => pure (.bv8 default) + | 16 => pure (.bv16 default) | 32 => pure (.bv32 default) + | 64 => pure (.bv64 default) + | _ => do + ToCSTM.logError caller s!"unsupported BV width {w}" (toString w) + pure (.bv64 default) + /-- Handle unary operations -/ def handleUnaryOps {M} [Inhabited M] (name : String) (arg : CoreDDM.Expr M) : ToCSTM M (CoreDDM.Expr M) := @@ -338,8 +346,13 @@ def handleUnaryOps {M} [Inhabited M] (name : String) (arg : CoreDDM.Expr M) | .bv ⟨16, .SafeNeg⟩ | .bv ⟨16, .SafeUNeg⟩ => pure (.safeneg_expr default (.bv16 default) arg) | .bv ⟨32, .SafeNeg⟩ | .bv ⟨32, .SafeUNeg⟩ => pure (.safeneg_expr default (.bv32 default) arg) | .bv ⟨64, .SafeNeg⟩ | .bv ⟨64, .SafeUNeg⟩ => pure (.safeneg_expr default (.bv64 default) arg) - -- Overflow predicates: approximated as Bool.Not for CST printing - | .bv ⟨_, .SNegOverflow⟩ | .bv ⟨_, .UNegOverflow⟩ => pure (.not default arg) + -- Overflow predicates + | .bv ⟨w, .SNegOverflow⟩ => do + let bvTy ← bvTypeOfWidth "handleUnaryOps" w + pure (.bv_neg_overflow default bvTy arg) + | .bv ⟨w, .UNegOverflow⟩ => do + let bvTy ← bvTypeOfWidth "handleUnaryOps" w + pure (.bv_uneg_overflow default bvTy arg) -- Bitvector extract ops | .bvExtract 8 7 7 => pure (.bvextract_7_7 default arg) | .bvExtract 16 15 15 => pure (.bvextract_15_15 default arg) @@ -386,14 +399,14 @@ def bvBinaryOpMap {M} [Inhabited M] : (.SafeUAdd, fun ty arg1 arg2 => .safeadd_expr default ty arg1 arg2), (.SafeUSub, fun ty arg1 arg2 => .safesub_expr default ty arg1 arg2), (.SafeUMul, fun ty arg1 arg2 => .safemul_expr default ty arg1 arg2), - -- Overflow predicates: approximated as boolean ops for CST printing - (.SAddOverflow, fun _ty arg1 arg2 => .le default _ty arg1 arg2), - (.SSubOverflow, fun _ty arg1 arg2 => .le default _ty arg1 arg2), - (.SMulOverflow, fun _ty arg1 arg2 => .le default _ty arg1 arg2), - (.SDivOverflow, fun _ty arg1 arg2 => .le default _ty arg1 arg2), - (.UAddOverflow, fun _ty arg1 arg2 => .le default _ty arg1 arg2), - (.USubOverflow, fun _ty arg1 arg2 => .le default _ty arg1 arg2), - (.UMulOverflow, fun _ty arg1 arg2 => .le default _ty arg1 arg2) + -- Overflow predicates + (.SAddOverflow, fun ty arg1 arg2 => .bv_sadd_overflow default ty arg1 arg2), + (.SSubOverflow, fun ty arg1 arg2 => .bv_ssub_overflow default ty arg1 arg2), + (.SMulOverflow, fun ty arg1 arg2 => .bv_smul_overflow default ty arg1 arg2), + (.SDivOverflow, fun ty arg1 arg2 => .bv_sdiv_overflow default ty arg1 arg2), + (.UAddOverflow, fun ty arg1 arg2 => .bv_uadd_overflow default ty arg1 arg2), + (.USubOverflow, fun ty arg1 arg2 => .bv_usub_overflow default ty arg1 arg2), + (.UMulOverflow, fun ty arg1 arg2 => .bv_umul_overflow default ty arg1 arg2) ] /-- Map from bitvector sizes to their corresponding type constructors -/ @@ -551,11 +564,19 @@ partial def lexprToExpr {M} [Inhabited M] pure (.fvar default (ctx.allFreeVars.size)) | .ite _ c t f => liteToExpr c t f qLevel | .eq _ e1 e2 => leqToExpr e1 e2 qLevel - | .op _ name _ => lopToExpr name.name [] + | .op _ name ty => do + -- seq_empty needs the type annotation to render the explicit type parameter + if name.name == "Sequence.empty" then + let tyCST ← match ty with + | some (.tcons "Sequence" [ety]) => lmonoTyToCoreType ety + | _ => pure (CoreType.tvar default unknownTypeVar) + pure (.seq_empty default tyCST) + else + lopToExpr name.name [] | .app _ _ _ => lappToExpr e qLevel | .abs _ prettyName ty body => labsToExpr prettyName ty body (qLevel + 1) - | .quant _ qkind _ ty trigger body => - lquantToExpr qkind ty trigger body (qLevel + 1) + | .quant _ qkind prettyName ty trigger body => + lquantToExpr qkind prettyName ty trigger body (qLevel + 1) /-- Extract trigger patterns from Lambda's trigger expression representation -/ partial def extractTriggerPatterns {M} [Inhabited M] @@ -609,11 +630,13 @@ partial def labsToExpr {M} [Inhabited M] pure (.lambda default tyExpr dl bodyExpr) partial def lquantToExpr {M} [Inhabited M] - (qkind : Lambda.QuantifierKind) (ty : Option Lambda.LMonoTy) + (qkind : Lambda.QuantifierKind) (prettyName : String) + (ty : Option Lambda.LMonoTy) (trigger : Lambda.LExpr CoreLParams.mono) (body : Lambda.LExpr CoreLParams.mono) (qLevel : Nat) : ToCSTM M (CoreDDM.Expr M) := do - let name : Ann String M := ⟨default, mkQuantVarName (qLevel - 1)⟩ + let varName := if prettyName.isEmpty then mkQuantVarName (qLevel - 1) else prettyName + let name : Ann String M := ⟨default, varName⟩ modify ToCSTContext.pushScope modify (·.addScopedBoundVars #[name.val]) let tyExpr ← match ty with @@ -661,23 +684,23 @@ partial def leqToExpr {M} [Inhabited M] partial def lappToExpr {M} [Inhabited M] (e : Lambda.LExpr CoreLParams.mono) - (qLevel : Nat) (acc : List (CoreDDM.Expr M) := []) - : ToCSTM M (CoreDDM.Expr M) := - match e with - | .app _ (.app m fn e1) e2 => do - let e2Expr ← lexprToExpr e2 qLevel - lappToExpr (.app m fn e1) qLevel (e2Expr :: acc) - | .app _ (.op _ fn _) e1 => do - let e1Expr ← lexprToExpr e1 qLevel - lopToExpr fn.name (e1Expr :: acc) - | .app _ fn e1 => do + (qLevel : Nat) + : ToCSTM M (CoreDDM.Expr M) := do + let (head, args) := Lambda.getLFuncCall e + match head with + | .op _ fn _ => + let argExprs ← args.mapM (lexprToExpr · qLevel) + lopToExpr fn.name argExprs + | .app _ fn arg => + -- getLFuncCall couldn't decompose further (fn is not .app or .op) let fnCST ← lexprToExpr fn qLevel - let e1Expr ← lexprToExpr e1 qLevel - pure <| (e1Expr :: acc).foldl (fun fnAcc arg => .app default fnAcc arg) fnCST - | _ => do - -- Non-application head (e.g. lambda applied to arguments) - let eCST ← lexprToExpr e qLevel - pure <| acc.foldl (fun fnAcc arg => .app default fnAcc arg) eCST + let argCST ← lexprToExpr arg qLevel + let argExprs ← args.mapM (lexprToExpr · qLevel) + pure <| (argCST :: argExprs).foldl (fun fnAcc a => .app default fnAcc a) fnCST + | _ => + let fnCST ← lexprToExpr head qLevel + let argExprs ← args.mapM (lexprToExpr · qLevel) + pure <| argExprs.foldl (fun fnAcc arg => .app default fnAcc arg) fnCST end /-- Convert preconditions to CST spec elements -/ @@ -717,7 +740,9 @@ def funcDeclToStatement {M} [Inhabited M] (decl : Imperative.PureFunc Expression let paramNames := results.map (·.2) let b : Bindings M := .mkBindings default ⟨default, bindings⟩ let r ← lTyToCoreType decl.output - let inline? : Ann (Option (Inline M)) M := ⟨default, none⟩ + let inline? : Ann (Option (Inline M)) M := + if decl.attr.any (· == .inline) then ⟨default, some (.inline default)⟩ + else ⟨default, none⟩ -- Add formals to the context modify (·.addScopedBoundVars (reverse? := false) paramNames) -- Convert preconditions @@ -735,6 +760,24 @@ def funcDeclToStatement {M} [Inhabited M] (decl : Imperative.PureFunc Expression modify (·.pushBoundVar name.val) pure (.funcDecl_statement default name typeArgs b r preconds bodyExpr inline?) +/-- Decompose a single-level `map_update(base, idx, val)` where `base` is (or starts + with) an fvar matching `varName`. Returns `(indices, innerVal)` with indices + in left-to-right order, or `none` if the expression is not this pattern. -/ +private def decomposeMapUpdate (varName : String) + (e : Lambda.LExpr CoreLParams.mono) + : Option (List (Lambda.LExpr CoreLParams.mono) × Lambda.LExpr CoreLParams.mono) := + let (head, args) := Lambda.getLFuncCall e + match head, args with + | .op _ opName _, [base, idx, val] => + if opName.name == "update" then + match base with + | .fvar _ ident _ => + if ident.name == varName then some ([idx], val) + else none + | _ => none + else none + | _, _ => none + mutual /-- Convert `Core.Statement` to `CoreDDM.Statement` -/ partial def stmtToCST {M} [Inhabited M] (s : Core.Statement) @@ -758,9 +801,20 @@ partial def stmtToCST {M} [Inhabited M] (s : Core.Statement) modify (·.pushBoundVar name.toPretty) pure result | .set name expr _md => do - let lhs := Lhs.lhsIdent default ⟨default, name.name⟩ - let exprCST ← lexprToExpr expr 0 - -- Type annotation required by CST but not semantically used. + -- Detect map_update(name, idx, val) pattern to produce lhsArray syntax + let (lhs, exprCST) ← match decomposeMapUpdate name.name expr with + | some (idxs, val) => do + let baseLhs := Lhs.lhsIdent default ⟨default, name.name⟩ + let lhs ← idxs.foldlM (init := baseLhs) fun acc idx => do + let idxCST ← lexprToExpr idx 0 + let tyCST := CoreType.tvar default unknownTypeVar + pure (Lhs.lhsArray default tyCST acc idxCST) + let valCST ← lexprToExpr val 0 + pure (lhs, valCST) + | none => do + let lhs := Lhs.lhsIdent default ⟨default, name.name⟩ + let exprCST ← lexprToExpr expr 0 + pure (lhs, exprCST) let tyCST := CoreType.tvar default unknownTypeVar pure (.assign default tyCST lhs exprCST) | .havoc name _md => do diff --git a/Strata/Languages/Core/DDMTransform/Grammar.lean b/Strata/Languages/Core/DDMTransform/Grammar.lean index 206b72e7d5..0375a10596 100644 --- a/Strata/Languages/Core/DDMTransform/Grammar.lean +++ b/Strata/Languages/Core/DDMTransform/Grammar.lean @@ -103,9 +103,9 @@ fn map_get (K : Type, V : Type, m : Map K V, k : K) : V => m "[" k "]"; fn map_set (K : Type, V : Type, m : Map K V, k : K, v : V) : Map K V => m "[" k ":=" v "]"; -// TODO: seq_empty is not yet supported in the grammar because the DDM parser -// cannot currently handle 0-ary polymorphic functions (no arguments to infer -// the type parameter from). The Factory definition exists for programmatic use. +// seq_empty uses explicit type annotation syntax since there are no value +// arguments to infer the type parameter from. +fn seq_empty (A : Type) : Sequence A => "Sequence.empty" "<" A ">" "(" ")"; fn seq_length (A : Type, s : Sequence A) : int => "Sequence.length" "(" s ")"; fn seq_select (A : Type, s : Sequence A, i : int) : A => "Sequence.select" "(" s ", " i ")"; fn seq_append (A : Type, s1 : Sequence A, s2 : Sequence A) : Sequence A => @@ -188,6 +188,16 @@ fn bvsle (tp : Type, a : tp, b : tp) : bool => @[prec(20), leftassoc] a " <=s " fn bvsgt (tp : Type, a : tp, b : tp) : bool => @[prec(20), leftassoc] a " >s " b; fn bvsge (tp : Type, a : tp, b : tp) : bool => @[prec(20), leftassoc] a " >=s " b; +fn bv_neg_overflow (tp : Type, a : tp) : bool => "Bv.SNegOverflow" "(" a ")"; +fn bv_uneg_overflow (tp : Type, a : tp) : bool => "Bv.UNegOverflow" "(" a ")"; +fn bv_sadd_overflow (tp : Type, a : tp, b : tp) : bool => "Bv.SAddOverflow" "(" a ", " b ")"; +fn bv_ssub_overflow (tp : Type, a : tp, b : tp) : bool => "Bv.SSubOverflow" "(" a ", " b ")"; +fn bv_smul_overflow (tp : Type, a : tp, b : tp) : bool => "Bv.SMulOverflow" "(" a ", " b ")"; +fn bv_sdiv_overflow (tp : Type, a : tp, b : tp) : bool => "Bv.SDivOverflow" "(" a ", " b ")"; +fn bv_uadd_overflow (tp : Type, a : tp, b : tp) : bool => "Bv.UAddOverflow" "(" a ", " b ")"; +fn bv_usub_overflow (tp : Type, a : tp, b : tp) : bool => "Bv.USubOverflow" "(" a ", " b ")"; +fn bv_umul_overflow (tp : Type, a : tp, b : tp) : bool => "Bv.UMulOverflow" "(" a ", " b ")"; + fn bvconcat8 (a : bv8, b : bv8) : bv16 => "bvconcat{8}{8}" "(" a ", " b ")"; fn bvconcat16 (a : bv16, b : bv16) : bv32 => "bvconcat{16}{16}" "(" a ", " b ")"; fn bvconcat32 (a : bv32, b : bv32) : bv64 => "bvconcat{32}{32}" "(" a ", " b ")"; @@ -354,7 +364,7 @@ op command_fndecl (name : Ident, "function " name typeArgs b " : " r ";\n"; category Inline; -op inline () : Inline => "inline"; +op inline () : Inline => "inline "; // Note: when editing command_fndef, consider whether recfn_decl needs // matching edits. diff --git a/Strata/Languages/Core/DDMTransform/Translate.lean b/Strata/Languages/Core/DDMTransform/Translate.lean index 3eeb98ac4d..1fa2b4fe95 100644 --- a/Strata/Languages/Core/DDMTransform/Translate.lean +++ b/Strata/Languages/Core/DDMTransform/Translate.lean @@ -355,14 +355,6 @@ def translateTypeDecl (bindings : TransBindings) (op : Operation) : --------------------------------------------------------------------- -def translateLhs (arg : Arg) : TransM Core.CoreIdent := do - let .op op := arg - | TransM.error s!"translateLhs expected op {repr arg}" - match op.name, op.args with - | q`Core.lhsIdent, #[id] => translateIdent Core.CoreIdent id - -- (TODO) Implement lhsArray. - | _, _ => TransM.error s!"translateLhs: unimplemented for {repr arg}" - def translateBindMk (bindings : TransBindings) (arg : Arg) : TransM (Core.CoreIdent × List TyIdentifier × LMonoTy) := do let .op op := arg @@ -664,6 +656,52 @@ def translateFn (ty? : Option LMonoTy) (q : QualifiedIdent) : TransM Core.Expres | _, q`Core.bvextract_15_0_64 => return Core.bv64Extract_15_0_Op | _, q`Core.bvextract_31_0_64 => return Core.bv64Extract_31_0_Op + | .some .bv1, q`Core.bv_neg_overflow => return Core.bv1SNegOverflowOp + | .some .bv1, q`Core.bv_uneg_overflow => return Core.bv1UNegOverflowOp + | .some .bv1, q`Core.bv_sadd_overflow => return Core.bv1SAddOverflowOp + | .some .bv1, q`Core.bv_ssub_overflow => return Core.bv1SSubOverflowOp + | .some .bv1, q`Core.bv_smul_overflow => return Core.bv1SMulOverflowOp + | .some .bv1, q`Core.bv_sdiv_overflow => return Core.bv1SDivOverflowOp + | .some .bv1, q`Core.bv_uadd_overflow => return Core.bv1UAddOverflowOp + | .some .bv1, q`Core.bv_usub_overflow => return Core.bv1USubOverflowOp + | .some .bv1, q`Core.bv_umul_overflow => return Core.bv1UMulOverflowOp + | .some .bv8, q`Core.bv_neg_overflow => return Core.bv8SNegOverflowOp + | .some .bv8, q`Core.bv_uneg_overflow => return Core.bv8UNegOverflowOp + | .some .bv8, q`Core.bv_sadd_overflow => return Core.bv8SAddOverflowOp + | .some .bv8, q`Core.bv_ssub_overflow => return Core.bv8SSubOverflowOp + | .some .bv8, q`Core.bv_smul_overflow => return Core.bv8SMulOverflowOp + | .some .bv8, q`Core.bv_sdiv_overflow => return Core.bv8SDivOverflowOp + | .some .bv8, q`Core.bv_uadd_overflow => return Core.bv8UAddOverflowOp + | .some .bv8, q`Core.bv_usub_overflow => return Core.bv8USubOverflowOp + | .some .bv8, q`Core.bv_umul_overflow => return Core.bv8UMulOverflowOp + | .some .bv16, q`Core.bv_neg_overflow => return Core.bv16SNegOverflowOp + | .some .bv16, q`Core.bv_uneg_overflow => return Core.bv16UNegOverflowOp + | .some .bv16, q`Core.bv_sadd_overflow => return Core.bv16SAddOverflowOp + | .some .bv16, q`Core.bv_ssub_overflow => return Core.bv16SSubOverflowOp + | .some .bv16, q`Core.bv_smul_overflow => return Core.bv16SMulOverflowOp + | .some .bv16, q`Core.bv_sdiv_overflow => return Core.bv16SDivOverflowOp + | .some .bv16, q`Core.bv_uadd_overflow => return Core.bv16UAddOverflowOp + | .some .bv16, q`Core.bv_usub_overflow => return Core.bv16USubOverflowOp + | .some .bv16, q`Core.bv_umul_overflow => return Core.bv16UMulOverflowOp + | .some .bv32, q`Core.bv_neg_overflow => return Core.bv32SNegOverflowOp + | .some .bv32, q`Core.bv_uneg_overflow => return Core.bv32UNegOverflowOp + | .some .bv32, q`Core.bv_sadd_overflow => return Core.bv32SAddOverflowOp + | .some .bv32, q`Core.bv_ssub_overflow => return Core.bv32SSubOverflowOp + | .some .bv32, q`Core.bv_smul_overflow => return Core.bv32SMulOverflowOp + | .some .bv32, q`Core.bv_sdiv_overflow => return Core.bv32SDivOverflowOp + | .some .bv32, q`Core.bv_uadd_overflow => return Core.bv32UAddOverflowOp + | .some .bv32, q`Core.bv_usub_overflow => return Core.bv32USubOverflowOp + | .some .bv32, q`Core.bv_umul_overflow => return Core.bv32UMulOverflowOp + | .some .bv64, q`Core.bv_neg_overflow => return Core.bv64SNegOverflowOp + | .some .bv64, q`Core.bv_uneg_overflow => return Core.bv64UNegOverflowOp + | .some .bv64, q`Core.bv_sadd_overflow => return Core.bv64SAddOverflowOp + | .some .bv64, q`Core.bv_ssub_overflow => return Core.bv64SSubOverflowOp + | .some .bv64, q`Core.bv_smul_overflow => return Core.bv64SMulOverflowOp + | .some .bv64, q`Core.bv_sdiv_overflow => return Core.bv64SDivOverflowOp + | .some .bv64, q`Core.bv_uadd_overflow => return Core.bv64UAddOverflowOp + | .some .bv64, q`Core.bv_usub_overflow => return Core.bv64USubOverflowOp + | .some .bv64, q`Core.bv_umul_overflow => return Core.bv64UMulOverflowOp + | _, q`Core.str_len => return Core.strLengthOp | _, q`Core.str_concat => return Core.strConcatOp | _, q`Core.str_substr => return Core.strSubstrOp @@ -845,6 +883,13 @@ partial def translateExpr (p : Program) (bindings : TransBindings) (arg : Arg) : | .fn _ q`Core.re_all, [] => let fn ← translateFn .none q`Core.re_all return fn + -- Sequence.empty (1 type arg, 0 value args) + | .fn _ q`Core.seq_empty, [_atp] => + let ety ← translateLMonoTy bindings _atp + let fn : LExpr Core.CoreLParams.mono := + Core.coreOpExpr (.seq .Empty) + (.some (Core.seqTy ety)) + return fn -- Unary function applications | .fn _ fni, [xa] => match fni with @@ -877,6 +922,16 @@ partial def translateExpr (p : Program) (bindings : TransBindings) (arg : Arg) : let fn ← translateFn ty q`Core.safeneg_expr let x ← translateExpr p bindings xa return .mkApp () fn [x] + | .fn _ q`Core.bv_neg_overflow, [tpa, xa] => + let ty ← translateLMonoTy bindings (dealiasTypeArg p tpa) + let fn ← translateFn ty q`Core.bv_neg_overflow + let x ← translateExpr p bindings xa + return .mkApp () fn [x] + | .fn _ q`Core.bv_uneg_overflow, [tpa, xa] => + let ty ← translateLMonoTy bindings (dealiasTypeArg p tpa) + let fn ← translateFn ty q`Core.bv_uneg_overflow + let x ← translateExpr p bindings xa + return .mkApp () fn [x] -- Strings | .fn _ q`Core.str_concat, [xa, ya] => let x ← translateExpr p bindings xa @@ -910,7 +965,6 @@ partial def translateExpr (p : Program) (bindings : TransBindings) (arg : Arg) : let x ← translateExpr p bindings xa return .mkApp () fn [m, i, x] -- Seq operations - -- TODO: seq_empty is not yet parseable (see Grammar.lean); handle here when added. | .fn _ q`Core.seq_length, [_atp, sa] => let ety ← translateLMonoTy bindings _atp let fn : LExpr Core.CoreLParams.mono := @@ -1042,7 +1096,14 @@ partial def translateExpr (p : Program) (bindings : TransBindings) (arg : Arg) : | q`Core.bvsle | q`Core.bvslt | q`Core.bvsgt - | q`Core.bvsge => + | q`Core.bvsge + | q`Core.bv_sadd_overflow + | q`Core.bv_ssub_overflow + | q`Core.bv_smul_overflow + | q`Core.bv_sdiv_overflow + | q`Core.bv_uadd_overflow + | q`Core.bv_usub_overflow + | q`Core.bv_umul_overflow => let ty ← translateLMonoTy bindings (dealiasTypeArg p tpa) if ¬ isArithTy ty then TransM.error s!"translateExpr unexpected type for {repr fni}: {repr args}" @@ -1225,6 +1286,36 @@ private def translateCondBool (p : Program) (bindings : TransBindings) (a : Arg) | q`Core.condDet, #[ca] => pure (.det (← translateExpr p bindings ca)) | _, _ => TransM.error s!"translateCondBool: unexpected {repr op.name}" +/-- Build a nested map-update expression: `nestMapUpdate base [i1, i2] v` produces + `map_update(base, i1, map_update(map_select(base, i1), i2, v))`. -/ +private def nestMapUpdate (base : Core.Expression.Expr) (idxs : List Core.Expression.Expr) + (rhs : Core.Expression.Expr) : Core.Expression.Expr := + let selectOp := Core.coreOpExpr (.map .Select) + let updateOp := Core.coreOpExpr (.map .Update) + match idxs with + | [] => rhs + | [i] => .mkApp () updateOp [base, i, rhs] + | i :: rest => + let inner := .mkApp () selectOp [base, i] + let updatedInner := nestMapUpdate inner rest rhs + .mkApp () updateOp [base, i, updatedInner] + +/-- Decompose an LHS into a base identifier and a (reversed) list of index + expressions. For `m[k1][k2]`, returns `(m, [k2, k1])`. -/ +partial def translateLhsParts (p : Program) (bindings : TransBindings) (arg : Arg) : + TransM (Core.CoreIdent × List Core.Expression.Expr) := do + let .op op := arg + | TransM.error s!"translateLhsParts expected op {repr arg}" + match op.name, op.args with + | q`Core.lhsIdent, #[id] => + let ident ← translateIdent Core.CoreIdent id + return (ident, []) + | q`Core.lhsArray, #[_tpa, lhsa, idxa] => + let (ident, idxsRev) ← translateLhsParts p bindings lhsa + let idx ← translateExpr p bindings idxa + return (ident, idx :: idxsRev) + | _, _ => TransM.error s!"translateLhsParts: unimplemented for {repr arg}" + mutual partial def translateFnPreconds (p : Program) (name : Core.CoreIdent) (bindings : TransBindings) (arg : Arg) : TransM (List (Strata.DL.Util.FuncPrecondition Core.Expression.Expr Core.Expression.ExprMetadata)) := do @@ -1255,10 +1346,13 @@ partial def translateStmt (p : Program) (bindings : TransBindings) (arg : Arg) : | q`Core.initStatement, args => translateInitStatement p bindings args (← getOpMetaData op) | q`Core.assign, #[_tpa, lhsa, ea] => - let lhs ← translateLhs lhsa + let (lhs, idxsRev) ← translateLhsParts p bindings lhsa let val ← translateExpr p bindings ea let md ← getOpMetaData op - return ([.set lhs val md], bindings) + let rhs := match idxsRev.reverse with + | [] => val + | idxs => nestMapUpdate (.fvar () lhs none) idxs val + return ([.set lhs rhs md], bindings) | q`Core.havoc_statement, #[ida] => let id ← translateIdent Core.CoreIdent ida let md ← getOpMetaData op diff --git a/Strata/Languages/Core/Factory.lean b/Strata/Languages/Core/Factory.lean index ef99656a5b..0fedf025c4 100644 --- a/Strata/Languages/Core/Factory.lean +++ b/Strata/Languages/Core/Factory.lean @@ -432,9 +432,9 @@ def seqLengthFunc : WFLFunc CoreLParams := ]) /- An empty `Sequence` constructor with type `∀a. Sequence a`. - NOTE: This is registered in the Factory for programmatic use, but is not yet - parseable from `.st` files because the DDM grammar cannot currently handle - 0-ary polymorphic functions (no arguments to infer the type parameter from). -/ + `Sequence.empty()` returns an empty sequence of element type `A`. + The `` is surface syntax produced by Grammar.lean and consumed by + Translate.lean; this function itself takes no value parameters. -/ def seqEmptyFunc : WFLFunc CoreLParams := polyUneval "Sequence.empty" ["a"] [] (seqTy mty[%a]) (axioms := [ diff --git a/StrataTest/Languages/Core/Examples/AdvancedMaps.lean b/StrataTest/Languages/Core/Examples/AdvancedMaps.lean index 1de2d946c6..1af27aa0fc 100644 --- a/StrataTest/Languages/Core/Examples/AdvancedMaps.lean +++ b/StrataTest/Languages/Core/Examples/AdvancedMaps.lean @@ -59,15 +59,15 @@ spec { requires [P_requires_1]: c[0] == a; } { assert [c_0_eq_a]: c[0] == a; - c := c[1:=a]; + c[1] := a; assert [c_1_eq_a]: c[1] == a; assert [a0eq0]: a[0] == 0; - a := a[1:=1]; + a[1] := 1; assert [a1eq1]: a[1] == 1; - a := a[0:=1]; + a[0] := 1; assert [a0eq1]: a[0] == 1; assert [a0neq2]: !(a[0] == 2); - b := b[true:=-1]; + b[true] := -1; assert [bTrueEqTrue]: b[true] == -1; assert [mix]: a[1] == -(b[true]); }; diff --git a/StrataTest/Languages/Core/Examples/AdvancedQuantifiers.lean b/StrataTest/Languages/Core/Examples/AdvancedQuantifiers.lean index 758a8a0a5f..aac3dcd880 100644 --- a/StrataTest/Languages/Core/Examples/AdvancedQuantifiers.lean +++ b/StrataTest/Languages/Core/Examples/AdvancedQuantifiers.lean @@ -32,14 +32,14 @@ VCs: Label: a Property: assert Assumptions: -mapAllValues0: forall __q0 : (Map int int) :: forall __q1 : int :: __q0[__q1] == 0 +mapAllValues0: forall m : (Map int int) :: forall k : int :: m[k] == 0 Obligation: mArg@1[kArg@1] == 0 Label: Update_ensures_0 Property: assert Assumptions: -mapAllValues0: forall __q0 : (Map int int) :: forall __q1 : int :: __q0[__q1] == 0 +mapAllValues0: forall m : (Map int int) :: forall k : int :: m[k] == 0 Obligation: mArg@1[kArg@1] == 0 diff --git a/StrataTest/Languages/Core/Examples/Axioms.lean b/StrataTest/Languages/Core/Examples/Axioms.lean index a763936907..6ed5ff4f5c 100644 --- a/StrataTest/Languages/Core/Examples/Axioms.lean +++ b/StrataTest/Languages/Core/Examples/Axioms.lean @@ -51,7 +51,7 @@ Property: assert Assumptions: a1: x == 5 a2: y == 2 -f1: forall __q0 : int :: f(__q0) > __q0 +f1: forall y : int :: f(y) > y Obligation: x > y @@ -60,7 +60,7 @@ Property: assert Assumptions: a1: x == 5 a2: y == 2 -f1: forall __q0 : int :: f(__q0) > __q0 +f1: forall y : int :: f(y) > y Obligation: f(x + y) > 7 @@ -69,7 +69,7 @@ Property: assert Assumptions: a1: x == 5 a2: y == 2 -f1: forall __q0 : int :: f(__q0) > __q0 +f1: forall y : int :: f(y) > y Obligation: y == 2 @@ -78,7 +78,7 @@ Property: assert Assumptions: a1: x == 5 a2: y == 2 -f1: forall __q0 : int :: f(__q0) > __q0 +f1: forall y : int :: f(y) > y Obligation: f(y) > y @@ -139,10 +139,10 @@ VCs: Label: axiomPgm2_main_assert Property: assert Assumptions: -f_g_ax: forall __q0 : int :: { f(__q0) } - f(__q0) == g(__q0) + 1 -g_ax: forall __q0 : int :: { g(__q0), f(__q0) } - g(__q0) == __q0 * 2 +f_g_ax: forall x : int :: { f(x) } + f(x) == g(x) + 1 +g_ax: forall x : int :: { g(x), f(x) } + g(x) == x * 2 Obligation: x@1 >= 0 ==> f(x@1) > x@1 diff --git a/StrataTest/Languages/Core/Examples/FunctionPreconditions.lean b/StrataTest/Languages/Core/Examples/FunctionPreconditions.lean index a33b03a92c..04f09ead9b 100644 --- a/StrataTest/Languages/Core/Examples/FunctionPreconditions.lean +++ b/StrataTest/Languages/Core/Examples/FunctionPreconditions.lean @@ -415,7 +415,7 @@ Property: assert Assumptions: precond_allPositiveDiv_0: y@2 >= 0 Obligation: -forall __q0 : int :: __q0 > 0 ==> !(__q0 == 0) +forall x : int :: x > 0 ==> !(x == 0) --- info: diff --git a/StrataTest/Languages/Core/Examples/Loops.lean b/StrataTest/Languages/Core/Examples/Loops.lean index 729c9c9a23..ddcddd7c62 100644 --- a/StrataTest/Languages/Core/Examples/Loops.lean +++ b/StrataTest/Languages/Core/Examples/Loops.lean @@ -384,6 +384,7 @@ loop_entry$_1: -- Errors encountered during conversion: Unsupported construct in lopToExpr: 0-ary op not found: top Context: Global scope: + freeVars: [n] var loop_measure$_2 : int; assume [assume_loop_measure$_2]: loop_measure$_2 == n - x; assert [measure_lb_loop_measure$_2]: !(loop_measure$_2 < 0); diff --git a/StrataTest/Languages/Core/Examples/Quantifiers.lean b/StrataTest/Languages/Core/Examples/Quantifiers.lean index 6436514ca4..825a5dd4d4 100644 --- a/StrataTest/Languages/Core/Examples/Quantifiers.lean +++ b/StrataTest/Languages/Core/Examples/Quantifiers.lean @@ -54,17 +54,17 @@ VCs: Label: good_assert Property: assert Obligation: -forall __q0 : int :: !(__q0 == __q0 + 1) +forall l : int :: !(l == l + 1) Label: good Property: assert Obligation: -forall __q0 : int :: exists __q1 : int :: x@1 + 1 + (__q1 + __q0) == __q0 + (__q1 + (x@1 + 1)) +forall y : int :: exists z : int :: x@1 + 1 + (z + y) == y + (z + (x@1 + 1)) Label: bad Property: assert Obligation: -forall __q0 : int :: __q0 < x@1 +forall q : int :: q < x@1 --- info: @@ -93,42 +93,42 @@ VCs: Label: trigger_assert Property: assert Assumptions: -f_pos: forall __q0 : int :: { f(__q0) } - f(__q0) > 0 -g_neg: forall __q0 : int :: forall __q1 : int :: { g(__q0, __q1) } - __q0 > 0 ==> g(__q0, __q1) < 0 -f_and_g: forall __q0 : int :: forall __q1 : int :: { g(__q0, __q1), f(__q0) } - g(__q0, __q1) < f(__q0) -f_and_g2: forall __q0 : int :: forall __q1 : int :: { g(__q0, __q1), f(__q0) } - g(__q0, __q1) < f(__q0) +f_pos: forall x : int :: { f(x) } + f(x) > 0 +g_neg: forall x : int :: forall y : int :: { g(x, y) } + x > 0 ==> g(x, y) < 0 +f_and_g: forall x : int :: forall y : int :: { g(x, y), f(x) } + g(x, y) < f(x) +f_and_g2: forall x : int :: forall y : int :: { g(x, y), f(x) } + g(x, y) < f(x) Obligation: f(x@1) > 0 Label: multi_trigger_assert Property: assert Assumptions: -f_pos: forall __q0 : int :: { f(__q0) } - f(__q0) > 0 -g_neg: forall __q0 : int :: forall __q1 : int :: { g(__q0, __q1) } - __q0 > 0 ==> g(__q0, __q1) < 0 -f_and_g: forall __q0 : int :: forall __q1 : int :: { g(__q0, __q1), f(__q0) } - g(__q0, __q1) < f(__q0) -f_and_g2: forall __q0 : int :: forall __q1 : int :: { g(__q0, __q1), f(__q0) } - g(__q0, __q1) < f(__q0) +f_pos: forall x : int :: { f(x) } + f(x) > 0 +g_neg: forall x : int :: forall y : int :: { g(x, y) } + x > 0 ==> g(x, y) < 0 +f_and_g: forall x : int :: forall y : int :: { g(x, y), f(x) } + g(x, y) < f(x) +f_and_g2: forall x : int :: forall y : int :: { g(x, y), f(x) } + g(x, y) < f(x) Obligation: -forall __q0 : int :: g(x@1, __q0) < f(x@1) +forall y : int :: g(x@1, y) < f(x@1) Label: f_and_g Property: assert Assumptions: -f_pos: forall __q0 : int :: { f(__q0) } - f(__q0) > 0 -g_neg: forall __q0 : int :: forall __q1 : int :: { g(__q0, __q1) } - __q0 > 0 ==> g(__q0, __q1) < 0 -f_and_g: forall __q0 : int :: forall __q1 : int :: { g(__q0, __q1), f(__q0) } - g(__q0, __q1) < f(__q0) -f_and_g2: forall __q0 : int :: forall __q1 : int :: { g(__q0, __q1), f(__q0) } - g(__q0, __q1) < f(__q0) +f_pos: forall x : int :: { f(x) } + f(x) > 0 +g_neg: forall x : int :: forall y : int :: { g(x, y) } + x > 0 ==> g(x, y) < 0 +f_and_g: forall x : int :: forall y : int :: { g(x, y), f(x) } + g(x, y) < f(x) +f_and_g2: forall x : int :: forall y : int :: { g(x, y), f(x) } + g(x, y) < f(x) Obligation: g(f(x@1), x@1) < 0 diff --git a/StrataTest/Languages/Core/Examples/QuantifiersWithTypeAliases.lean b/StrataTest/Languages/Core/Examples/QuantifiersWithTypeAliases.lean index cfebbf7c50..ac60917729 100644 --- a/StrataTest/Languages/Core/Examples/QuantifiersWithTypeAliases.lean +++ b/StrataTest/Languages/Core/Examples/QuantifiersWithTypeAliases.lean @@ -42,10 +42,10 @@ type Ref; type Field; type Struct := Map Field int; type Heap := Map Ref Struct; -axiom [axiom_0]: forall __q0 : Struct :: forall __q1 : Field :: forall __q2 : Field :: forall __q3 : int :: !(__q1 == __q2) ==> __q0[__q1] == (__q0[__q2:=__q3])[__q1]; -axiom [axiom_1]: forall __q0 : Struct :: forall __q1 : Field :: forall __q2 : int :: (__q0[__q1:=__q2])[__q1] == __q2; -axiom [axiom_2]: forall __q0 : Heap :: forall __q1 : Ref :: forall __q2 : Ref :: forall __q3 : Struct :: !(__q1 == __q2) ==> __q0[__q1] == (__q0[__q2:=__q3])[__q1]; -axiom [axiom_3]: forall __q0 : Heap :: forall __q1 : Ref :: forall __q2 : Struct :: (__q0[__q1:=__q2])[__q1] == __q2; +axiom [axiom_0]: forall m : Struct :: forall okk : Field :: forall kk : Field :: forall vv : int :: !(okk == kk) ==> m[okk] == (m[kk:=vv])[okk]; +axiom [axiom_1]: forall m : Struct :: forall kk : Field :: forall vv : int :: (m[kk:=vv])[kk] == vv; +axiom [axiom_2]: forall m : Heap :: forall okk : Ref :: forall kk : Ref :: forall vv : Struct :: !(okk == kk) ==> m[okk] == (m[kk:=vv])[okk]; +axiom [axiom_3]: forall m : Heap :: forall kk : Ref :: forall vv : Struct :: (m[kk:=vv])[kk] == vv; procedure test (h : Heap, ref : Ref, field : Field) { var newH : Heap := h[ref:=(h[ref])[field:=(h[ref])[field] + 1]]; @@ -64,10 +64,10 @@ VCs: Label: assert0 Property: assert Assumptions: -axiom_0: forall __q0 : (Map Field int) :: forall __q1 : Field :: forall __q2 : Field :: forall __q3 : int :: !(__q1 == __q2) ==> __q0[__q1] == (__q0[__q2:=__q3])[__q1] -axiom_1: forall __q0 : (Map Field int) :: forall __q1 : Field :: forall __q2 : int :: (__q0[__q1:=__q2])[__q1] == __q2 -axiom_2: forall __q0 : (Map Ref (Map Field int)) :: forall __q1 : Ref :: forall __q2 : Ref :: forall __q3 : (Map Field int) :: !(__q1 == __q2) ==> __q0[__q1] == (__q0[__q2:=__q3])[__q1] -axiom_3: forall __q0 : (Map Ref (Map Field int)) :: forall __q1 : Ref :: forall __q2 : (Map Field int) :: (__q0[__q1:=__q2])[__q1] == __q2 +axiom_0: forall m : (Map Field int) :: forall okk : Field :: forall kk : Field :: forall vv : int :: !(okk == kk) ==> m[okk] == (m[kk:=vv])[okk] +axiom_1: forall m : (Map Field int) :: forall kk : Field :: forall vv : int :: (m[kk:=vv])[kk] == vv +axiom_2: forall m : (Map Ref (Map Field int)) :: forall okk : Ref :: forall kk : Ref :: forall vv : (Map Field int) :: !(okk == kk) ==> m[okk] == (m[kk:=vv])[okk] +axiom_3: forall m : (Map Ref (Map Field int)) :: forall kk : Ref :: forall vv : (Map Field int) :: (m[kk:=vv])[kk] == vv Obligation: ((h@1[ref@1:=(h@1[ref@1])[field@1:=(h@1[ref@1])[field@1] + 1]])[ref@1])[field@1] == (h@1[ref@1])[field@1] + 1 diff --git a/StrataTest/Languages/Core/Examples/Seq.lean b/StrataTest/Languages/Core/Examples/Seq.lean index c7e3c32b8e..937c40858d 100644 --- a/StrataTest/Languages/Core/Examples/Seq.lean +++ b/StrataTest/Languages/Core/Examples/Seq.lean @@ -305,3 +305,169 @@ Result: ✅ pass #eval verify seqOpsPgm --------------------------------------------------------------------- + +---------------------------------------------------------------------- +-- Tests for Sequence.empty() syntax (issue #1027) +---------------------------------------------------------------------- + +private def seqEmptyPgm := +#strata +program Core; + +procedure SeqEmpty() +{ + var s : Sequence int; + + // Create an empty sequence using Sequence.empty syntax + s := Sequence.empty(); + assert [empty_length]: Sequence.length(s) == 0; + + // Build on top of an empty sequence + s := Sequence.build(Sequence.empty(), 42); + assert [build_on_empty_length]: Sequence.length(s) == 1; + assert [build_on_empty_elem]: Sequence.select(s, 0) == 42; +}; +#end + +/-- info: true -/ +#guard_msgs in +-- No errors in translation. +#eval TransM.run Inhabited.default (translateProgram seqEmptyPgm) |>.snd |>.isEmpty + +/-- +info: program Core; + +procedure SeqEmpty () +{ + var s : (Sequence int); + s := Sequence.empty(); + assert [empty_length]: Sequence.length(s) == 0; + s := Sequence.build(Sequence.empty(), 42); + assert [build_on_empty_length]: Sequence.length(s) == 1; + assert [build_on_empty_elem]: Sequence.select(s, 0) == 42; +}; +-/ +#guard_msgs in +#eval TransM.run Inhabited.default (translateProgram seqEmptyPgm) |>.fst + +/-- +info: [Strata.Core] Type checking succeeded. + + +VCs: +Label: empty_length +Property: assert +Obligation: +Sequence.length(Sequence.empty()) == 0 + +Label: build_on_empty_length +Property: assert +Obligation: +Sequence.length(Sequence.build(Sequence.empty(), 42)) == 1 + +Label: build_on_empty_elem +Property: assert +Obligation: +Sequence.select(Sequence.build(Sequence.empty(), 42), 0) == 42 + +--- +info: +Obligation: empty_length +Property: assert +Result: ✅ pass + +Obligation: build_on_empty_length +Property: assert +Result: ✅ pass + +Obligation: build_on_empty_elem +Property: assert +Result: ✅ pass +-/ +#guard_msgs in +#eval verify seqEmptyPgm + +---------------------------------------------------------------------- + +-- Exercise various element types for Sequence.empty(). +private def seqEmptyTypesPgm := +#strata +program Core; + +procedure SeqEmptyTypes() +{ + var sb : Sequence bool; + var ssi : Sequence (Sequence int); + var smi : Sequence (Map int bool); + + sb := Sequence.empty(); + ssi := Sequence.empty(); + smi := Sequence.empty(); + + assert [bool_len]: Sequence.length(sb) == 0; + assert [seq_seq_len]: Sequence.length(ssi) == 0; + assert [seq_map_len]: Sequence.length(smi) == 0; +}; +#end + +/-- info: true -/ +#guard_msgs in +#eval TransM.run Inhabited.default (translateProgram seqEmptyTypesPgm) |>.snd |>.isEmpty + +/-- +info: program Core; + +procedure SeqEmptyTypes () +{ + var sb : (Sequence bool); + var ssi : (Sequence (Sequence int)); + var smi : (Sequence (Map int bool)); + sb := Sequence.empty(); + ssi := Sequence.empty(); + smi := Sequence.empty(); + assert [bool_len]: Sequence.length(sb) == 0; + assert [seq_seq_len]: Sequence.length(ssi) == 0; + assert [seq_map_len]: Sequence.length(smi) == 0; +}; +-/ +#guard_msgs in +#eval TransM.run Inhabited.default (translateProgram seqEmptyTypesPgm) |>.fst + +/-- +info: [Strata.Core] Type checking succeeded. + + +VCs: +Label: bool_len +Property: assert +Obligation: +Sequence.length(Sequence.empty()) == 0 + +Label: seq_seq_len +Property: assert +Obligation: +Sequence.length(Sequence.empty()) == 0 + +Label: seq_map_len +Property: assert +Obligation: +Sequence.length(Sequence.empty()) == 0 + +--- +info: +Obligation: bool_len +Property: assert +Result: ✅ pass + +Obligation: seq_seq_len +Property: assert +Result: ✅ pass + +Obligation: seq_map_len +Property: assert +Result: ✅ pass +-/ +#guard_msgs in +#eval verify seqEmptyTypesPgm + +---------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/SubstFvarsCaptureTests.lean b/StrataTest/Languages/Core/Examples/SubstFvarsCaptureTests.lean index 042d88705e..03e9b3e795 100644 --- a/StrataTest/Languages/Core/Examples/SubstFvarsCaptureTests.lean +++ b/StrataTest/Languages/Core/Examples/SubstFvarsCaptureTests.lean @@ -114,11 +114,11 @@ private def actualsBvar : List (LExpr CoreLParams.mono) := [.bvar () 0] -- Correct (with lifting): `forall z :: bvar 1 > bvar 0` (bvar 1 = outer y). -- The "out of bounds" error is expected: bvar!1 is only in-bounds when the iterated version incorrectly captures it. /-- -info: forall __q0 : int :: bvar!1 > __q0 +info: forall z : int :: bvar!1 > z -- Errors: Unsupported construct in lexprToExpr: bvar index out of bounds: 1 Context: Global scope: Scope 1: - boundVars: [__q0] + boundVars: [z] -/ #guard_msgs in #eval Std.ToFormat.format (substitutePrecondition precondBvar formalsBvar actualsBvar) diff --git a/StrataTest/Languages/Core/Examples/TypeVarImplicitlyQuantified.lean b/StrataTest/Languages/Core/Examples/TypeVarImplicitlyQuantified.lean index ff5296a0df..1c580bbf23 100644 --- a/StrataTest/Languages/Core/Examples/TypeVarImplicitlyQuantified.lean +++ b/StrataTest/Languages/Core/Examples/TypeVarImplicitlyQuantified.lean @@ -45,10 +45,10 @@ info: ok: program Core; type set := Map int bool; function diff (a : Map int bool, b : Map int bool) : Map int bool; function lambda_0 (l_0 : bool, l_1 : int, l_2 : int) : Map int int; -axiom [a1]: forall __q0 : (Map int bool) :: forall __q1 : (Map int bool) :: { diff(__q0, __q1) } - diff(__q0, __q1) == diff(__q1, __q0); -axiom [a2]: forall __q0 : bool :: forall __q1 : int :: forall __q2 : int :: forall __q3 : int :: { (lambda_0(__q0, __q1, __q2))[__q3] } - (lambda_0(__q0, __q1, __q2))[__q3] == (lambda_0(__q0, __q2, __q1))[__q3]; +axiom [a1]: forall a : (Map int bool) :: forall b : (Map int bool) :: { diff(a, b) } + diff(a, b) == diff(b, a); +axiom [a2]: forall l_0 : bool :: forall l_1 : int :: forall l_2 : int :: forall y : int :: { (lambda_0(l_0, l_1, l_2))[y] } + (lambda_0(l_0, l_1, l_2))[y] == (lambda_0(l_0, l_2, l_1))[y]; -/ #guard_msgs in #eval Core.typeCheck .default core_pgm.fst diff --git a/StrataTest/Languages/Core/Tests/GeneratedLabels.lean b/StrataTest/Languages/Core/Tests/GeneratedLabels.lean index 1b5992dbc3..b97363ab5b 100644 --- a/StrataTest/Languages/Core/Tests/GeneratedLabels.lean +++ b/StrataTest/Languages/Core/Tests/GeneratedLabels.lean @@ -40,10 +40,10 @@ type Ref; type Field; type Struct := Map Field int; type Heap := Map Ref Struct; -axiom [axiom_0]: forall __q0 : Struct :: forall __q1 : Field :: forall __q2 : Field :: forall __q3 : int :: !(__q1 == __q2) ==> __q0[__q1] == (__q0[__q2:=__q3])[__q1]; -axiom [axiom_1]: forall __q0 : Struct :: forall __q1 : Field :: forall __q2 : int :: (__q0[__q1:=__q2])[__q1] == __q2; -axiom [axiom_2]: forall __q0 : Heap :: forall __q1 : Ref :: forall __q2 : Ref :: forall __q3 : Struct :: !(__q1 == __q2) ==> __q0[__q1] == (__q0[__q2:=__q3])[__q1]; -axiom [axiom_3]: forall __q0 : Heap :: forall __q1 : Ref :: forall __q2 : Struct :: (__q0[__q1:=__q2])[__q1] == __q2; +axiom [axiom_0]: forall m : Struct :: forall okk : Field :: forall kk : Field :: forall vv : int :: !(okk == kk) ==> m[okk] == (m[kk:=vv])[okk]; +axiom [axiom_1]: forall m : Struct :: forall kk : Field :: forall vv : int :: (m[kk:=vv])[kk] == vv; +axiom [axiom_2]: forall m : Heap :: forall okk : Ref :: forall kk : Ref :: forall vv : Struct :: !(okk == kk) ==> m[okk] == (m[kk:=vv])[okk]; +axiom [axiom_3]: forall m : Heap :: forall kk : Ref :: forall vv : Struct :: (m[kk:=vv])[kk] == vv; procedure test (h : Heap, ref : Ref, field : Field) { var newH : Heap := h[ref:=(h[ref])[field:=(h[ref])[field] + 1]]; @@ -61,10 +61,10 @@ VCs: Label: assert_0 Property: assert Assumptions: -axiom_0: forall __q0 : (Map Field int) :: forall __q1 : Field :: forall __q2 : Field :: forall __q3 : int :: !(__q1 == __q2) ==> __q0[__q1] == (__q0[__q2:=__q3])[__q1] -axiom_1: forall __q0 : (Map Field int) :: forall __q1 : Field :: forall __q2 : int :: (__q0[__q1:=__q2])[__q1] == __q2 -axiom_2: forall __q0 : (Map Ref (Map Field int)) :: forall __q1 : Ref :: forall __q2 : Ref :: forall __q3 : (Map Field int) :: !(__q1 == __q2) ==> __q0[__q1] == (__q0[__q2:=__q3])[__q1] -axiom_3: forall __q0 : (Map Ref (Map Field int)) :: forall __q1 : Ref :: forall __q2 : (Map Field int) :: (__q0[__q1:=__q2])[__q1] == __q2 +axiom_0: forall m : (Map Field int) :: forall okk : Field :: forall kk : Field :: forall vv : int :: !(okk == kk) ==> m[okk] == (m[kk:=vv])[okk] +axiom_1: forall m : (Map Field int) :: forall kk : Field :: forall vv : int :: (m[kk:=vv])[kk] == vv +axiom_2: forall m : (Map Ref (Map Field int)) :: forall okk : Ref :: forall kk : Ref :: forall vv : (Map Field int) :: !(okk == kk) ==> m[okk] == (m[kk:=vv])[okk] +axiom_3: forall m : (Map Ref (Map Field int)) :: forall kk : Ref :: forall vv : (Map Field int) :: (m[kk:=vv])[kk] == vv Obligation: ((h@1[ref@1:=(h@1[ref@1])[field@1:=(h@1[ref@1])[field@1] + 1]])[ref@1])[field@1] == (h@1[ref@1])[field@1] + 1 diff --git a/StrataTest/Languages/Core/Tests/LambdaHigherOrderTests.lean b/StrataTest/Languages/Core/Tests/LambdaHigherOrderTests.lean index 379e681eda..fe93e8e0e8 100644 --- a/StrataTest/Languages/Core/Tests/LambdaHigherOrderTests.lean +++ b/StrataTest/Languages/Core/Tests/LambdaHigherOrderTests.lean @@ -93,7 +93,7 @@ info: [Strata.Core] Type checking succeeded. --- info: ok: program Core; -function apply (f : int -> int, x : int) : int { +inline function apply (f : int -> int, x : int) : int { f(x) } procedure TestLambdaApply (out result : int) diff --git a/StrataTest/Languages/Core/Tests/MutualRecursiveFunctionTests.lean b/StrataTest/Languages/Core/Tests/MutualRecursiveFunctionTests.lean index 10173ed316..9de26a834c 100644 --- a/StrataTest/Languages/Core/Tests/MutualRecursiveFunctionTests.lean +++ b/StrataTest/Languages/Core/Tests/MutualRecursiveFunctionTests.lean @@ -66,20 +66,20 @@ Obligation: Label: isEven_terminates_0 Property: assert Assumptions: -MyNat..adtRank_0: forall __q0 : MyNat :: { MyNat..adtRank(__q0) } - MyNat..adtRank(__q0) >= 0 -MyNat..adtRank_1: forall __q0 : MyNat :: { MyNat..adtRank(Succ(__q0)) } - MyNat..adtRank(__q0) < MyNat..adtRank(Succ(__q0)) +MyNat..adtRank_0: forall x : MyNat :: { MyNat..adtRank(x) } + MyNat..adtRank(x) >= 0 +MyNat..adtRank_1: forall pred : MyNat :: { MyNat..adtRank(Succ(pred)) } + MyNat..adtRank(pred) < MyNat..adtRank(Succ(pred)) Obligation: !(MyNat..isZero(n@3)) ==> MyNat..adtRank(MyNat..pred(n@3)) < MyNat..adtRank(n@3) Label: isOdd_terminates_0 Property: assert Assumptions: -MyNat..adtRank_0: forall __q0 : MyNat :: { MyNat..adtRank(__q0) } - MyNat..adtRank(__q0) >= 0 -MyNat..adtRank_1: forall __q0 : MyNat :: { MyNat..adtRank(Succ(__q0)) } - MyNat..adtRank(__q0) < MyNat..adtRank(Succ(__q0)) +MyNat..adtRank_0: forall x : MyNat :: { MyNat..adtRank(x) } + MyNat..adtRank(x) >= 0 +MyNat..adtRank_1: forall pred : MyNat :: { MyNat..adtRank(Succ(pred)) } + MyNat..adtRank(pred) < MyNat..adtRank(Succ(pred)) Obligation: !(MyNat..isZero(n@4)) ==> MyNat..adtRank(MyNat..pred(n@4)) < MyNat..adtRank(n@4) diff --git a/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean b/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean index d9ee5b06a5..51d905cbd8 100644 --- a/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean +++ b/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean @@ -268,115 +268,115 @@ func Bv64.UAddOverflow : ((x : bv64) (y : bv64)) → bool; func Bv64.USubOverflow : ((x : bv64) (y : bv64)) → bool; func Bv64.UMulOverflow : ((x : bv64) (y : bv64)) → bool; func Bv1.SafeAdd : ((x : bv1) (y : bv1)) → bv1 - requires !(x <= y); + requires !(Bv.SAddOverflow(x, y)); func Bv1.SafeSub : ((x : bv1) (y : bv1)) → bv1 - requires !(x <= y); + requires !(Bv.SSubOverflow(x, y)); func Bv1.SafeMul : ((x : bv1) (y : bv1)) → bv1 - requires !(x <= y); + requires !(Bv.SMulOverflow(x, y)); func Bv1.SafeNeg : ((x : bv1)) → bv1 - requires !(!x); + requires !(Bv.SNegOverflow(x)); func Bv1.SafeUAdd : ((x : bv1) (y : bv1)) → bv1 - requires !(x <= y); + requires !(Bv.UAddOverflow(x, y)); func Bv1.SafeUSub : ((x : bv1) (y : bv1)) → bv1 - requires !(x <= y); + requires !(Bv.USubOverflow(x, y)); func Bv1.SafeUMul : ((x : bv1) (y : bv1)) → bv1 - requires !(x <= y); + requires !(Bv.UMulOverflow(x, y)); func Bv1.SafeUNeg : ((x : bv1)) → bv1 - requires !(!x); + requires !(Bv.UNegOverflow(x)); func Bv8.SafeAdd : ((x : bv8) (y : bv8)) → bv8 - requires !(x <= y); + requires !(Bv.SAddOverflow(x, y)); func Bv8.SafeSub : ((x : bv8) (y : bv8)) → bv8 - requires !(x <= y); + requires !(Bv.SSubOverflow(x, y)); func Bv8.SafeMul : ((x : bv8) (y : bv8)) → bv8 - requires !(x <= y); + requires !(Bv.SMulOverflow(x, y)); func Bv8.SafeNeg : ((x : bv8)) → bv8 - requires !(!x); + requires !(Bv.SNegOverflow(x)); func Bv8.SafeUAdd : ((x : bv8) (y : bv8)) → bv8 - requires !(x <= y); + requires !(Bv.UAddOverflow(x, y)); func Bv8.SafeUSub : ((x : bv8) (y : bv8)) → bv8 - requires !(x <= y); + requires !(Bv.USubOverflow(x, y)); func Bv8.SafeUMul : ((x : bv8) (y : bv8)) → bv8 - requires !(x <= y); + requires !(Bv.UMulOverflow(x, y)); func Bv8.SafeUNeg : ((x : bv8)) → bv8 - requires !(!x); + requires !(Bv.UNegOverflow(x)); func Bv16.SafeAdd : ((x : bv16) (y : bv16)) → bv16 - requires !(x <= y); + requires !(Bv.SAddOverflow(x, y)); func Bv16.SafeSub : ((x : bv16) (y : bv16)) → bv16 - requires !(x <= y); + requires !(Bv.SSubOverflow(x, y)); func Bv16.SafeMul : ((x : bv16) (y : bv16)) → bv16 - requires !(x <= y); + requires !(Bv.SMulOverflow(x, y)); func Bv16.SafeNeg : ((x : bv16)) → bv16 - requires !(!x); + requires !(Bv.SNegOverflow(x)); func Bv16.SafeUAdd : ((x : bv16) (y : bv16)) → bv16 - requires !(x <= y); + requires !(Bv.UAddOverflow(x, y)); func Bv16.SafeUSub : ((x : bv16) (y : bv16)) → bv16 - requires !(x <= y); + requires !(Bv.USubOverflow(x, y)); func Bv16.SafeUMul : ((x : bv16) (y : bv16)) → bv16 - requires !(x <= y); + requires !(Bv.UMulOverflow(x, y)); func Bv16.SafeUNeg : ((x : bv16)) → bv16 - requires !(!x); + requires !(Bv.UNegOverflow(x)); func Bv32.SafeAdd : ((x : bv32) (y : bv32)) → bv32 - requires !(x <= y); + requires !(Bv.SAddOverflow(x, y)); func Bv32.SafeSub : ((x : bv32) (y : bv32)) → bv32 - requires !(x <= y); + requires !(Bv.SSubOverflow(x, y)); func Bv32.SafeMul : ((x : bv32) (y : bv32)) → bv32 - requires !(x <= y); + requires !(Bv.SMulOverflow(x, y)); func Bv32.SafeNeg : ((x : bv32)) → bv32 - requires !(!x); + requires !(Bv.SNegOverflow(x)); func Bv32.SafeUAdd : ((x : bv32) (y : bv32)) → bv32 - requires !(x <= y); + requires !(Bv.UAddOverflow(x, y)); func Bv32.SafeUSub : ((x : bv32) (y : bv32)) → bv32 - requires !(x <= y); + requires !(Bv.USubOverflow(x, y)); func Bv32.SafeUMul : ((x : bv32) (y : bv32)) → bv32 - requires !(x <= y); + requires !(Bv.UMulOverflow(x, y)); func Bv32.SafeUNeg : ((x : bv32)) → bv32 - requires !(!x); + requires !(Bv.UNegOverflow(x)); func Bv64.SafeAdd : ((x : bv64) (y : bv64)) → bv64 - requires !(x <= y); + requires !(Bv.SAddOverflow(x, y)); func Bv64.SafeSub : ((x : bv64) (y : bv64)) → bv64 - requires !(x <= y); + requires !(Bv.SSubOverflow(x, y)); func Bv64.SafeMul : ((x : bv64) (y : bv64)) → bv64 - requires !(x <= y); + requires !(Bv.SMulOverflow(x, y)); func Bv64.SafeNeg : ((x : bv64)) → bv64 - requires !(!x); + requires !(Bv.SNegOverflow(x)); func Bv64.SafeUAdd : ((x : bv64) (y : bv64)) → bv64 - requires !(x <= y); + requires !(Bv.UAddOverflow(x, y)); func Bv64.SafeUSub : ((x : bv64) (y : bv64)) → bv64 - requires !(x <= y); + requires !(Bv.USubOverflow(x, y)); func Bv64.SafeUMul : ((x : bv64) (y : bv64)) → bv64 - requires !(x <= y); + requires !(Bv.UMulOverflow(x, y)); func Bv64.SafeUNeg : ((x : bv64)) → bv64 - requires !(!x); + requires !(Bv.UNegOverflow(x)); func Bv1.SafeSDiv : ((x : bv1) (y : bv1)) → bv1 requires !(y == bv{1}(0)) - requires !(x <= y); + requires !(Bv.SDivOverflow(x, y)); func Bv1.SafeSMod : ((x : bv1) (y : bv1)) → bv1 requires !(y == bv{1}(0)) - requires !(x <= y); + requires !(Bv.SDivOverflow(x, y)); func Bv8.SafeSDiv : ((x : bv8) (y : bv8)) → bv8 requires !(y == bv{8}(0)) - requires !(x <= y); + requires !(Bv.SDivOverflow(x, y)); func Bv8.SafeSMod : ((x : bv8) (y : bv8)) → bv8 requires !(y == bv{8}(0)) - requires !(x <= y); + requires !(Bv.SDivOverflow(x, y)); func Bv16.SafeSDiv : ((x : bv16) (y : bv16)) → bv16 requires !(y == bv{16}(0)) - requires !(x <= y); + requires !(Bv.SDivOverflow(x, y)); func Bv16.SafeSMod : ((x : bv16) (y : bv16)) → bv16 requires !(y == bv{16}(0)) - requires !(x <= y); + requires !(Bv.SDivOverflow(x, y)); func Bv32.SafeSDiv : ((x : bv32) (y : bv32)) → bv32 requires !(y == bv{32}(0)) - requires !(x <= y); + requires !(Bv.SDivOverflow(x, y)); func Bv32.SafeSMod : ((x : bv32) (y : bv32)) → bv32 requires !(y == bv{32}(0)) - requires !(x <= y); + requires !(Bv.SDivOverflow(x, y)); func Bv64.SafeSDiv : ((x : bv64) (y : bv64)) → bv64 requires !(y == bv{64}(0)) - requires !(x <= y); + requires !(Bv.SDivOverflow(x, y)); func Bv64.SafeSMod : ((x : bv64) (y : bv64)) → bv64 requires !(y == bv{64}(0)) - requires !(x <= y); + requires !(Bv.SDivOverflow(x, y)); Datatypes: diff --git a/StrataTest/Languages/Core/Tests/QuantifierBvarIndexTest.lean b/StrataTest/Languages/Core/Tests/QuantifierBvarIndexTest.lean index 4a806af60e..492b8a493b 100644 --- a/StrataTest/Languages/Core/Tests/QuantifierBvarIndexTest.lean +++ b/StrataTest/Languages/Core/Tests/QuantifierBvarIndexTest.lean @@ -36,7 +36,7 @@ info: [Strata.Core] Type checking succeeded. info: ok: program Core; function apply (f : int -> int, x : int) : int; -axiom [axiom_0]: forall __q0 : int -> int :: forall __q1 : int :: apply(__q0, __q1) == __q0(__q1); +axiom [axiom_0]: forall f : int -> int :: forall x : int :: apply(f, x) == f(x); -/ #guard_msgs in #eval (Std.format ((Core.typeCheck .default (translate axiomApplyBoundVar).stripMetaData))) @@ -71,7 +71,7 @@ function apply (f : int -> int, x : int) : int { } procedure Check (out result : bool) spec { - ensures [Check_ensures_0]: result == forall __q0 : int -> int :: forall __q1 : int :: apply(__q0, __q1) == __q0(__q1); + ensures [Check_ensures_0]: result == forall f : int -> int :: forall x : int :: apply(f, x) == f(x); } { result := true; }; diff --git a/StrataTest/Languages/Core/Tests/RecursiveFunctionTests.lean b/StrataTest/Languages/Core/Tests/RecursiveFunctionTests.lean index c27eac0880..43f6f1e761 100644 --- a/StrataTest/Languages/Core/Tests/RecursiveFunctionTests.lean +++ b/StrataTest/Languages/Core/Tests/RecursiveFunctionTests.lean @@ -61,10 +61,10 @@ Obligation: Label: listLen_terminates_0 Property: assert Assumptions: -IntList..adtRank_0: forall __q0 : IntList :: { IntList..adtRank(__q0) } - IntList..adtRank(__q0) >= 0 -IntList..adtRank_1: forall __q0 : int :: forall __q1 : IntList :: { IntList..adtRank(Cons(__q0, __q1)) } - IntList..adtRank(__q1) < IntList..adtRank(Cons(__q0, __q1)) +IntList..adtRank_0: forall x : IntList :: { IntList..adtRank(x) } + IntList..adtRank(x) >= 0 +IntList..adtRank_1: forall hd : int :: forall tl : IntList :: { IntList..adtRank(Cons(hd, tl)) } + IntList..adtRank(tl) < IntList..adtRank(Cons(hd, tl)) Obligation: !(IntList..isNil(xs@2)) ==> IntList..adtRank(IntList..tl(xs@2)) < IntList..adtRank(xs@2) @@ -168,10 +168,10 @@ Obligation: Label: listLen_terminates_0 Property: assert Assumptions: -IntList..adtRank_0: forall __q0 : IntList :: { IntList..adtRank(__q0) } - IntList..adtRank(__q0) >= 0 -IntList..adtRank_1: forall __q0 : int :: forall __q1 : IntList :: { IntList..adtRank(Cons(__q0, __q1)) } - IntList..adtRank(__q1) < IntList..adtRank(Cons(__q0, __q1)) +IntList..adtRank_0: forall x : IntList :: { IntList..adtRank(x) } + IntList..adtRank(x) >= 0 +IntList..adtRank_1: forall hd : int :: forall tl : IntList :: { IntList..adtRank(Cons(hd, tl)) } + IntList..adtRank(tl) < IntList..adtRank(Cons(hd, tl)) Obligation: !(IntList..isNil(xs@2)) ==> IntList..adtRank(IntList..tl(xs@2)) < IntList..adtRank(xs@2) @@ -360,10 +360,10 @@ Obligation: Label: listLen_terminates_0 Property: assert Assumptions: -IntList..adtRank_0: forall __q0 : IntList :: { IntList..adtRank(__q0) } - IntList..adtRank(__q0) >= 0 -IntList..adtRank_1: forall __q0 : int :: forall __q1 : IntList :: { IntList..adtRank(Cons(__q0, __q1)) } - IntList..adtRank(__q1) < IntList..adtRank(Cons(__q0, __q1)) +IntList..adtRank_0: forall x : IntList :: { IntList..adtRank(x) } + IntList..adtRank(x) >= 0 +IntList..adtRank_1: forall hd : int :: forall tl : IntList :: { IntList..adtRank(Cons(hd, tl)) } + IntList..adtRank(tl) < IntList..adtRank(Cons(hd, tl)) Obligation: !(IntList..isNil(xs@2)) ==> IntList..adtRank(IntList..tl(xs@2)) < IntList..adtRank(xs@2) diff --git a/StrataTest/Languages/Core/Tests/RoundtripTest.lean b/StrataTest/Languages/Core/Tests/RoundtripTest.lean new file mode 100644 index 0000000000..4ff9c9d88a --- /dev/null +++ b/StrataTest/Languages/Core/Tests/RoundtripTest.lean @@ -0,0 +1,235 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import Strata.Languages.Core.DDMTransform.ASTtoCST +import Strata.Languages.Core.DDMTransform.Translate +import Strata.DDM.Elab +import Strata.DDM.BuiltinDialects.Init + +/-! +# Core Roundtrip Tests + +Tests that `Core.formatProgram` produces output that can be parsed back to the +same AST. The roundtrip is: parse → translate → format → re-parse → re-translate +→ compare. +-/ + +namespace Strata.Test.Roundtrip + +open Strata +open Strata.CoreDDM +open Core +open Lean.Parser (InputContext) + +/-- Parse a string as a Core program and translate to AST. -/ +private def parseAndTranslate (input : String) : IO Core.Program := do + let dialects := Strata.Elab.LoadedDialects.ofDialects! #[initDialect, Core] + -- Strip "program Core;\n\n" header if present + let body := if input.startsWith "program Core;\n\n" then + (input.drop "program Core;\n\n".length).toString + else input + let inputCtx := Strata.Parser.stringInputContext ⟨"roundtrip-test"⟩ body + let strataProgram ← Strata.Elab.parseStrataProgramFromDialect dialects "Core" inputCtx + let (ast, errs) := TransM.run Inhabited.default (translateProgram strataProgram) + if !errs.isEmpty then + throw (IO.userError s!"Translation errors: {errs}") + pure ast + +/-- Perform a roundtrip test: parse → format → re-parse → compare. + Prints OK or FAIL with details. -/ +def roundtrip (program : Strata.Program) : IO Unit := do + -- First pass: translate to AST + let (ast1, errs1) := TransM.run Inhabited.default (translateProgram program) + if !errs1.isEmpty then + IO.println s!"FAIL: First translation errors: {errs1}" + return + -- Format back to text + let formatted := (Core.formatProgram ast1).pretty + -- Second pass: re-parse and re-translate + let ast2 ← parseAndTranslate formatted + -- Compare: format both ASTs and check they match + let formatted2 := (Core.formatProgram ast2).pretty + if formatted == formatted2 then + IO.println "OK" + else + IO.println s!"FAIL: Roundtrip mismatch.\nFirst format:\n{formatted}\nSecond format:\n{formatted2}" + +------------------------------------------------------------------------------- +-- Test: Basic types and type aliases +------------------------------------------------------------------------------- + +private def testTypesRoundtrip : Program := +#strata +program Core; + +type T0; +type Byte := bv8; +type IntMap := Map int int; +type T1 (x : Type); +type MyMap (a : Type, b : Type); +type Foo (a : Type, b : Type) := Map b a; +#end + +/-- info: OK -/ +#guard_msgs in +#eval roundtrip testTypesRoundtrip + +------------------------------------------------------------------------------- +-- Test: Polymorphic datatypes with parameterized types +------------------------------------------------------------------------------- + +private def testDatatypesRoundtrip : Program := +#strata +program Core; + +datatype List (a : Type) { + Nil(), + Cons(head : a, tail : List a) +}; + +datatype Tree (a : Type) { + Leaf(val : a), + Node(left : Tree a, right : Tree a) +}; +#end + +/-- +info: program Core; + +datatype List (a : Type) { + Nil(), + Cons(head : a, tail : List a) +}; +datatype Tree (a : Type) { + Leaf(val : a), + Node(left : Tree a, right : Tree a) +}; +-/ +#guard_msgs in +#eval do + let (ast, _) := TransM.run Inhabited.default (translateProgram testDatatypesRoundtrip) + IO.println f!"{Core.formatProgram ast}" + +/-- info: OK -/ +#guard_msgs in +#eval roundtrip testDatatypesRoundtrip + +------------------------------------------------------------------------------- +-- Test: Functions and axioms with quantifiers +------------------------------------------------------------------------------- + +private def testFunctionsRoundtrip : Program := +#strata +program Core; + +function f1(x : int) : int; +axiom [f1_ax]: (forall x : int :: f1(x) > x); + +function f2(x : int, y : bool) : bool; +axiom [f2_ax]: (forall x : int, y : bool :: + {f2(x, true), f2(x, false)} + f2(x, true) == true); + +function f3(x : T1) : Map T1 T2; +#end + +/-- info: OK -/ +#guard_msgs in +#eval roundtrip testFunctionsRoundtrip + +------------------------------------------------------------------------------- +-- Test: Procedures with specs +------------------------------------------------------------------------------- + +private def testProceduresRoundtrip : Program := +#strata +program Core; + +procedure Test(x : bool, out y : bool) +spec { + requires x == true; + ensures y == x; +} { + y := x; +}; +#end + +/-- info: OK -/ +#guard_msgs in +#eval roundtrip testProceduresRoundtrip + +------------------------------------------------------------------------------- +-- Test: Inline functions +------------------------------------------------------------------------------- + +private def testInlineFunctionRoundtrip : Program := +#strata +program Core; + +inline function double(x : int) : int { + x + x +} +#end + +/-- info: OK -/ +#guard_msgs in +#eval roundtrip testInlineFunctionRoundtrip + +------------------------------------------------------------------------------- +-- Test: Parameterized type arguments (the reversed-args bug) +------------------------------------------------------------------------------- + +private def testTypeArgsRoundtrip : Program := +#strata +program Core; + +type Pair (a : Type, b : Type); + +function f(x : Pair int bool) : int; +function g(x : Map int bool) : int; +#end + +/-- info: OK -/ +#guard_msgs in +#eval roundtrip testTypeArgsRoundtrip + +------------------------------------------------------------------------------- +-- Test: Array assignment (lhsArray: m[k] := v) +------------------------------------------------------------------------------- + +private def testLhsArrayRoundtrip : Program := +#strata +program Core; + +procedure MapUpdate(m : Map int int, out m : Map int int) +spec { + ensures true; +} { + m[0] := 1; +}; +#end + +/-- info: OK -/ +#guard_msgs in +#eval roundtrip testLhsArrayRoundtrip + +------------------------------------------------------------------------------- +-- Test: Sequence.empty with explicit type annotation +------------------------------------------------------------------------------- + +private def testSeqEmptyRoundtrip : Program := +#strata +program Core; + +function f(s : Sequence int) : bool; +axiom [f_ax]: f(Sequence.empty()) == true; +#end + +/-- info: OK -/ +#guard_msgs in +#eval roundtrip testSeqEmptyRoundtrip + +end Strata.Test.Roundtrip diff --git a/StrataTest/Languages/Core/Tests/TerminationCheckTests.lean b/StrataTest/Languages/Core/Tests/TerminationCheckTests.lean index 3de20d743a..48486280af 100644 --- a/StrataTest/Languages/Core/Tests/TerminationCheckTests.lean +++ b/StrataTest/Languages/Core/Tests/TerminationCheckTests.lean @@ -54,10 +54,10 @@ Obligation: Label: listLen_terminates_0 Property: assert Assumptions: -IntList..adtRank_0: forall __q0 : IntList :: { IntList..adtRank(__q0) } - IntList..adtRank(__q0) >= 0 -IntList..adtRank_1: forall __q0 : int :: forall __q1 : IntList :: { IntList..adtRank(Cons(__q0, __q1)) } - IntList..adtRank(__q1) < IntList..adtRank(Cons(__q0, __q1)) +IntList..adtRank_0: forall x : IntList :: { IntList..adtRank(x) } + IntList..adtRank(x) >= 0 +IntList..adtRank_1: forall hd : int :: forall tl : IntList :: { IntList..adtRank(Cons(hd, tl)) } + IntList..adtRank(tl) < IntList..adtRank(Cons(hd, tl)) Obligation: !(IntList..isNil(xs@2)) ==> IntList..adtRank(IntList..tl(xs@2)) < IntList..adtRank(xs@2) @@ -320,10 +320,10 @@ Obligation: Label: listLen_terminates_0 Property: assert Assumptions: -IntList..adtRank_0: forall __q0 : IntList :: { IntList..adtRank(__q0) } - IntList..adtRank(__q0) >= 0 -IntList..adtRank_1: forall __q0 : int :: forall __q1 : IntList :: { IntList..adtRank(Cons(__q0, __q1)) } - IntList..adtRank(__q1) < IntList..adtRank(Cons(__q0, __q1)) +IntList..adtRank_0: forall x : IntList :: { IntList..adtRank(x) } + IntList..adtRank(x) >= 0 +IntList..adtRank_1: forall hd : int :: forall tl : IntList :: { IntList..adtRank(Cons(hd, tl)) } + IntList..adtRank(tl) < IntList..adtRank(Cons(hd, tl)) Obligation: !(IntList..isNil(xs@2)) ==> IntList..adtRank(IntList..tl(xs@2)) < IntList..adtRank(xs@2) @@ -340,10 +340,10 @@ Obligation: Label: listSum_terminates_0 Property: assert Assumptions: -IntList..adtRank_0: forall __q0 : IntList :: { IntList..adtRank(__q0) } - IntList..adtRank(__q0) >= 0 -IntList..adtRank_1: forall __q0 : int :: forall __q1 : IntList :: { IntList..adtRank(Cons(__q0, __q1)) } - IntList..adtRank(__q1) < IntList..adtRank(Cons(__q0, __q1)) +IntList..adtRank_0: forall x : IntList :: { IntList..adtRank(x) } + IntList..adtRank(x) >= 0 +IntList..adtRank_1: forall hd : int :: forall tl : IntList :: { IntList..adtRank(Cons(hd, tl)) } + IntList..adtRank(tl) < IntList..adtRank(Cons(hd, tl)) Obligation: !(IntList..isNil(xs@4)) ==> IntList..adtRank(IntList..tl(xs@4)) < IntList..adtRank(xs@4) @@ -449,42 +449,42 @@ Obligation: Label: treeSize_terminates_0 Property: assert Assumptions: -Tree..adtRank_0: forall __q0 : Tree :: { Tree..adtRank(__q0) } - Tree..adtRank(__q0) >= 0 -Tree..adtRank_1: forall __q0 : Tree :: forall __q1 : Tree :: { Tree..adtRank(Branch(__q0, __q1)) } - Tree..adtRank(__q0) < Tree..adtRank(Branch(__q0, __q1)) -Tree..adtRank_2: forall __q0 : Tree :: forall __q1 : Tree :: { Tree..adtRank(Branch(__q0, __q1)) } - Tree..adtRank(__q1) < Tree..adtRank(Branch(__q0, __q1)) -Tree..adtRank_3: forall __q0 : int :: forall __q1 : Tree :: { Tree..adtRank(Chain(__q0, __q1)) } - Tree..adtRank(__q1) < Tree..adtRank(Chain(__q0, __q1)) +Tree..adtRank_0: forall x : Tree :: { Tree..adtRank(x) } + Tree..adtRank(x) >= 0 +Tree..adtRank_1: forall left : Tree :: forall right : Tree :: { Tree..adtRank(Branch(left, right)) } + Tree..adtRank(left) < Tree..adtRank(Branch(left, right)) +Tree..adtRank_2: forall left : Tree :: forall right : Tree :: { Tree..adtRank(Branch(left, right)) } + Tree..adtRank(right) < Tree..adtRank(Branch(left, right)) +Tree..adtRank_3: forall head : int :: forall tail : Tree :: { Tree..adtRank(Chain(head, tail)) } + Tree..adtRank(tail) < Tree..adtRank(Chain(head, tail)) Obligation: Tree..isBranch(t@2) ==> !(Tree..isLeaf(t@2)) ==> Tree..adtRank(Tree..left(t@2)) < Tree..adtRank(t@2) Label: treeSize_terminates_1 Property: assert Assumptions: -Tree..adtRank_0: forall __q0 : Tree :: { Tree..adtRank(__q0) } - Tree..adtRank(__q0) >= 0 -Tree..adtRank_1: forall __q0 : Tree :: forall __q1 : Tree :: { Tree..adtRank(Branch(__q0, __q1)) } - Tree..adtRank(__q0) < Tree..adtRank(Branch(__q0, __q1)) -Tree..adtRank_2: forall __q0 : Tree :: forall __q1 : Tree :: { Tree..adtRank(Branch(__q0, __q1)) } - Tree..adtRank(__q1) < Tree..adtRank(Branch(__q0, __q1)) -Tree..adtRank_3: forall __q0 : int :: forall __q1 : Tree :: { Tree..adtRank(Chain(__q0, __q1)) } - Tree..adtRank(__q1) < Tree..adtRank(Chain(__q0, __q1)) +Tree..adtRank_0: forall x : Tree :: { Tree..adtRank(x) } + Tree..adtRank(x) >= 0 +Tree..adtRank_1: forall left : Tree :: forall right : Tree :: { Tree..adtRank(Branch(left, right)) } + Tree..adtRank(left) < Tree..adtRank(Branch(left, right)) +Tree..adtRank_2: forall left : Tree :: forall right : Tree :: { Tree..adtRank(Branch(left, right)) } + Tree..adtRank(right) < Tree..adtRank(Branch(left, right)) +Tree..adtRank_3: forall head : int :: forall tail : Tree :: { Tree..adtRank(Chain(head, tail)) } + Tree..adtRank(tail) < Tree..adtRank(Chain(head, tail)) Obligation: Tree..isBranch(t@2) ==> !(Tree..isLeaf(t@2)) ==> Tree..adtRank(Tree..right(t@2)) < Tree..adtRank(t@2) Label: treeSize_terminates_2 Property: assert Assumptions: -Tree..adtRank_0: forall __q0 : Tree :: { Tree..adtRank(__q0) } - Tree..adtRank(__q0) >= 0 -Tree..adtRank_1: forall __q0 : Tree :: forall __q1 : Tree :: { Tree..adtRank(Branch(__q0, __q1)) } - Tree..adtRank(__q0) < Tree..adtRank(Branch(__q0, __q1)) -Tree..adtRank_2: forall __q0 : Tree :: forall __q1 : Tree :: { Tree..adtRank(Branch(__q0, __q1)) } - Tree..adtRank(__q1) < Tree..adtRank(Branch(__q0, __q1)) -Tree..adtRank_3: forall __q0 : int :: forall __q1 : Tree :: { Tree..adtRank(Chain(__q0, __q1)) } - Tree..adtRank(__q1) < Tree..adtRank(Chain(__q0, __q1)) +Tree..adtRank_0: forall x : Tree :: { Tree..adtRank(x) } + Tree..adtRank(x) >= 0 +Tree..adtRank_1: forall left : Tree :: forall right : Tree :: { Tree..adtRank(Branch(left, right)) } + Tree..adtRank(left) < Tree..adtRank(Branch(left, right)) +Tree..adtRank_2: forall left : Tree :: forall right : Tree :: { Tree..adtRank(Branch(left, right)) } + Tree..adtRank(right) < Tree..adtRank(Branch(left, right)) +Tree..adtRank_3: forall head : int :: forall tail : Tree :: { Tree..adtRank(Chain(head, tail)) } + Tree..adtRank(tail) < Tree..adtRank(Chain(head, tail)) Obligation: !(Tree..isBranch(t@2)) ==> !(Tree..isLeaf(t@2)) ==> Tree..adtRank(Tree..tail(t@2)) < Tree..adtRank(t@2) @@ -581,10 +581,10 @@ Obligation: Label: intListLen_terminates_0 Property: assert Assumptions: -MyList..adtRank_0: forall __q0 : (MyList int) :: { MyList..adtRank(__q0) } - MyList..adtRank(__q0) >= 0 -MyList..adtRank_1: forall __q0 : int :: forall __q1 : (MyList int) :: { MyList..adtRank(Cons(__q0, __q1)) } - MyList..adtRank(__q1) < MyList..adtRank(Cons(__q0, __q1)) +MyList..adtRank_0: forall x : (MyList int) :: { MyList..adtRank(x) } + MyList..adtRank(x) >= 0 +MyList..adtRank_1: forall hd : int :: forall tl : (MyList int) :: { MyList..adtRank(Cons(hd, tl)) } + MyList..adtRank(tl) < MyList..adtRank(Cons(hd, tl)) Obligation: !(MyList..isNil(xs@2)) ==> MyList..adtRank(MyList..tl(xs@2)) < MyList..adtRank(xs@2) @@ -674,10 +674,10 @@ Obligation: Label: zipLen_terminates_0 Property: assert Assumptions: -IntList..adtRank_0: forall __q0 : IntList :: { IntList..adtRank(__q0) } - IntList..adtRank(__q0) >= 0 -IntList..adtRank_1: forall __q0 : int :: forall __q1 : IntList :: { IntList..adtRank(Cons(__q0, __q1)) } - IntList..adtRank(__q1) < IntList..adtRank(Cons(__q0, __q1)) +IntList..adtRank_0: forall x : IntList :: { IntList..adtRank(x) } + IntList..adtRank(x) >= 0 +IntList..adtRank_1: forall hd : int :: forall tl : IntList :: { IntList..adtRank(Cons(hd, tl)) } + IntList..adtRank(tl) < IntList..adtRank(Cons(hd, tl)) Obligation: !(IntList..isNil(ys@2)) ==> !(IntList..isNil(xs@2)) ==> IntList..adtRank(IntList..tl(ys@2)) < IntList..adtRank(ys@2) @@ -1151,20 +1151,20 @@ Obligation: Label: listLen_terminates_0 Property: assert Assumptions: -IntList..adtRank_0: forall __q0 : IntList :: { IntList..adtRank(__q0) } - IntList..adtRank(__q0) >= 0 -IntList..adtRank_1: forall __q0 : int :: forall __q1 : IntList :: { IntList..adtRank(Cons(__q0, __q1)) } - IntList..adtRank(__q1) < IntList..adtRank(Cons(__q0, __q1)) +IntList..adtRank_0: forall x : IntList :: { IntList..adtRank(x) } + IntList..adtRank(x) >= 0 +IntList..adtRank_1: forall hd : int :: forall tl : IntList :: { IntList..adtRank(Cons(hd, tl)) } + IntList..adtRank(tl) < IntList..adtRank(Cons(hd, tl)) Obligation: !(IntList..isNil(xs@2)) ==> IntList..adtRank(IntList..tl(xs@2)) < IntList..adtRank(xs@2) Label: natToInt_terminates_0 Property: assert Assumptions: -MyNat..adtRank_0: forall __q0 : MyNat :: { MyNat..adtRank(__q0) } - MyNat..adtRank(__q0) >= 0 -MyNat..adtRank_1: forall __q0 : MyNat :: { MyNat..adtRank(Succ(__q0)) } - MyNat..adtRank(__q0) < MyNat..adtRank(Succ(__q0)) +MyNat..adtRank_0: forall x : MyNat :: { MyNat..adtRank(x) } + MyNat..adtRank(x) >= 0 +MyNat..adtRank_1: forall pred : MyNat :: { MyNat..adtRank(Succ(pred)) } + MyNat..adtRank(pred) < MyNat..adtRank(Succ(pred)) Obligation: !(MyNat..isZero(n@2)) ==> MyNat..adtRank(MyNat..pred(n@2)) < MyNat..adtRank(n@2) diff --git a/StrataTest/Languages/Core/Tests/TestASTtoCST.lean b/StrataTest/Languages/Core/Tests/TestASTtoCST.lean index 57b1251bec..981a7fc688 100644 --- a/StrataTest/Languages/Core/Tests/TestASTtoCST.lean +++ b/StrataTest/Languages/Core/Tests/TestASTtoCST.lean @@ -119,17 +119,17 @@ info: program Core; function fooConst () : int; axiom [fooConst_value]: fooConst == 5; function f1 (x : int) : int; -axiom [f1_ax1]: forall __q0 : int :: { f1(__q0) } - f1(__q0) > __q0; -axiom [f1_ax2_no_trigger]: forall __q0 : int :: f1(__q0) > __q0; +axiom [f1_ax1]: forall x : int :: { f1(x) } + f1(x) > x; +axiom [f1_ax2_no_trigger]: forall x : int :: f1(x) > x; function f2 (x : int, y : bool) : bool; -axiom [f2_ax]: forall __q0 : int :: forall __q1 : bool :: { f2(__q0, true), f2(__q0, false) } - f2(__q0, true) == true; +axiom [f2_ax]: forall x : int :: forall y : bool :: { f2(x, true), f2(x, false) } + f2(x, true) == true; function f3 (x : int, y : bool, z : regex) : bool; -axiom [f3_ax]: forall __q0 : int :: forall __q1 : bool :: forall __q2 : regex :: { f3(__q0, __q1, __q2), f2(__q0, __q1) } - f3(__q0, __q1, __q2) == f2(__q0, __q1); +axiom [f3_ax]: forall x : int :: forall y : bool :: forall z : regex :: { f3(x, y, z), f2(x, y) } + f3(x, y, z) == f2(x, y); function f4 (x : T1) : Map T1 T2; -axiom [foo_ax]: forall __q0 : int :: (f4(__q0))[1] == true; +axiom [foo_ax]: forall x : int :: (f4(x))[1] == true; function f5 (x : T1, y : T2) : T1 { x } @@ -425,8 +425,8 @@ info: program Core; procedure find_max (nums : Map bv64 bv32, nums_len : bv64, out ret : bv32) spec { requires [find_max_requires_0]: nums_len > bv{64}(0); - ensures [find_max_ensures_1]: forall __q0 : bv64 :: bv{64}(0) <= __q0 && __q0 < nums_len ==> ret >=s nums[__q0]; - ensures [find_max_ensures_2]: exists __q0 : bv64 :: bv{64}(0) <= __q0 && __q0 < nums_len && ret == nums[__q0]; + ensures [find_max_ensures_1]: forall x0 : bv64 :: bv{64}(0) <= x0 && x0 < nums_len ==> ret >=s nums[x0]; + ensures [find_max_ensures_2]: exists x0 : bv64 :: bv{64}(0) <= x0 && x0 < nums_len && ret == nums[x0]; } { var max : bv32; var i : bv64; @@ -436,8 +436,8 @@ spec { invariant nums_len > bv{64}(0) invariant bv{64}(0) <= i invariant i <= nums_len - invariant forall __q0 : bv64 :: bv{64}(0) <= __q0 && __q0 < i ==> max >=s nums[__q0] - invariant exists __q0 : bv64 :: bv{64}(0) <= __q0 && __q0 < i && max == nums[__q0] + invariant forall x0 : bv64 :: bv{64}(0) <= x0 && x0 < i ==> max >=s nums[x0] + invariant exists x0 : bv64 :: bv{64}(0) <= x0 && x0 < i && max == nums[x0] { if (nums[i] >s max) { max := nums[i]; diff --git a/editors/emacs/core-st-mode.el b/editors/emacs/core-st-mode.el index 6bcfb271d4..f2cffc48e1 100644 --- a/editors/emacs/core-st-mode.el +++ b/editors/emacs/core-st-mode.el @@ -22,12 +22,16 @@ '( "div" "mod" "sdiv" "smod" "safesdiv" "safesmod")) (defvar core-st-builtins - '( "Sequence.length" "Sequence.select" "Sequence.append" - "Sequence.build" "Sequence.update" "Sequence.contains" - "Sequence.take" "Sequence.drop" "str.len" "str.concat" "str.substr" - "str.to.re" "str.in.re" "str.prefixof" "str.suffixof" "re.allchar" - "re.all" "re.range" "re.concat" "re.*" "re.+" "re.loop" "re.union" - "re.inter" "re.comp" "re.none" "Int.DivT" "Int.ModT")) + '( "Sequence.empty" "Sequence.length" "Sequence.select" + "Sequence.append" "Sequence.build" "Sequence.update" + "Sequence.contains" "Sequence.take" "Sequence.drop" "str.len" + "str.concat" "str.substr" "str.to.re" "str.in.re" "str.prefixof" + "str.suffixof" "re.allchar" "re.all" "re.range" "re.concat" "re.*" + "re.+" "re.loop" "re.union" "re.inter" "re.comp" "re.none" + "Int.DivT" "Int.ModT" "Bv.SNegOverflow" "Bv.UNegOverflow" + "Bv.SAddOverflow" "Bv.SSubOverflow" "Bv.SMulOverflow" + "Bv.SDivOverflow" "Bv.UAddOverflow" "Bv.USubOverflow" + "Bv.UMulOverflow")) ;; Font-lock rules (defvar core-st-font-lock-keywords diff --git a/editors/vscode/syntaxes/core-st.tmLanguage.json b/editors/vscode/syntaxes/core-st.tmLanguage.json index 44e4208209..8a1dd9e289 100644 --- a/editors/vscode/syntaxes/core-st.tmLanguage.json +++ b/editors/vscode/syntaxes/core-st.tmLanguage.json @@ -84,7 +84,7 @@ ] }, "function-call": { - "match": "\\b(Sequence\\.length|Sequence\\.select|Sequence\\.append|Sequence\\.build|Sequence\\.update|Sequence\\.contains|Sequence\\.take|Sequence\\.drop|str\\.len|str\\.concat|str\\.substr|str\\.to\\.re|str\\.in\\.re|str\\.prefixof|str\\.suffixof|re\\.allchar|re\\.all|re\\.range|re\\.concat|re\\.\\*|re\\.\\+|re\\.loop|re\\.union|re\\.inter|re\\.comp|re\\.none|Int\\.DivT|Int\\.ModT|bvconcat\\{[0-9]+\\}\\{[0-9]+\\}|bvextract\\{[0-9]+\\}\\{[0-9]+\\}\\{[0-9]+\\})\\b", + "match": "\\b(Sequence\\.empty|Sequence\\.length|Sequence\\.select|Sequence\\.append|Sequence\\.build|Sequence\\.update|Sequence\\.contains|Sequence\\.take|Sequence\\.drop|str\\.len|str\\.concat|str\\.substr|str\\.to\\.re|str\\.in\\.re|str\\.prefixof|str\\.suffixof|re\\.allchar|re\\.all|re\\.range|re\\.concat|re\\.\\*|re\\.\\+|re\\.loop|re\\.union|re\\.inter|re\\.comp|re\\.none|Int\\.DivT|Int\\.ModT|Bv\\.SNegOverflow|Bv\\.UNegOverflow|Bv\\.SAddOverflow|Bv\\.SSubOverflow|Bv\\.SMulOverflow|Bv\\.SDivOverflow|Bv\\.UAddOverflow|Bv\\.USubOverflow|Bv\\.UMulOverflow|bvconcat\\{[0-9]+\\}\\{[0-9]+\\}|bvextract\\{[0-9]+\\}\\{[0-9]+\\}\\{[0-9]+\\})\\b", "captures": { "1": { "name": "support.function.builtin.core-st" } } From 192b7804ecbbbd83630564cc42ab433703603ed0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mika=C3=ABl=20Mayer?= Date: Mon, 18 May 2026 13:35:08 -0500 Subject: [PATCH 08/28] Abstract Solver Interface: Decouple Term Construction from SMT-LIB Encoding (#935) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes #917 ## Summary Introduces an abstract solver interface (`AbstractSolver τ σ m`) that decouples term construction and session operations from the SMT-LIB string encoding pipeline. The interface is parameterized by a term type `τ`, sort type `σ`, and monad `m` (with `[Monad m] [MonadExceptOf IO.Error m]` constraints), so a non-SMT-LIB backend (e.g., cvc5 FFI) can be plugged in by implementing `AbstractSolver` without touching the encoding logic. All methods throw `IO.Error` directly (no `Except String` layer). A new incremental backend communicates with a live solver process via stdin/stdout. It is opt-in via `--incremental` (batch remains the default). ## What the interface provides All operations are monadic (`m`), throwing on error: - **Configuration**: `setLogic`, `setOption`, `comment` - **Sort construction**: `boolSort`, `intSort`, `realSort`, `stringSort`, `regexSort`, `bitvecSort`, `arraySort`, `constrSort`, `termTypeToSort` - **Term construction**: `mkPrim`, `mkBool`, `mkAnd`, `mkOr`, `mkNot`, `mkImplies`, `mkEq`, `mkIte`, `mkAdd`, `mkSub`, `mkMul`, `mkDiv`, `mkMod`, `mkNeg`, `mkAbs`, `mkLt`, `mkLe`, `mkGt`, `mkGe`, `mkSelect`, `mkStore`, `mkApp`, `mkAppOp`, `mkForall`, `mkExists` - **Declarations**: `declareNew`, `declareFun`, `defineFun`, `declareSort`, `declareDatatype`, `declareDatatypes` - **Session**: `assert`, `checkSat`, `checkSatAssuming`, `getUnsatAssumptions`, `getModel`, `getValue`, `reset`, `close` - **Model inspection**: `termToSMTLibString` Terms (`τ`) are opaque handles whose meaning is backend-specific. ## Other changes - **Generic encoder** — `AbstractEncoder.encodeTerm` parameterized over `τ`/`σ`, caches handles in `AbstractEncoderState τ`. - **Generic incremental discharge** — `Imperative.SMT.dischargeObligationIncremental` in `SMTUtils.lean` is parameterized over `PureExpr`, so any Imperative-level language can use the incremental solver. - **Pluggable solver backends** — `CoreSMTSolver` and `MkDischargeFn` threaded through `Core.verifyProgram`, `Core.verify`, and `Strata.verify`. - **Strict solver compatibility** — `encodeDeclarationsAbstract` skips `declareSort` for datatype names and validates datatype fields. - **`--incremental`** flag to opt in to the incremental backend. ## Testing All tests pass with both batch (default) and incremental modes. ## Follow-ups - [ ] Implement with Lean FFI for cvc5 --- Strata/DL/Imperative/SMTUtils.lean | 70 +++- Strata/DL/SMT/AbstractSolver.lean | 197 ++++++++++ Strata/DL/SMT/Encoder.lean | 2 +- Strata/DL/SMT/IncrementalSolver.lean | 364 +++++++++++++++++++ Strata/DL/SMT/SMT.lean | 2 + Strata/DL/SMT/Solver.lean | 64 ++-- Strata/Languages/Core/Options.lean | 5 + Strata/Languages/Core/SMTEncoder.lean | 4 +- Strata/Languages/Core/Verifier.lean | 498 +++++++++++++++++++++++--- Strata/SimpleAPI.lean | 6 +- StrataMain.lean | 3 + 11 files changed, 1143 insertions(+), 72 deletions(-) create mode 100644 Strata/DL/SMT/AbstractSolver.lean create mode 100644 Strata/DL/SMT/IncrementalSolver.lean diff --git a/Strata/DL/Imperative/SMTUtils.lean b/Strata/DL/Imperative/SMTUtils.lean index 36c08f3828..a5ec0c1a59 100644 --- a/Strata/DL/Imperative/SMTUtils.lean +++ b/Strata/DL/Imperative/SMTUtils.lean @@ -166,7 +166,7 @@ directly, which avoids the ambiguity that arises when parsing at the Returns a list of (key-string, value-Term) pairs on success. -/ -private def parseModelDDM (modelStr : String) : IO (List (String × Strata.SMT.Term)) := do +def parseModelDDM (modelStr : String) : IO (List (String × Strata.SMT.Term)) := do let inputCtx := Strata.Parser.stringInputContext "solver-model" modelStr let op ← try Strata.Elab.parseCategoryFromDialect @@ -194,7 +194,7 @@ Process a parsed model (list of key-string / value-Term pairs) against the expected variables, matching each variable's SMT-encoded name to its value in the model. -/ -private def processModel {P : PureExpr} [ToFormat P.Ident] +def processModel {P : PureExpr} [ToFormat P.Ident] (typedVarToSMTFn : P.Ident → P.Ty → Except Format (String × Strata.SMT.TermType)) (vars : List P.TypedIdent) (pairs : List (String × Strata.SMT.Term)) (E : Strata.SMT.EncoderState) : Except Format (Model P.Ident) := do @@ -292,6 +292,72 @@ def addLocationInfo {P : PureExpr} [BEq P.Ident] Strata.SMT.Solver.setInfoString message.fst message.snd | .none => pure () +/-- Result of encoding a proof obligation against an `AbstractSolver`. + Returned by the encoder callback passed to `dischargeObligationIncremental`, + consumed by the check-sat orchestration. -/ +structure EncodedObligation where + obligationId : Strata.SMT.Term + assumptionIds : List String + estate : Strata.SMT.EncoderState + +/-- Discharge a proof obligation using a live (incremental) SMT solver. + The encoder callback runs against the spawned solver to emit declarations + and assertions; this helper orchestrates check-sat calls and model parsing. -/ +def dischargeObligationIncremental {P : PureExpr} [ToFormat P.Ident] [BEq P.Ident] + (encodeDecl : Strata.SMT.AbstractSolver Strata.SMT.Term Strata.SMT.TermType + Strata.SMT.IncrementalSolverM → + Strata.SMT.IncrementalSolverM EncodedObligation) + (typedVarToSMTFn : P.Ident → P.Ty → Except Format (String × Strata.SMT.TermType)) + (vars : List P.TypedIdent) + (smtsolver : String) (solverFlags : Array String) + (satisfiabilityCheck validityCheck : Bool) : + IO (Except SolverError (Result P.Ident × Result P.Ident × Strata.SMT.EncoderState)) := do + let solverState ← Strata.SMT.IncrementalSolver.spawn smtsolver solverFlags + let action : Strata.SMT.IncrementalSolverM + (Except SolverError (Result P.Ident × Result P.Ident × Strata.SMT.EncoderState)) := do + let solver := Strata.SMT.IncrementalSolver.mkIncrementalSolver + let { obligationId, assumptionIds, estate } ← encodeDecl solver + let varIds := assumptionIds.map fun id => Strata.SMT.Term.var ⟨id, .bool⟩ + let getModelForVars : Strata.SMT.IncrementalSolverM (Model P.Ident) := do + if varIds.isEmpty then return [] + try + let pairs ← solver.getValue varIds + match pairs with + | [(.prim (.string rawOutput), _)] => + let rawModel ← parseModelDDM rawOutput + match processModel typedVarToSMTFn vars rawModel estate with + | .ok model => return model + | .error _ => return [] + | _ => return [] + catch _ => return [] + let decisionToResult (decision : Strata.SMT.Decision) : + Strata.SMT.IncrementalSolverM (Result P.Ident) := do + match decision with + | .sat => return .sat (← getModelForVars) + | .unknown => + let model ← getModelForVars + return if model.isEmpty then .unknown else .unknown (some model) + | .unsat => return .unsat + let bothChecks := satisfiabilityCheck && validityCheck + let mut satResult : Result P.Ident := .unknown + let mut valResult : Result P.Ident := .unknown + if bothChecks then + satResult ← decisionToResult (← solver.checkSatAssuming [obligationId]) + let negObligation ← solver.mkNot obligationId + valResult ← decisionToResult (← solver.checkSatAssuming [negObligation]) + else + if satisfiabilityCheck then + solver.assert obligationId + satResult ← decisionToResult (← solver.checkSat) + else if validityCheck then + let negObligation ← solver.mkNot obligationId + solver.assert negObligation + valResult ← decisionToResult (← solver.checkSat) + solver.close + return .ok (satResult, valResult, estate) + let (result, _) ← action.run solverState + return result + /-- Writes the proof obligation to file, discharge the obligation using SMT solver, and parse the output of the SMT solver. diff --git a/Strata/DL/SMT/AbstractSolver.lean b/Strata/DL/SMT/AbstractSolver.lean new file mode 100644 index 0000000000..79df0cddff --- /dev/null +++ b/Strata/DL/SMT/AbstractSolver.lean @@ -0,0 +1,197 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.DL.SMT.Solver + +/-! +# Abstract Solver Interface + +Defines `AbstractSolver τ σ m`, a generic solver interface parameterized by an +opaque term type `τ`, an opaque sort type `σ`, and a monad `m`. All operations +that can fail throw `IO.Error` via `MonadExceptOf`. The monad `m` captures any +state or effects the backend needs. + +For the incremental SMT-LIB backend, `τ = SMT.Term`, `σ = SMT.TermType`, +`m = StateT IncrementalSolverState IO`. + +## Design + +- `declareNew` allows shadowing: declaring the same name twice creates two + distinct variables. The backend handles disambiguation internally. +- Models return keys as `(String × Nat)` where `Nat` is the shadow depth + (0 = most recently declared). +- Quantifier bound variables are scoped via a callback pattern. +- Terms (`τ`) are opaque handles whose meaning is backend-specific. They may + be internal addresses and should not be assumed valid across sessions. +- Sorts are first-class: backends can create and pass their own sort + representations via `intSort`, `boolSort`, `bitvecSort`, `arraySort`, etc. +-/ + +namespace Strata.SMT + +public section + +/-- Handles for a single datatype constructor returned by `declareDatatype`. + - `constr` is the constructor function (use with `mkApp` to build values) + - `tester` is the recognizer predicate (use with `mkApp` to test membership) + - `selectors` are the field accessors in declaration order -/ +structure DatatypeConstructorHandles (τ : Type) where + constr : τ + tester : τ + selectors : List τ + +/-- Result of declaring a datatype: the sort and handles for each constructor. -/ +structure DatatypeInfo (τ : Type) (σ : Type) where + sort : σ + constructors : List (DatatypeConstructorHandles τ) + +/-- Abstract solver interface parameterized by term type `τ`, sort type `σ`, +and monad `m`. + +All term constructors are fallible. Solvers might not accept certain constructs +(e.g., wrong sorts, unsupported combinations) and we need to surface the issue +precisely via `MonadExceptOf IO.Error`. -/ +structure AbstractSolver (τ : Type) (σ : Type) (m : Type → Type) [Monad m] [MonadExceptOf IO.Error m] where + -- Configuration (for solvers that support them; ignored otherwise) + setLogic : String → m Unit + setOption : String → String → m Unit + comment : String → m Unit + + -- Sort constructors + boolSort : m σ + intSort : m σ + realSort : m σ + stringSort : m σ + regexSort : m σ + bitvecSort : Nat → m σ + arraySort : σ → σ → m σ + + /-- Construct a sort for a named type (datatype or user-defined sort) + with the given type arguments. -/ + constrSort : String → List σ → m σ + + -- Literal / leaf constructors + mkBool : Bool → m τ + mkInt : Int → m τ + mkPrim : TermPrim → m τ + + /-- Fallback for operations not covered by specific mk* methods + (e.g. bitvectors, strings, regex). The backend receives the raw `Op`, + the already-encoded arguments, and the result sort. -/ + mkAppOp : Op → List τ → σ → m τ + + -- Boolean operations + mkAnd : List τ → m τ + mkOr : List τ → m τ + mkNot : τ → m τ + mkImplies : τ → τ → m τ + + -- Arithmetic operations + mkAdd : List τ → m τ + mkSub : List τ → m τ + mkMul : List τ → m τ + mkDiv : τ → τ → m τ + mkMod : τ → τ → m τ + mkNeg : τ → m τ + mkAbs : τ → m τ + + -- Comparison operations + mkEq : List τ → m τ + mkLt : List τ → m τ + mkLe : List τ → m τ + mkGt : List τ → m τ + mkGe : List τ → m τ + + -- Conditional + mkIte : τ → τ → τ → m τ + + -- Array operations + mkSelect : τ → τ → m τ + mkStore : τ → τ → τ → m τ + + -- Function application (for uninterpreted functions) + mkApp : τ → List τ → m τ + + -- Quantifiers + /-- Construct a universally quantified term. + Takes name-sort pairs for bound variables and a monadic callback that + receives the bound variable terms and returns the body and trigger groups. + The callback is monadic so callers can encode sub-terms using the + bound variable handles. Bound variables cannot escape the quantifier scope. -/ + mkForall : List (String × σ) → (List τ → m (τ × List (List τ))) → m τ + + /-- Construct an existentially quantified term. Same callback pattern as `mkForall`. -/ + mkExists : List (String × σ) → (List τ → m (τ × List (List τ))) → m τ + + /-- Declare a new variable. Shadowing is allowed: declaring the same name + twice creates two distinct variables. The backend handles disambiguation + internally. -/ + declareNew : String → σ → m τ + + /-- Declare an uninterpreted function. -/ + declareFun : String → List σ → σ → m τ + + /-- Define an interpreted function with a body term. -/ + defineFun : String → List (String × σ) → σ → τ → m Unit + + /-- Declare a new sort with the given arity. Returns the declared sort. -/ + declareSort : String → Nat → m σ + + /-- Declare an algebraic datatype. + Takes the datatype name, type parameter names, and a callback that + receives `(selfSort, typeParamSorts)` and returns the constructors. + Returns the declared sort and constructor/tester/selector handles. + This callback pattern (like `mkForall`) allows recursive and parametric + datatypes: the sort being declared does not exist yet when selectors + need to reference it. -/ + declareDatatype : String → List String → + (σ → List σ → Except String (List (String × List (String × σ)))) → + m (DatatypeInfo τ σ) + + /-- Declare mutually recursive algebraic datatypes. + Takes a list of `(name, typeParams)` and a callback that receives + `(selfSorts, typeParamSorts)` and returns constructors for each datatype. + Returns the declared sorts and constructor/tester/selector handles. -/ + declareDatatypes : List (String × List String) → + (List σ → List (List σ) → Except String (List (List (String × List (String × σ))))) → + m (List (DatatypeInfo τ σ)) + + -- Session operations + + /-- Assert a term (must be Bool-typed). -/ + assert : τ → m Unit + + /-- Check satisfiability of the current assertions. -/ + checkSat : m Decision + + /-- Check satisfiability under additional assumptions. -/ + checkSatAssuming : List τ → m Decision + + /-- After an `unsat` result from `checkSatAssuming`, retrieve the subset of + assumptions that contributed to unsatisfiability. -/ + getUnsatAssumptions : m (List τ) + + /-- Retrieve the model after a `sat` result. + Keys are `(name, shadow_depth)` where 0 = most recently declared. -/ + getModel : m (List ((String × Nat) × τ)) + + /-- Get values of specific terms in the current model. -/ + getValue : List τ → m (List (τ × τ)) + + /-- Convert a term to its SMT-LIB string representation, making model values inspectable. + The returned string must be valid SMT-LIB syntax. -/ + termToSMTLibString : τ → m String + + /-- Reset the solver session to its initial state. -/ + reset : m Unit + + /-- Close the solver session and release resources. -/ + close : m Unit + +end + +end Strata.SMT diff --git a/Strata/DL/SMT/Encoder.lean b/Strata/DL/SMT/Encoder.lean index 4b3fce6f1c..67757d404a 100644 --- a/Strata/DL/SMT/Encoder.lean +++ b/Strata/DL/SMT/Encoder.lean @@ -177,7 +177,7 @@ private theorem extractTriggerGroup_sizeOf (t ti : Term) (h : ti ∈ extractTrig · simp_all /-- Every term nested in `extractTriggers t` has `sizeOf ≤ sizeOf t`. -/ -private theorem extractTriggers_sizeOf (t : Term) (ts : List Term) (ti : Term) +theorem extractTriggers_sizeOf (t : Term) (ts : List Term) (ti : Term) (hts : ts ∈ extractTriggers t) (hti : ti ∈ ts) : sizeOf ti ≤ sizeOf t := by unfold extractTriggers at hts diff --git a/Strata/DL/SMT/IncrementalSolver.lean b/Strata/DL/SMT/IncrementalSolver.lean new file mode 100644 index 0000000000..4a1e65dbc7 --- /dev/null +++ b/Strata/DL/SMT/IncrementalSolver.lean @@ -0,0 +1,364 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.DL.SMT.AbstractSolver +public import Strata.DL.SMT.Factory +import Strata.DDM.Format +import Std.Data.HashMap + +/-! +# Incremental SMT-LIB Backend + +Implements `AbstractSolver Term (StateT IncrementalSolverState IO)` where the +state wraps a live solver process communicating via stdin/stdout. Unlike the +batch pipeline (write file, run solver), this backend sends commands +incrementally and reads responses interactively. + +Variable shadowing is handled by appending `@N` suffixes to disambiguate +repeated declarations of the same name. The shadow depth is tracked per name. +-/ + +namespace Strata.SMT + +public section + +/-- State for the incremental SMT-LIB solver backend. Wraps a live solver + process and tracks variable shadowing for `declareNew`. -/ +structure IncrementalSolverState where + /-- The underlying SMT-LIB solver process. -/ + solver : SMTLibSolver + /-- Caches `Term → SMT-LIB string` conversions. -/ + termStrings : Std.HashMap Term String := {} + /-- Caches `TermType → SMT-LIB string` conversions. -/ + typeStrings : Std.HashMap TermType String := {} + /-- Tracks how many times each variable name has been declared (for shadowing). -/ + shadowCounts : Std.HashMap String Nat := {} + /-- Maps SMT-LIB string → Term for the last `checkSatAssuming` call, + used by `getUnsatAssumptions` to recover terms from solver output. -/ + lastAssumptions : Std.HashMap String Term := {} + +/-- The monad for the incremental solver backend. -/ +abbrev IncrementalSolverM := StateT IncrementalSolverState IO + +namespace IncrementalSolver + +def emitln (str : String) : IncrementalSolverM Unit := do + let st ← get + st.solver.smtLibInput.putStr s!"{str}\n" + st.solver.smtLibInput.flush + +def readln : IncrementalSolverM String := do + let st ← get + match st.solver.smtLibOutput with + | .some stdout => return (← stdout.getLine).trimAscii.toString + | .none => throw (IO.userError "no output stream available") + +private def termToStr (t : Term) : IncrementalSolverM String := do + let st ← get + if let .some s := st.termStrings.get? t then return s + match Strata.SMTDDM.termToString t with + | .ok s => + modify fun st => { st with termStrings := st.termStrings.insert t s } + return s + | .error msg => throw (IO.userError s!"term serialization failed: {msg}") + +private def typeToStr (ty : TermType) : IncrementalSolverM String := do + let st ← get + if let .some s := st.typeStrings.get? ty then return s + match Strata.SMTDDM.termTypeToString ty with + | .ok s => + modify fun st => { st with typeStrings := st.typeStrings.insert ty s } + return s + | .error msg => throw (IO.userError s!"type serialization failed: {msg}") + +/-- Get the disambiguated SMT-LIB name for a variable, handling shadowing. -/ +private def disambiguatedName (name : String) (depth : Nat) : String := + if depth == 0 then name else s!"{name}@{depth}" + +/-- Spawn an incremental solver process. -/ +def spawn (path : String) (args : Array String) : IO IncrementalSolverState := do + let solver ← Solver.spawn path args + return { solver } + +/-- Shared helper for constructing quantified terms. -/ +private def mkQuantHelper (qk : QuantifierKind) + (bindings : List (String × TermType)) + (callback : List Term → IncrementalSolverM (Term × List (List Term))) + : IncrementalSolverM Term := do + let vars := bindings.map fun (name, ty) => TermVar.mk name ty + let varTerms := vars.map Term.var + let (body, triggers) ← callback varTerms + let tr := match triggers with + | [] => Term.app .triggers [] .trigger + | groups => + let triggerTerms := groups.map fun group => Term.app .triggers group .trigger + Term.app .triggers triggerTerms .trigger + return (Term.quant qk vars tr body) + +/-- Shared helper for binary comparison operations. -/ +private def mkBinCmp (op : Op) (opName : String) (ts : List Term) + : IncrementalSolverM Term := + match ts with + | [] | [_] => throw (IO.userError s!"{opName}: need at least two arguments") + | [t1, t2] => return (Term.app op [t1, t2] .bool) + | _ => throw (IO.userError s!"{opName}: pairwise comparison not yet supported") + +/-- Shared helper for variadic arithmetic operations. -/ +private def mkVarArith (op : Op) (opName : String) (ts : List Term) + : IncrementalSolverM Term := + match ts with + | [] => throw (IO.userError s!"{opName}: empty argument list") + | [t] => return t + | t :: rest => return (rest.foldl (fun acc x => Term.app op [acc, x] acc.typeOf) t) + +/-- Parse a solver check-sat response into a `Decision`. -/ +def parseDecision (line : String) : Except String Decision := + match line with + | "sat" => .ok .sat + | "unsat" => .ok .unsat + | "unknown" => .ok .unknown + | other => .error s!"unrecognized solver output: {other}" + +/-- Format datatype constructors as SMT-LIB strings. -/ +private def formatConstrs (constrs : List (String × List (String × TermType))) + : IncrementalSolverM (List String) := do + let mut result := [] + for (cname, fields) in constrs.reverse do + if fields.isEmpty then + result := s!"({cname})" :: result + else do + let mut fieldStrs := [] + for (fname, fty) in fields.reverse do + let tyStr ← typeToStr fty + fieldStrs := s!"({fname} {tyStr})" :: fieldStrs + result := s!"({cname} {String.intercalate " " fieldStrs})" :: result + return result + +/-- Construct the sort for a datatype given its name and type parameter names. -/ +private def mkDatatypeSort (name : String) (params : List String) : TermType × List TermType := + let paramSorts := params.map fun p => TermType.constr p [] + (.constr name paramSorts, paramSorts) + +/-- Build constructor/tester/selector handles for a list of constructors. -/ +private def mkConstructorHandles (selfSort : TermType) + (constrs : List (String × List (String × TermType))) + : List (DatatypeConstructorHandles Term) := + constrs.map fun (cname, fields) => + { constr := Term.app (.datatype_op .constructor cname) [] selfSort + tester := Term.app (.datatype_op .tester cname) [] .bool + selectors := fields.map fun (fname, fty) => + Term.app (.datatype_op .selector fname) [] fty } + +/-- Build the `AbstractSolver` implementation for incremental SMT-LIB. -/ +def mkIncrementalSolver : AbstractSolver Term TermType IncrementalSolverM where + setLogic logic := emitln s!"(set-logic {logic})" + setOption name value := emitln s!"(set-option :{name} {value})" + comment c := emitln s!"; {c.replace "\n" " "}" + + boolSort := return .bool + intSort := return .int + realSort := return .real + stringSort := return .string + regexSort := return .regex + bitvecSort n := return .bitvec n + arraySort k v := return .constr "Array" [k, v] + constrSort name args := return .constr name args + + mkBool b := return Term.bool b + mkInt i := return Term.int i + mkPrim p := return .prim p + mkAppOp op args retTy := return .app op args retTy + + mkAnd ts := return (ts.foldl Factory.and (Term.bool true)) + mkOr ts := return (ts.foldl Factory.or (Term.bool false)) + mkNot t := return (Factory.not t) + mkImplies t1 t2 := return (Factory.implies t1 t2) + + mkAdd ts := mkVarArith .add "mkAdd" ts + mkSub ts := mkVarArith .sub "mkSub" ts + mkMul ts := mkVarArith .mul "mkMul" ts + mkDiv t1 t2 := return (Term.app .div [t1, t2] t1.typeOf) + mkMod t1 t2 := return (Term.app .mod [t1, t2] t1.typeOf) + mkNeg t := return (Term.app .neg [t] t.typeOf) + mkAbs t := return (Term.app .abs [t] t.typeOf) + + mkEq ts := match ts with + | [] | [_] => throw (IO.userError "mkEq: need at least two arguments") + | [t1, t2] => return (Factory.eq t1 t2) + | t1 :: t2 :: rest => + return (rest.foldl (fun acc x => Factory.and acc (Factory.eq t1 x)) (Factory.eq t1 t2)) + mkLt ts := mkBinCmp .lt "mkLt" ts + mkLe ts := mkBinCmp .le "mkLe" ts + mkGt ts := mkBinCmp .gt "mkGt" ts + mkGe ts := mkBinCmp .ge "mkGe" ts + + mkIte c t f := return (Factory.ite c t f) + + mkSelect arr idx := return (Term.app .select [arr, idx] arr.typeOf) + mkStore arr idx val := return (Term.app .store [arr, idx, val] arr.typeOf) + mkApp fn args := match fn with + | .app (.uf uf) _ _ => return (Term.app (.uf uf) args uf.out) + | .app (.datatype_op kind name) _ retTy => return (Term.app (.datatype_op kind name) args retTy) + | _ => throw (IO.userError "mkApp: expected a function handle (uninterpreted function or datatype op)") + + declareNew name ty := do + let st ← get + let count := st.shadowCounts.getD name 0 + let smtName := disambiguatedName name count + set { st with shadowCounts := st.shadowCounts.insert name (count + 1) } + let tyStr ← typeToStr ty + emitln s!"(declare-const {quoteIdent smtName} {tyStr})" + return Term.var ⟨smtName, ty⟩ + + declareFun name argTys retTy := do + let retStr ← typeToStr retTy + if argTys.isEmpty then + emitln s!"(declare-const {quoteIdent name} {retStr})" + else + let mut argStrs := [] + for ty in argTys.reverse do + argStrs := (← typeToStr ty) :: argStrs + let inline := String.intercalate " " argStrs + emitln s!"(declare-fun {quoteIdent name} ({inline}) {retStr})" + return Term.var ⟨name, retTy⟩ + + defineFun name args retTy body := do + let retStr ← typeToStr retTy + let mut typedArgs := [] + for (n, ty) in args.reverse do + let tyStr ← typeToStr ty + typedArgs := s!"({quoteIdent n} {tyStr})" :: typedArgs + let inline := String.intercalate " " typedArgs + let bodyStr ← termToStr body + emitln s!"(define-fun {quoteIdent name} ({inline}) {retStr} {bodyStr})" + + declareSort name arity := do + emitln s!"(declare-sort {name} {arity})" + return (.constr name (List.replicate arity (.constr "_" []))) + + declareDatatype name params callback := do + let (selfSort, paramSorts) := mkDatatypeSort name params + match callback selfSort paramSorts with + | .error msg => throw (IO.userError msg) + | .ok constrs => + let strs ← formatConstrs constrs + let cInline := "\n " ++ String.intercalate "\n " strs + if params.isEmpty then + emitln s!"(declare-datatype {name} ({cInline}))" + else + let pInline := String.intercalate " " params + emitln s!"(declare-datatype {name} (par ({pInline}) ({cInline})))" + return { sort := selfSort, constructors := mkConstructorHandles selfSort constrs } + + declareDatatypes dts callback := do + if dts.isEmpty then return [] + let sortsAndParams := dts.map fun (name, params) => mkDatatypeSort name params + let selfSorts := sortsAndParams.map (·.1) + let paramSorts := sortsAndParams.map (·.2) + match callback selfSorts paramSorts with + | .error msg => throw (IO.userError msg) + | .ok allConstrs => + let sortDecls := dts.map fun (name, params) => s!"({name} {params.length})" + let sortDeclStr := String.intercalate " " sortDecls + let mut bodies := [] + for ((_, params), constrs) in (dts.zip allConstrs).reverse do + let strs ← formatConstrs constrs + let cInline := String.intercalate " " strs + if params.isEmpty then + bodies := s!"({cInline})" :: bodies + else + let pInline := String.intercalate " " params + bodies := s!"(par ({pInline}) ({cInline}))" :: bodies + let bodyStr := String.intercalate "\n " bodies + emitln s!"(declare-datatypes ({sortDeclStr})\n ({bodyStr}))" + return (selfSorts.zip allConstrs |>.map fun (sort, constrs) => + { sort, constructors := mkConstructorHandles sort constrs }) + + mkForall bindings callback := do + mkQuantHelper .all bindings callback + + mkExists bindings callback := do + mkQuantHelper .exist bindings callback + + assert t := do + let s ← termToStr t + emitln s!"(assert {s})" + + checkSat := do + emitln "(check-sat)" + let result ← readln + match parseDecision result with + | .ok d => return d + | .error msg => throw (IO.userError msg) + + checkSatAssuming assumptions := do + let mut strs := [] + let mut assumptionMap : Std.HashMap String Term := {} + for t in assumptions.reverse do + let s ← termToStr t + strs := s :: strs + assumptionMap := assumptionMap.insert s t + modify fun st => { st with lastAssumptions := assumptionMap } + let inline := String.intercalate " " strs + emitln s!"(check-sat-assuming ({inline}))" + let result ← readln + match parseDecision result with + | .ok d => return d + | .error msg => throw (IO.userError msg) + + getModel := throw (IO.userError "getModel: not yet implemented for incremental backend") + + getUnsatAssumptions := do + emitln "(get-unsat-assumptions)" + let response ← readln + -- Response is "(lit1 lit2 ...)" — strip parens and split + let inner := response.replace "(" "" |>.replace ")" "" + if inner.trimAscii.toString.isEmpty then return [] + let literals := inner.trimAscii.toString.splitOn " " |>.filter (!·.isEmpty) + let assumptionMap := (← get).lastAssumptions + let mut result := [] + for lit in literals.reverse do + match assumptionMap.get? lit with + | some t => result := t :: result + | none => throw (IO.userError s!"getUnsatAssumptions: unknown literal '{lit}'") + return result + + getValue ts := do + -- Send get-value command with the given terms + let mut strs := [] + for t in ts.reverse do + strs := (← termToStr t) :: strs + let inline := String.intercalate " " strs + emitln s!"(get-value ({inline}))" + -- Read the response (a single s-expression, possibly multi-line) + let mut modelOutput := "" + let mut reading := true + let mut parenDepth : Int := 0 + while reading do + let respLine ← readln + if respLine.isEmpty then + reading := false + else + modelOutput := modelOutput ++ respLine ++ "\n" + for c in respLine.toList do + if c == '(' then parenDepth := parenDepth + 1 + else if c == ')' then parenDepth := parenDepth - 1 + if parenDepth ≤ 0 then reading := false + -- Return the raw output as a single pair (the verifier parses it) + return [(Term.string modelOutput, Term.string modelOutput)] + + termToSMTLibString t := return (← termToStr t) + + reset := emitln "(reset)" + + close := emitln "(exit)" + +end IncrementalSolver + +end + +end Strata.SMT diff --git a/Strata/DL/SMT/SMT.lean b/Strata/DL/SMT/SMT.lean index 53161c9f56..67fbaf1093 100644 --- a/Strata/DL/SMT/SMT.lean +++ b/Strata/DL/SMT/SMT.lean @@ -5,9 +5,11 @@ -/ module +public import Strata.DL.SMT.AbstractSolver public import Strata.DL.SMT.Encoder public import Strata.DL.SMT.Factory public import Strata.DL.SMT.Function +public import Strata.DL.SMT.IncrementalSolver public import Strata.DL.SMT.Op public import Strata.DL.SMT.Solver public import Strata.DL.SMT.Term diff --git a/Strata/DL/SMT/Solver.lean b/Strata/DL/SMT/Solver.lean index 8b12459bf1..d49e2b8529 100644 --- a/Strata/DL/SMT/Solver.lean +++ b/Strata/DL/SMT/Solver.lean @@ -37,35 +37,55 @@ inductive Decision where deriving DecidableEq, Repr /-- - A Solver is an interpreter for SMTLib scripts, which are passed to the solver - via its `smtLibInput` stream. Solvers optionally have an `smtLibOutput` stream - to which they print the results of executing the commands received on the input - stream. We assume that both the input and output streams conform to the SMTLib - standard: the inputs are SMTLib script commands encoded as s-expressions, and - the outputs are the s-expressions whose shape is determined by the standard for - each command. We don't have an error stream here, since we configure solvers to - run in quiet mode and not print anything to the error stream. + An SMT-LIB solver process wrapper. + + An SMTLibSolver is an interpreter for SMTLib scripts, which are passed to the + solver via its `smtLibInput` stream. Solvers optionally have an `smtLibOutput` + stream to which they print the results of executing the commands received on + the input stream. We assume that both the input and output streams conform to + the SMTLib standard: the inputs are SMTLib script commands encoded as + s-expressions, and the outputs are the s-expressions whose shape is determined + by the standard for each command. We don't have an error stream here, since we + configure solvers to run in quiet mode and not print anything to the error + stream. -/ -structure Solver where +structure SMTLibSolver where smtLibInput : IO.FS.Stream smtLibOutput : Option IO.FS.Stream -/-- State tracked by `SolverM`: caches `Term → SMT-LIB string` and +/-- Backward-compatible alias for `SMTLibSolver`. -/ +abbrev Solver := SMTLibSolver + +/-- State tracked by `SMTLibSolverM`: caches `Term → SMT-LIB string` and `TermType → SMT-LIB string` conversions so that the same term/type is never converted twice. -/ -structure SolverState where +structure SMTLibSolverState where /-- Caches `Term → full SMT-LIB string` via `SMTDDM.termToString`. -/ termStrings : Std.HashMap Term String := {} /-- Caches `TermType → full SMT-LIB string` via `SMTDDM.termTypeToString`. -/ typeStrings : Std.HashMap TermType String := {} -def SolverState.init : SolverState := {} +def SMTLibSolverState.init : SMTLibSolverState := {} + +/-- Backward-compatible alias for `SMTLibSolverState`. -/ +abbrev SolverState := SMTLibSolverState + +/-- Backward-compatible alias. -/ +abbrev SolverState.init := SMTLibSolverState.init -@[expose] abbrev SolverM (α) := StateT SolverState (ReaderT Solver IO) α +/-- SMT-LIB solver monad. Renamed from `SolverM` to `SMTLibSolverM` + to distinguish from the abstract solver interface. -/ +@[expose] abbrev SMTLibSolverM (α) := StateT SolverState (ReaderT Solver IO) α + +/-- Backward-compatible alias for `SMTLibSolverM`. -/ +abbrev SolverM := SMTLibSolverM def SolverM.run (solver : Solver) (x : SolverM α) (state : SolverState := SolverState.init) : IO (α × SolverState) := ReaderT.run (StateT.run x state) solver +/-- Alias for `SolverM.run`. -/ +abbrev SMTLibSolverM.run := @SolverM.run + /-- A typed SMT-LIB datatype constructor: name + typed fields. -/ structure SMTConstructor where name : String @@ -75,11 +95,11 @@ deriving Repr, Inhabited namespace Solver /-- - Returns a Solver for the given path and arguments. This function expects - `path` to point to an SMT solver executable, and `args` to specify valid - arguments to that solver. + Returns an SMTLibSolver for the given path and arguments. This function + expects `path` to point to an SMT solver executable, and `args` to specify + valid arguments to that solver. -/ -def spawn (path : String) (args : Array String) : IO Solver := do +def spawn (path : String) (args : Array String) : IO SMTLibSolver := do try let proc ← IO.Process.spawn { stdin := .piped @@ -97,7 +117,7 @@ def spawn (path : String) (args : Array String) : IO Solver := do Returns an instance of the solver that is backed by the executable specified in the environment variable "SOLVER". -/ -def solver : IO Solver := do +def solver : IO SMTLibSolver := do match (← IO.getEnv "SOLVER") with | .some path => spawn path ["--quiet", "--lang", "smt"].toArray | .none => throw (IO.userError "SOLVER environment variable not defined.") @@ -109,7 +129,7 @@ def solver : IO Solver := do useful). For example, `Solver.checkSat` returns `Decision.unknown`. This function expects `h` to be write-enabled. -/ -def fileWriter (h : IO.FS.Handle) : IO Solver := +def fileWriter (h : IO.FS.Handle) : IO SMTLibSolver := return ⟨IO.FS.Stream.ofHandle h, .none⟩ /-- @@ -118,7 +138,7 @@ def fileWriter (h : IO.FS.Handle) : IO Solver := return values that are sound according to the SMTLIb spec (but generally not useful). For example, `Solver.checkSat` returns `Decision.unknown`. -/ -def bufferWriter (b : IO.Ref IO.FS.Stream.Buffer) : IO Solver := +def bufferWriter (b : IO.Ref IO.FS.Stream.Buffer) : IO SMTLibSolver := return ⟨IO.FS.Stream.ofBuffer b, .none⟩ /-! ## Internal helpers -/ @@ -128,7 +148,7 @@ private def emitln (str : String) : SolverM Unit := do solver.smtLibInput.putStr s!"{str}\n" solver.smtLibInput.flush -/-- Convert a `Term` to its SMT-LIB string, using the `SolverState` cache. -/ +/-- Convert a `Term` to its SMT-LIB string, using the `SMTLibSolverState` cache. -/ def termToSMTString (t : Term) : SolverM String := do if let (.some s) := (← get).termStrings.get? t then return s match Strata.SMTDDM.termToString t with @@ -137,7 +157,7 @@ def termToSMTString (t : Term) : SolverM String := do return s | .error msg => throw (IO.userError s!"Solver.termToSMTString failed: {msg}") -/-- Convert a `TermType` to its SMT-LIB string, using the `SolverState` cache. -/ +/-- Convert a `TermType` to its SMT-LIB string, using the `SMTLibSolverState` cache. -/ def typeToSMTString (ty : TermType) : SolverM String := do if let (.some s) := (← get).typeStrings.get? ty then return s match Strata.SMTDDM.termTypeToString ty with diff --git a/Strata/Languages/Core/Options.lean b/Strata/Languages/Core/Options.lean index 15d80e5c6b..1ae64192f8 100644 --- a/Strata/Languages/Core/Options.lean +++ b/Strata/Languages/Core/Options.lean @@ -197,6 +197,10 @@ structure VerifyOptions where outputSarif : Bool /-- Print elapsed time for each verification sub-step. -/ profile : Bool + /-- Use the incremental solver backend (stdin/stdout) instead of the + batch pipeline (write file, run solver). Opt-in via `--incremental`; + disabled automatically with `--no-solve`. -/ + incremental : Bool def VerifyOptions.default : VerifyOptions := { verbose := .normal, @@ -216,6 +220,7 @@ def VerifyOptions.default : VerifyOptions := { uniqueBoundNames := false skipSolver := false profile := false + incremental := false pathCap := .none } diff --git a/Strata/Languages/Core/SMTEncoder.lean b/Strata/Languages/Core/SMTEncoder.lean index 59476c1de8..57593a85fd 100644 --- a/Strata/Languages/Core/SMTEncoder.lean +++ b/Strata/Languages/Core/SMTEncoder.lean @@ -95,7 +95,7 @@ def SMT.Context.withTypeFactory (ctx : SMT.Context) (tf : @Lambda.TypeFactory Co Helper function to convert LMonoTy to TermType for datatype constructor fields. Handles monomorphic types and type variables (as `.constr tv []`). -/ -private def lMonoTyToTermType (useArrayTheory : Bool := false) (ty : LMonoTy) : TermType := +def lMonoTyToTermType (useArrayTheory : Bool := false) (ty : LMonoTy) : TermType := match ty with | .bitvec n => .bitvec n | .tcons "bool" [] => .bool @@ -119,7 +119,7 @@ private def datatypeConstructorsToSMT (d : LDatatype CoreLParams.IDMeta) (useArr /-- Ensures that all datatypes in the SMT encoding do not have arrow-typed constructor arguments-/ -private def validateDatatypesForSMT (typeFactory : @Lambda.TypeFactory CoreLParams.IDMeta) +def validateDatatypesForSMT (typeFactory : @Lambda.TypeFactory CoreLParams.IDMeta) (seenDatatypes : Std.HashSet String) : Except Format Unit := do for block in typeFactory.toList do for d in block do diff --git a/Strata/Languages/Core/Verifier.lean b/Strata/Languages/Core/Verifier.lean index c4b1fb0026..86441d2fbb 100644 --- a/Strata/Languages/Core/Verifier.lean +++ b/Strata/Languages/Core/Verifier.lean @@ -14,6 +14,7 @@ public import Strata.DL.Imperative.MetaData public import Strata.DL.Imperative.SMTUtils public import Strata.DDM.AST public import Strata.Languages.Core.PipelinePhase +import Strata.DL.SMT.IncrementalSolver import Strata.Transform.CallElim import Strata.Transform.FilterProcedures import Strata.Transform.PrecondElim @@ -33,22 +34,312 @@ open Strata public section -/-- Encode a verification condition into SMT-LIB format. - -This function encodes the path conditions (P) and obligation (Q) into SMT, -then emits check-sat commands to determine satisfiability and/or validity. - -When both checks are requested, uses check-sat-assuming for efficiency: -- Satisfiability: (check-sat-assuming (Q)) tests if P ∧ Q is satisfiable -- Validity: (check-sat-assuming ((not Q))) tests if P ∧ ¬Q is satisfiable - -When only one check is requested, uses assert + check-sat: -- For satisfiability: (assert Q) (check-sat) tests P ∧ Q -- For validity: (assert (not Q)) (check-sat) tests P ∧ ¬Q +/-- Encoder state for the abstract solver backend. Extends `EncoderState` with + a cache of `τ` handles for declared variables, so that `encodeTerm` can + look up handles by name instead of requiring a `mkVar` method on the solver. -/ +structure AbstractEncoderState (τ : Type) where + /-- The underlying encoder state (UF name mappings). -/ + base : EncoderState + /-- Maps declared variable/function names to their solver handles. + Populated by `encodeUF` / `declareFun`; looked up by `encodeTerm`. -/ + varHandles : Std.HashMap String τ := {} + +/-- Encoder monad over an abstract solver backend. + Parameterized by the underlying monad `m` and the solver's term type `τ` + so the encoder is not tied to any particular solver backend. -/ +abbrev AbstractEncoderM (τ : Type) (m : Type → Type) := StateT (AbstractEncoderState τ) m + +namespace AbstractEncoder + +variable {τ σ : Type} {m : Type → Type} [Monad m] [MonadExceptOf IO.Error m] + +/-- Convert a `TermType` to the solver's sort type `σ` by dispatching on + the sort primitives provided by the solver. This is the sort-level + counterpart of `encodeTerm`: both convert a Strata representation to a + solver-native handle by pattern-matching on constructors. Keeping this + logic in the encoder (rather than in `AbstractSolver`) means backends + only need to implement the one-liner sort primitives, not a full + dispatching method. -/ +def termTypeToSort (solver : AbstractSolver τ σ m) (ty : TermType) : m σ := do + match ty with + | .prim .bool => solver.boolSort + | .prim .int => solver.intSort + | .prim .real => solver.realSort + | .prim .string => solver.stringSort + | .prim .regex => solver.regexSort + | .prim (.bitvec n) => solver.bitvecSort n + | .prim .trigger => solver.boolSort + | .option inner => do + let s ← termTypeToSort solver inner + solver.constrSort "Option" [s] + | .constr name args => do + if name == "Array" then + match args with + | [k, v] => do + let ks ← termTypeToSort solver k + let vs ← termTypeToSort solver v + solver.arraySort ks vs + | _ => solver.constrSort name [] + else + let argSorts ← args.attach.mapM fun ⟨t, _⟩ => termTypeToSort solver t + solver.constrSort name argSorts +termination_by sizeOf ty +decreasing_by + all_goals simp_wf + all_goals (try omega) <;> (have := List.sizeOf_lt_of_mem ‹_›; omega) + +private def encodeUF (solver : AbstractSolver τ σ m) (uf : UF) : AbstractEncoderM τ m String := do + if let .some enc := (← get).base.ufs.get? uf then return enc + let baseName := sanitizeSmtName uf.id + let existingNames := (← get).base.ufs.toList.map (·.2) + let usedNames := Std.HashSet.ofList (existingNames ++ smtReservedKeywords) + let id := Strata.Name.findUnique baseName 1 usedNames + liftM (solver.comment uf.id) + let argSorts ← uf.args.mapM (fun vt => liftM (termTypeToSort solver vt.ty)) + let outSort ← liftM (termTypeToSort solver uf.out) + let handle ← liftM (solver.declareFun id argSorts outSort) + modify fun st => { st with varHandles := st.varHandles.insert id handle } + modifyGet fun state => (id, { state with base := { state.base with ufs := state.base.ufs.insert uf id } }) + +private def defineApp (solver : AbstractSolver τ σ m) (retSort : σ) (op : Op) (tEncs : List τ) : AbstractEncoderM τ m τ := do + -- Pattern: `liftM` lifts solver calls from `m` into `StateT`. + match op, tEncs with + -- Boolean operations + | .and, _ => liftM (solver.mkAnd tEncs) + | .or, _ => liftM (solver.mkOr tEncs) + | .not, [t] => liftM (solver.mkNot t) + | .implies, [a,b] => liftM (solver.mkImplies a b) + | .eq, _ => liftM (solver.mkEq tEncs) + | .ite, [c,t,f] => liftM (solver.mkIte c t f) + -- Arithmetic operations + | .add, _ => liftM (solver.mkAdd tEncs) + | .sub, _ => liftM (solver.mkSub tEncs) + | .mul, _ => liftM (solver.mkMul tEncs) + | .div, [a, b] => liftM (solver.mkDiv a b) + | .mod, [a, b] => liftM (solver.mkMod a b) + | .neg, [t] => liftM (solver.mkNeg t) + | .abs, [t] => liftM (solver.mkAbs t) + -- Comparison operations + | .lt, _ => liftM (solver.mkLt tEncs) + | .le, _ => liftM (solver.mkLe tEncs) + | .gt, _ => liftM (solver.mkGt tEncs) + | .ge, _ => liftM (solver.mkGe tEncs) + -- Array operations + | .select, [a, i] => liftM (solver.mkSelect a i) + | .store, [a,i,v] => liftM (solver.mkStore a i v) + -- Uninterpreted functions: declare and apply + | .uf f, _ => + let ufName ← encodeUF solver f + let ufRef : UF := { id := ufName, args := f.args, out := f.out } + let outSort ← liftM (termTypeToSort solver ufRef.out) + let handle ← liftM (solver.mkAppOp (.uf ufRef) [] outSort) + liftM (solver.mkApp handle tEncs) + -- Datatype operations: build handle and apply + | .datatype_op kind name, _ => + let handle ← liftM (solver.mkAppOp (.datatype_op kind name) [] retSort) + liftM (solver.mkApp handle tEncs) + -- All other operations (bitvectors, strings, etc.): route through mkAppOp + | _, _ => liftM (solver.mkAppOp op tEncs retSort) + +private def defineQuantifierHelper (solver : AbstractSolver τ σ m) (qk : QuantifierKind) + (args : List TermVar) + (encodeBody : AbstractEncoderM τ m τ) + (encodeTriggers : AbstractEncoderM τ m (List (List τ))) + : AbstractEncoderM τ m τ := do + let bindings ← args.mapM fun v => do + let s ← liftM (termTypeToSort solver v.ty) + return (v.id, s) + let mkQuant := match qk with + | .all => solver.mkForall + | .exist => solver.mkExists + -- Capture the encoder state so the callback can encode the body and + -- triggers with the bound variable handles in scope. The inner state + -- is intentionally not propagated back: bound variable handles are scoped + -- to the quantifier, and free variables in the body are already declared + -- before the quantifier is encoded. + let st ← get + liftM (mkQuant bindings (fun vars => do + let stWithVars := { st with + varHandles := args.zip vars |>.foldl + (fun m (v, h) => m.insert v.id h) st.varHandles } + let (bodyEnc, st') ← encodeBody.run stWithVars + let (trEncs, _) ← encodeTriggers.run st' + return (bodyEnc, trEncs))) + +def encodeTerm (solver : AbstractSolver τ σ m) (t : Term) : AbstractEncoderM τ m τ := do + match t with + | .var v => + -- Look up the τ handle cached when the variable was declared via declareFun/declareNew + match (← get).varHandles.get? v.id with + | .some handle => return handle + | .none => + -- Variable not yet declared — declare it now via declareNew + let s ← liftM (termTypeToSort solver v.ty) + let handle ← liftM (solver.declareNew v.id s) + modify fun st => { st with varHandles := st.varHandles.insert v.id handle } + return handle + | .prim p => liftM (solver.mkPrim p) + | .none ty => + -- Option none: use the datatype constructor via mkAppOp + let retSort ← liftM (termTypeToSort solver (.option ty)) + liftM (solver.mkAppOp (.datatype_op .constructor "none") [] retSort) + | .some t₁ => + -- Option some: encode the inner term and apply the constructor via mkAppOp + let t₁Enc ← encodeTerm solver t₁ + let retSort ← liftM (termTypeToSort solver (.option t₁.typeOf)) + let handle ← liftM (solver.mkAppOp (.datatype_op .constructor "some") [] retSort) + liftM (solver.mkApp handle [t₁Enc]) + | .app .re_allchar [] .regex => + let s ← liftM (termTypeToSort solver .regex) + liftM (solver.mkAppOp .re_allchar [] s) + | .app .re_all [] .regex => + let s ← liftM (termTypeToSort solver .regex) + liftM (solver.mkAppOp .re_all [] s) + | .app .re_none [] .regex => + let s ← liftM (termTypeToSort solver .regex) + liftM (solver.mkAppOp .re_none [] s) + | .app .bvnego [inner] .bool => + match inner.typeOf with + | .bitvec n => + let innerEnc ← encodeTerm solver inner + let minVal ← liftM (solver.mkPrim (.bitvec (BitVec.intMin n))) + let retSort ← liftM (termTypeToSort solver .bool) + defineApp solver retSort .eq [innerEnc, minVal] + | _ => liftM (solver.mkBool false) + | .app op ts _ => + let retSort ← liftM (termTypeToSort solver t.typeOf) + defineApp solver retSort op (← mapM₁ ts (fun ⟨tᵢ, _⟩ => encodeTerm solver tᵢ)) + | .quant qk qargs tr body => + let trExprs := if Factory.isSimpleTrigger tr then [] else extractTriggers tr + defineQuantifierHelper solver qk qargs + (encodeTerm solver body) + (mapM₁ trExprs (fun ⟨ts, _⟩ => mapM₁ ts (fun ⟨ti, _⟩ => encodeTerm solver ti))) +termination_by sizeOf t +decreasing_by + all_goals first + | term_by_mem + | add_mem_size_lemmas + have hmem : _ ∈ (if Factory.isSimpleTrigger tr then ([] : List (List Term)) else extractTriggers tr) := ‹_ ∈ trExprs› + split at hmem + · simp at hmem + · have := extractTriggers_sizeOf tr _ _ hmem ‹_ ∈ _› + simp_all; omega + +private def encodeFunction (solver : AbstractSolver τ σ m) (uf : UF) (body : Term) : AbstractEncoderM τ m String := do + if let .some enc := (← get).base.ufs.get? uf then return enc + let id := ufId (← get).base.ufs.size + liftM (solver.comment uf.id) + let argPairs ← uf.args.mapM fun vt => do + let s ← liftM (termTypeToSort solver vt.ty) + return (vt.id, s) + let outSort ← liftM (termTypeToSort solver uf.out) + let bodyEnc ← encodeTerm solver body + liftM (solver.defineFun id argPairs outSort bodyEnc) + modifyGet fun state => (id, { state with base := { state.base with ufs := state.base.ufs.insert uf id } }) + +end AbstractEncoder + +/-- Build constructor declarations for a datatype, converting field types + through the solver's `termTypeToSort`. -/ +private def datatypeConstrsM [Monad m] [MonadExceptOf IO.Error m] (solver : AbstractSolver τ σ m) + (d : Lambda.LDatatype Core.CoreLParams.IDMeta) + : m (List (String × List (String × σ))) := do + let mut result := [] + for c in d.constrs.reverse do + let mut fields := [] + for (name, fieldTy) in c.args.reverse do + let s ← AbstractEncoder.termTypeToSort solver (Core.lMonoTyToTermType (ty := fieldTy)) + fields := (d.name ++ ".." ++ name.name, s) :: fields + result := (c.name.name, fields) :: result + return result + +/-- Emit datatype declarations through the `AbstractSolver` API. -/ +private def emitDatatypesAbstract [Monad m] [MonadExceptOf IO.Error m] + (solver : AbstractSolver τ σ m) (ctx : Core.SMT.Context) : m Unit := do + -- Validate that no datatype has arrow-typed fields (same check as batch path) + match Core.validateDatatypesForSMT ctx.typeFactory ctx.seenDatatypes with + | .error msg => throw (IO.userError (toString msg)) + | .ok () => pure () + for block in ctx.typeFactory.toList do + let usedBlock := block.filter (fun d => ctx.seenDatatypes.contains d.name) + match usedBlock with + | [] => pure () + | [d] => + let constrs ← datatypeConstrsM solver d + let _ ← solver.declareDatatype d.name d.typeArgs + fun _ _ => .ok constrs + | _ => + let dtHeaders := usedBlock.map fun d => (d.name, d.typeArgs) + let allConstrs ← usedBlock.mapM (datatypeConstrsM solver) + let _ ← solver.declareDatatypes dtHeaders + fun _ _ => .ok allConstrs + +/-- Encode declarations and assertions through the `AbstractSolver` API. + Replaces `encodeDeclarations` for the incremental path — all commands + go through `AbstractSolver` methods instead of `SolverM`. + + Parameterized by the solver backend monad `m` and the solver's term/sort + types `τ`/`σ` so any implementation of `AbstractSolver τ σ m` can be used + (e.g. incremental SMT-LIB, cvc5 FFI). + + `prelude` is a deferred monadic action (e.g. solver option settings) + executed after `setLogic` but before declarations. The caller constructs + it inside the solver session and passes it in as a callback. -/ +def encodeDeclarationsAbstract [Monad m] [MonadExceptOf IO.Error m] + (solver : AbstractSolver τ σ m) + (ctx : Core.SMT.Context) + (prelude : m Unit) + (assumptionTerms : List Term) (obligationTerm : Term) + (varDefinitions : List Core.VarDefinition := []) + (varDeclarations : List Core.VarDeclaration := []) + : m (τ × List String × EncoderState) := do + solver.setLogic "ALL" + prelude + for s in ctx.sorts do + -- Skip sorts that will be defined as datatypes by emitDatatypesAbstract, + -- since strict solver APIs (e.g. cvc5 FFI) reject redefinition. + if !ctx.seenDatatypes.contains s.name then + let _ ← solver.declareSort s.name s.arity + emitDatatypesAbstract solver ctx + let initState : AbstractEncoderState τ := { base := EncoderState.init } + let varDefNames := varDefinitions.map (·.name) + let varDeclNames := varDeclarations.map (·.name) + let managedNames := varDefNames ++ varDeclNames + -- Filter out managed variables from UF declarations (they will be emitted separately) + let ufsToDecl := if managedNames.isEmpty then ctx.ufs + else ctx.ufs.filter fun uf => !managedNames.contains uf.id + let (_ufs, estate) ← ufsToDecl.mapM (fun uf => AbstractEncoder.encodeUF solver uf) |>.run initState + -- Pre-populate encoder state with managed variable names so encodeTerm + -- recognizes them without emitting declareFun + let estate := if managedNames.isEmpty then estate + else + let managedUfs := ctx.ufs.filter fun uf => managedNames.contains uf.id + managedUfs.foldl (init := estate) fun estate uf => + { estate with base := { estate.base with ufs := estate.base.ufs.insert uf uf.id } } + let (_ifs, estate) ← ctx.ifs.mapM (fun fn => AbstractEncoder.encodeFunction solver fn.uf fn.body) |>.run estate + let (_axms, estate) ← ctx.axms.mapM (fun ax => AbstractEncoder.encodeTerm solver ax) |>.run estate + for id in _axms do + solver.assert id + -- Emit variable declarations as declareFun + for decl in varDeclarations do + let sort ← AbstractEncoder.termTypeToSort solver decl.ty + let _ ← solver.declareFun decl.name [] sort + -- Emit variable definitions as defineFun + let estate ← varDefinitions.foldlM (init := estate) fun estate def_ => do + let (bodyEnc, estate) ← (AbstractEncoder.encodeTerm solver def_.body) |>.run estate + let sort ← AbstractEncoder.termTypeToSort solver def_.ty + solver.defineFun def_.name [] sort bodyEnc + pure estate + let (assumptionIds, estate) ← assumptionTerms.mapM (AbstractEncoder.encodeTerm solver) |>.run estate + for id in assumptionIds do + solver.assert id + let (obligationId, estate) ← (AbstractEncoder.encodeTerm solver obligationTerm) |>.run estate + let ids := estate.base.ufs.toList.filterMap fun (uf, id) => + if uf.args.isEmpty && !managedNames.contains uf.id then some id else none + return (obligationId, ids, estate.base) -Note: The obligation term Q is encoded without negation. Negation is applied -when needed for the validity check (line 64 for check-sat-assuming, line 77 for assert). --/ +/-- Encode a verification condition into SMT-LIB format, including check-sat + commands. Used by the batch pipeline. -/ def encodeCore (ctx : Core.SMT.Context) (prelude : SolverM Unit) (assumptionTerms : List Term) (obligationTerm : Term) (md : Imperative.MetaData Core.Expression) @@ -230,6 +521,50 @@ def dischargeObligation satisfiabilityCheck validityCheck (skipSolver := options.skipSolver) +/-- Discharge a proof obligation using the incremental solver backend. + Spawns a live solver process, sends commands via stdin/stdout, and + reads results interactively. Returns the same result triple as the + batch `dischargeObligation`. -/ +def dischargeObligationIncremental + (options : VerifyOptions) + (vars : List Expression.TypedIdent) + (_md : Imperative.MetaData Expression) + (assumptionTerms : List Term) + (obligationTerm : Term) + (ctx : SMT.Context) + (satisfiabilityCheck validityCheck : Bool) + (_label : String) + (varDefinitions : List VarDefinition := []) + (varDeclarations : List VarDeclaration := []) + : IO (Except Imperative.SMT.SolverError (SMT.Result × SMT.Result × EncoderState)) := do + let baseFlags := getSolverFlags options + let needsIncremental := satisfiabilityCheck && validityCheck + let solverSpecificFlags := match options.solver with + | "cvc5" => + let base := #["--quiet", "--lang", "smt"] + if needsIncremental && !baseFlags.contains "--incremental" then + base ++ #["--incremental"] + else base + | "z3" => #["-in"] + | _ => #[] + let allFlags := solverSpecificFlags ++ baseFlags + let encodeDecl (solver : Strata.SMT.AbstractSolver Term TermType + Strata.SMT.IncrementalSolverM) : + Strata.SMT.IncrementalSolverM Imperative.SMT.EncodedObligation := do + let prelude : Strata.SMT.IncrementalSolverM Unit := match options.solver with + | "z3" => do + solver.setOption "smt.mbqi" "false" + solver.setOption "auto_config" "false" + | _ => pure () + let (obligationId, ids, estate) ← + _root_.Strata.SMT.Encoder.encodeDeclarationsAbstract solver ctx prelude + assumptionTerms obligationTerm + (varDefinitions := varDefinitions) (varDeclarations := varDeclarations) + return { obligationId, assumptionIds := ids, estate } + Imperative.SMT.dischargeObligationIncremental (P := Core.Expression) + encodeDecl (typedVarToSMTFn ctx) vars options.solver allFlags + satisfiabilityCheck validityCheck + end -- public section end Core.SMT --------------------------------------------------------------------- @@ -931,6 +1266,58 @@ def SMT.Result.adjustForPhases (r : SMT.Result) | .sat _ | .unknown _ => AbstractedPhase.validateModel phases r obligation | other => (other, []) +/-- A discharge function encapsulates the solver backend. It takes assumption + terms, the obligation term, the SMT context, and the satisfiability/validity + check flags, and returns the solver results. The pipeline is parametrized + by this function so it does not know about SMT-LIB or any specific solver. -/ +abbrev DischargeFn := + List Term → Term → SMT.Context → Bool → Bool → List VarDefinition → List VarDeclaration → + IO (Except Imperative.SMT.SolverError (SMT.Result × SMT.Result × EncoderState)) + +/-- A `CoreSMTSolver` encapsulates the strategy for discharging all proof + obligations extracted from a CoreSMT program. The pipeline is parametrized + by this function so that the solver backend can be swapped — e.g. for a + parallel solver that dispatches obligations concurrently, or an incremental + solver that shares path-condition state across assertions. + + The solver receives the factory extensions (custom functions from external + phases, e.g. `ReFactory`) and the obligation program (in CoreSMT format + after all pipeline transformations), and returns verification results + together with statistics. The factory parameter ensures custom solvers + can build the environment with the same function definitions as the + default solver. -/ +abbrev CoreSMTSolver := + @Lambda.Factory CoreLParams → Program → EIO DiagnosticModel (VCResults × Statistics) + +/-- Factory for discharge functions. Called once per obligation with the + obligation's typed variables, metadata, and label. A custom implementation + can replace the default (batch/incremental SMT-LIB) backend. -/ +abbrev MkDischargeFn := + VerifyOptions → IO.Ref Nat → System.FilePath → + List Expression.TypedIdent → Imperative.MetaData Expression → String → DischargeFn + +/-- Construct a `DischargeFn` from verification options. Selects the incremental + (abstract solver) backend or the batch (SMT-LIB file) backend based on + `options.incremental` and `options.alwaysGenerateSMT`. -/ +def mkDischargeFn : MkDischargeFn := fun (options : VerifyOptions) (counter : IO.Ref Nat) + (tempDir : System.FilePath) + (vars : List Expression.TypedIdent) + (md : Imperative.MetaData Expression) + (label : String) => + fun assumptionTerms obligationTerm ctx satisfiabilityCheck validityCheck + varDefinitions varDeclarations => do + if options.incremental && !options.alwaysGenerateSMT then + SMT.dischargeObligationIncremental options vars md + assumptionTerms obligationTerm ctx satisfiabilityCheck validityCheck label + (varDefinitions := varDefinitions) (varDeclarations := varDeclarations) + else + let counterVal ← counter.get + counter.set (counterVal + 1) + let filename := tempDir / s!"{SMT.sanitizeFilename label}_{counterVal}.smt2" + SMT.dischargeObligation options vars md filename.toString + assumptionTerms obligationTerm ctx satisfiabilityCheck validityCheck + (label := label) (varDefinitions := varDefinitions) (varDeclarations := varDeclarations) + /-- Invoke a backend engine and get the analysis result for a given proof obligation. @@ -938,36 +1325,18 @@ given proof obligation. def getObligationResult (assumptionTerms : List Term) (obligationTerm : Term) (ctx : SMT.Context) (obligation : ProofObligation Expression) (p : Program) - (options : VerifyOptions) (counter : IO.Ref Nat) - (tempDir : System.FilePath) (satisfiabilityCheck validityCheck : Bool) + (options : VerifyOptions) + (discharge : DischargeFn) + (satisfiabilityCheck validityCheck : Bool) (phases : List AbstractedPhase) (varDefinitions : List VarDefinition := []) (varDeclarations : List VarDeclaration := []) : EIO DiagnosticModel VCResult := do let prog := f!"\n\n[DEBUG] Evaluated program:\n{Core.formatProgram p}" - let counterVal ← counter.get - counter.set (counterVal + 1) - let filename := tempDir / s!"{Core.SMT.sanitizeFilename obligation.label}_{counterVal}.smt2" - let varsInObligation := ProofObligation.getVars obligation - -- Filter out managed variables (they are emitted as define-fun/declare-fun, not via UF declarations) - let managedNames := (varDefinitions.map (·.name)) ++ (varDeclarations.map (·.name)) - let varsInObligation := varsInObligation.filter fun (v, _) => - !managedNames.contains v.name - -- All variables in ProofObligation must have been typed. - let typedVarsInObligation ← varsInObligation.mapM - (fun (v,ty) => do - match ty with - | .some ty => return (v,LTy.forAll [] ty) - | .none => throw (DiagnosticModel.fromMessage s!"{v} untyped")) - let ans ← - IO.toEIO - (fun e => DiagnosticModel.fromFormat f!"{e}") - (SMT.dischargeObligation options - typedVarsInObligation - obligation.metadata - filename.toString - assumptionTerms obligationTerm ctx satisfiabilityCheck validityCheck - (label := obligation.label) (varDefinitions := varDefinitions) (varDeclarations := varDeclarations)) + let ans ← IO.toEIO + (fun e => DiagnosticModel.fromFormat f!"{e}") + (discharge assumptionTerms obligationTerm ctx satisfiabilityCheck validityCheck + varDefinitions varDeclarations) match ans with | .error solverError => let vcError : VCError := match solverError with @@ -1023,7 +1392,8 @@ def verifySingleEnv (oblProgram : Program) -- irrelevant axiom removal to determine which axioms to prune. (axiomProgram : Option Program := .none) (externalPhases : List AbstractedPhase := []) - (corePhases : List AbstractedPhase := coreAbstractedPhases) : + (corePhases : List AbstractedPhase := coreAbstractedPhases) + (mkDischarge : MkDischargeFn := mkDischargeFn) : EIO DiagnosticModel (VCResults × Statistics) := do -- Build SMT encoding context from the obligations program itself let E ← EIO.ofExcept (Core.buildEnv options oblProgram moreFns (registerCustomFunctions := true) |>.map (·.1)) @@ -1101,9 +1471,21 @@ def verifySingleEnv (oblProgram : Program) if options.stopOnFirstError then break | .ok (assumptionTerms, varDefs, varDecls, obligationTerm, ctx, encStats) => stats := stats.merge encStats + let varsInObligation := ProofObligation.getVars obligation + -- Filter out managed variables (they are emitted as define-fun/declare-fun, not via UF declarations) + let managedNames := (varDefs.map (·.name)) ++ (varDecls.map (·.name)) + let varsInObligation := varsInObligation.filter fun (v, _) => + !managedNames.contains v.name + let typedVarsInObligation ← varsInObligation.mapM + (fun (v,ty) => do + match ty with + | .some ty => return (v,LTy.forAll [] ty) + | .none => throw (DiagnosticModel.fromMessage s!"{v} untyped")) + let discharge := mkDischarge options counter tempDir + typedVarsInObligation obligation.metadata obligation.label let t4 ← IO.monoNanosNow let result ← getObligationResult assumptionTerms obligationTerm ctx obligation p options - counter tempDir needSatCheck needValCheck (externalPhases ++ corePhases) + discharge needSatCheck needValCheck (externalPhases ++ corePhases) (varDefinitions := varDefs) (varDeclarations := varDecls) let t5 ← IO.monoNanosNow solverNs := solverNs + (t5 - t4) @@ -1129,6 +1511,24 @@ def verifySingleEnv (oblProgram : Program) let _ ← (IO.println s!"[profile] Obligations: {obligations.size} total, {peResolvedCount} resolved by evaluator" |>.toBaseIO) return (results, stats) +/-- Construct the default `CoreSMTSolver` that discharges obligations + sequentially using the batch or incremental SMT-LIB backend (selected + by `options.incremental`). This is the standard solver used by `verify` + when no custom solver is provided. -/ +def mkDefaultCoreSMTSolver + (options : VerifyOptions) + (counter : IO.Ref Nat) (tempDir : System.FilePath) + (axiomCache : Option IrrelevantAxioms.Cache := .none) + (axiomNames : List String := []) + (axiomProgram : Option Program := .none) + (externalPhases : List AbstractedPhase := []) + (corePhases : List AbstractedPhase := coreAbstractedPhases) + (mkDischarge : MkDischargeFn := mkDischargeFn) : + CoreSMTSolver := + fun moreFns oblProgram => + verifySingleEnv oblProgram moreFns options counter tempDir axiomCache + axiomNames axiomProgram externalPhases corePhases (mkDischarge := mkDischarge) + /-- Run the Strata Core verification pipeline on a program: transform, type-check, partially evaluate, and discharge proof obligations via SMT. All program-wide transformations that occur before any analyses @@ -1144,6 +1544,8 @@ def verify (program : Program) (externalPhases : List AbstractedPhase := []) (prefixPhases : List PipelinePhase := []) (keepAllFilesPrefix : Option String := none) + (solver : Option CoreSMTSolver := none) + (mkDischarge : MkDischargeFn := mkDischargeFn) : EIO DiagnosticModel VCResults := do let profile := options.profile let factory ← EIO.ofExcept (Core.Factory.addFactory moreFns) @@ -1190,7 +1592,11 @@ def verify (program : Program) if options.checkOnly then pure [] else - pure [← verifySingleEnv oblProgram moreFns options counter tempDir axiomCache? axiomNames (axiomProgram := program) externalPhases phases] + let coreSMTSolver := solver.getD + (mkDefaultCoreSMTSolver options counter tempDir axiomCache? + axiomNames (axiomProgram := program) externalPhases phases + (mkDischarge := mkDischarge)) + pure [← coreSMTSolver moreFns oblProgram] let allStats := VCss.foldl (fun acc (_, s) => acc.merge s) allStats if profile then let _ ← (IO.println allStats.format |>.toBaseIO) @@ -1238,6 +1644,8 @@ def verify (moreFns : @Lambda.Factory Core.CoreLParams := Lambda.Factory.default) (externalPhases : List Core.AbstractedPhase := []) (keepAllFilesPrefix : Option String := none) + (solver : Option Core.CoreSMTSolver := none) + (mkDischarge : Core.MkDischargeFn := Core.mkDischargeFn) : IO Core.VCResults := do let (program, errors) := Core.getProgram env ictx if errors.isEmpty then @@ -1245,7 +1653,9 @@ def verify EIO.toIO (fun dm => IO.Error.userError (toString (dm.format (some ictx.fileMap)))) (Core.verify program tempDir proceduresToVerify options moreFns (externalPhases := externalPhases) - (keepAllFilesPrefix := keepAllFilesPrefix)) + (keepAllFilesPrefix := keepAllFilesPrefix) + (solver := solver) + (mkDischarge := mkDischarge)) match options.vcDirectory with | .none => IO.FS.withTempDir runner diff --git a/Strata/SimpleAPI.lean b/Strata/SimpleAPI.lean index 4e536c732b..569fd8d68d 100644 --- a/Strata/SimpleAPI.lean +++ b/Strata/SimpleAPI.lean @@ -328,11 +328,15 @@ def Core.verifyProgram (externalPhases : List Core.AbstractedPhase := []) (prefixPhases : List Core.PipelinePhase := []) (keepAllFilesPrefix : Option String := none) + (solver : Option Core.CoreSMTSolver := none) + (mkDischarge : Core.MkDischargeFn := Core.mkDischargeFn) : EIO String Core.VCResults := do let runVerification (tempDir : System.FilePath) : IO Core.VCResults := EIO.toIO (IO.Error.userError ∘ toString) (Core.verify program tempDir proceduresToVerify options moreFns externalPhases prefixPhases - (keepAllFilesPrefix := keepAllFilesPrefix)) + (keepAllFilesPrefix := keepAllFilesPrefix) + (solver := solver) + (mkDischarge := mkDischarge)) let ioAction := match options.vcDirectory with | .some vcDir => IO.FS.createDirAll vcDir *> runVerification vcDir | .none => IO.FS.withTempDir runVerification diff --git a/StrataMain.lean b/StrataMain.lean index 1e6700ff54..b4f1c646ab 100644 --- a/StrataMain.lean +++ b/StrataMain.lean @@ -206,6 +206,8 @@ def verifyOptionsFlags : List Flag := [ { name := "overflow-checks", help := "Comma-separated overflow checks to enable (signed,unsigned,float64,all,none).", takesArg := .arg "checks" }, + { name := "incremental", + help := "Use incremental solver backend (stdin/stdout) instead of batch file I/O." }, { name := "path-cap", help := "Maximum continuing paths between statements. 'none' (default) disables; N merges paths when count exceeds N.", takesArg := .arg "N|none" } @@ -265,6 +267,7 @@ def parseVerifyOptions (pflags : ParsedFlags) removeIrrelevantAxioms, outputSarif := pflags.getBool "sarif" || base.outputSarif, profile := pflags.getBool "profile" || base.profile, + incremental := if noSolve then false else pflags.getBool "incremental" || base.incremental, skipSolver, alwaysGenerateSMT := noSolve || base.alwaysGenerateSMT, overflowChecks, From 6835d653c4b3cb2d9f11cfd4fd6f52c22f96dda7 Mon Sep 17 00:00:00 2001 From: Michael Tautschnig Date: Mon, 18 May 2026 21:01:52 +0200 Subject: [PATCH 09/28] Fix #1146: require command_datatypes to be non-empty (#1155) The Core grammar declared command_datatypes as op command_datatypes (datatypes : NewlineSepBy DatatypeDecl) : Command => datatypes ";\\n"; Without @[nonempty] on the field, NewlineSepBy compiles to a zero-or-more parser, so the trailing ";\\n" production alone matched any stray ";" in the input. This is particularly easy to trip accidentally: command_fndef's surface syntax has no trailing semicolon, so a user writing "};" at the end of a function body (by analogy with procedures, whose grammar does end in ";") silently produced a phantom command_datatypes op with zero datatypes. The phantom later tripped an explicit assertion in translateDatatypes: "Datatype block must contain at least one datatype" which calls panic!, producing a large backtrace at gen_smt_vcs time with no useful source location. Mark the datatypes field @[nonempty]. The stray ";" now surfaces as a parse error at the point it actually appears, and the original repro elaborates cleanly. Add a regression test (StrataTest/Languages/Core/Tests/Issue1146Test.lean) that pins the canonical form: a program mixing a datatype and a function can run through gen_smt_vcs without panicking. Fixes: #1146 By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: Kiro Co-authored-by: Juneyoung Lee <136006969+aqjune-aws@users.noreply.github.com> --- .../Languages/Core/DDMTransform/Grammar.lean | 5 +- .../Languages/Core/Tests/Issue1146Test.lean | 56 +++++++++++++++++++ 2 files changed, 60 insertions(+), 1 deletion(-) create mode 100644 StrataTest/Languages/Core/Tests/Issue1146Test.lean diff --git a/Strata/Languages/Core/DDMTransform/Grammar.lean b/Strata/Languages/Core/DDMTransform/Grammar.lean index 0375a10596..ae29f0cfc9 100644 --- a/Strata/Languages/Core/DDMTransform/Grammar.lean +++ b/Strata/Languages/Core/DDMTransform/Grammar.lean @@ -461,8 +461,11 @@ op datatype_decl (name : Ident, // Unified datatype command: one or more datatype declarations separated by // newlines, ending with a semicolon. +// +// `@[nonempty]` is load-bearing: see +// https://github.com/strata-org/Strata/issues/1146. @[scope(datatypes), preRegisterTypes(datatypes)] -op command_datatypes (datatypes : NewlineSepBy DatatypeDecl) : Command => +op command_datatypes (@[nonempty] datatypes : NewlineSepBy DatatypeDecl) : Command => datatypes ";\n"; #end diff --git a/StrataTest/Languages/Core/Tests/Issue1146Test.lean b/StrataTest/Languages/Core/Tests/Issue1146Test.lean new file mode 100644 index 0000000000..86e7fc5370 --- /dev/null +++ b/StrataTest/Languages/Core/Tests/Issue1146Test.lean @@ -0,0 +1,56 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import Strata.Languages.Core.DDMTransform.Translate + +/-! +# Regression test for https://github.com/strata-org/Strata/issues/1146 + +A trailing `;` after a `function` body must not be silently accepted as an +empty `command_datatypes` block (which would later panic in +`translateDatatypes`), and a program mixing a datatype and a function must +translate cleanly. +-/ + +namespace Strata.Issue1146Test + +/-! ## Canonical form: datatype + function translates without error -/ + +private def datatypeAndFunction : Strata.Program := +#strata +program Core; + +datatype List () { Nil() }; + +function Len (xs : List) : int +{ + 0 +} +#end + +/-- info: true -/ +#guard_msgs in +#eval TransM.run Inhabited.default (translateProgram datatypeAndFunction) |>.snd |>.isEmpty + +/-! ## Stray trailing `;` after a function body is a parse error -/ + +/-- +error: unexpected token ';'; expected 'function', Core.Block or expected at least one element +-/ +#guard_msgs in +def strayTrailingSemi : Strata.Program := +#strata +program Core; + +datatype List () { Nil() }; + +function Len (xs : List) : int +{ + 0 +}; +#end + +end Strata.Issue1146Test From f6d195aa0a44bd22d78078d86d64b15346ae6ed6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mika=C3=ABl=20Mayer?= Date: Mon, 18 May 2026 16:08:57 -0500 Subject: [PATCH 10/28] Split StrataMain.lean into importable library and thin executable root (#1179) Fixes #1163 Moves all library code from `StrataMain.lean` into a new `StrataMainLib` module, leaving `StrataMain.lean` as a thin executable entry point (`import StrataMainLib`). This makes the library importable from tests and other tools without pulling in the executable entry point. --- StrataMain.lean | 1556 +------------------------------------------ StrataMainLib.lean | 1560 ++++++++++++++++++++++++++++++++++++++++++++ lakefile.toml | 3 + 3 files changed, 1566 insertions(+), 1553 deletions(-) create mode 100644 StrataMainLib.lean diff --git a/StrataMain.lean b/StrataMain.lean index b4f1c646ab..826504e67f 100644 --- a/StrataMain.lean +++ b/StrataMain.lean @@ -3,1557 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -module +import StrataMainLib --- Executable with utilities for working with Strata files. -import Lean.Parser.Extension -import Strata.Backends.CBMC.CollectSymbols -import Strata.Backends.CBMC.GOTO.CoreToGOTOPipeline -import Strata.DDM.Integration.Java.Gen -import Strata.Languages.Core.Verifier -import Strata.Languages.Core.SarifOutput -import Strata.Languages.Core.ProgramEval -import Strata.Languages.Core.StatementEval -import Strata.Languages.C_Simp.Verify -import Strata.Languages.B3.Verifier.Program -import Strata.Languages.Laurel.LaurelCompilationPipeline -import Strata.Languages.Boole.Boole -import Strata.Languages.Boole.Verify -import Strata.Languages.Python.Python -import Strata.Languages.Python.Specs.IdentifyOverloads -import Strata.Languages.Python.Specs.ToLaurel -import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator -import Strata.Languages.Laurel.Laurel -import Strata.Languages.Core.EntryPoint -import Strata.Transform.ProcedureInlining -import Strata.Util.IO - -import Strata.SimpleAPI -import Strata.Util.Profile -import Strata.Util.Json -import Strata.DDM.BuiltinDialects -import Strata.DDM.Util.String -import Strata.Languages.Python.PyFactory -import Strata.Languages.Python.Specs -import Strata.Languages.Python.Specs.DDM -import Strata.Languages.Python.ReadPython - -open Strata - -open Core (VerifyOptions VerboseMode VerificationMode CheckLevel EntryPoint) -open Laurel (LaurelVerifyOptions LaurelTranslateOptions) - -/-! ## Exit codes - -All `strata` subcommands use a common exit code scheme: - -| Code | Category | Meaning | -|------|--------------------|-----------------------------------------------------------| -| 0 | Success | Analysis passed, inconclusive, or `--no-solve` completed. | -| 1 | User error | Bad input: invalid arguments, malformed source, etc. | -| 2 | Failures found | Analysis completed and found failures. | -| 3 | Internal error | SMT encoding failure, solver crash, or translation bug. | -| 4 | Known limitation | Intentionally unsupported language construct. | - -Codes 1–2 are **user-actionable** (fix the input or the code under analysis). -Codes 3–4 are **tool-side** (report as a bug or wait for support). -Exit 0 covers success, inconclusive results, and solver timeouts. -/ - -namespace ExitCode - def userError : UInt8 := 1 - def failuresFound : UInt8 := 2 - def internalError : UInt8 := 3 - def knownLimitation : UInt8 := 4 -end ExitCode - -def exitFailure {α} (message : String) (hint : String := "strata --help") : IO α := do - IO.eprintln s!"Exception: {message}\n\nRun {hint} for additional help." - IO.Process.exit ExitCode.userError - -/-- Exit with code 1 for user errors (bad input, malformed source, etc.). -/ -def exitUserError {α} (message : String) : IO α := do - IO.eprintln s!"❌ {message}" - IO.Process.exit ExitCode.userError - -/-- Exit with code 2 for analysis failures found. -/ -def exitFailuresFound {α} (message : String) : IO α := do - IO.eprintln s!"Failures found: {message}" - IO.Process.exit ExitCode.failuresFound - -/-- Exit with code 3 for internal errors (tool limitations or crashes). -/ -def exitInternalError {α} (message : String) : IO α := do - IO.eprintln s!"Exception: {message}" - IO.Process.exit ExitCode.internalError - -/-- Exit with code 4 for known limitations (unsupported constructs). -/ -def exitKnownLimitation {α} (message : String) : IO α := do - IO.eprintln s!"Known limitation: {message}" - IO.Process.exit ExitCode.knownLimitation - -/-- Like `exitFailure` but tailors the help hint to a specific subcommand. -/ -def exitCmdFailure {α} (cmdName : String) (message : String) : IO α := - exitFailure message (hint := s!"strata {cmdName} --help") - -/-- How a flag consumes arguments. -/ -inductive FlagArg where - | none -- boolean flag, e.g. --verbose - | arg (name : String) -- takes one value, e.g. --output - | repeat (name : String) -- takes one value, may appear multiple times, e.g. --include - -/-- A flag that a command accepts. -/ -structure Flag where - name : String -- flag name without "--", used as lookup key - help : String - takesArg : FlagArg := .none - -/-- Parsed flags from the command line. Stored as an ordered array so that - command-line position is preserved (needed by `transform` to bind - `--procedures`/`--functions` to the preceding `--pass`). - For `.arg` flags that appear more than once, `getString` returns the - **last** occurrence (last-writer-wins). -/ -structure ParsedFlags where - entries : Array (String × Option String) := #[] - -namespace ParsedFlags - -def getBool (pf : ParsedFlags) (name : String) : Bool := - pf.entries.any (·.1 == name) - -def getString (pf : ParsedFlags) (name : String) : Option String := - -- Scan from the end so last occurrence wins. - match pf.entries.findRev? (·.1 == name) with - | some (_, some v) => some v - | _ => Option.none - -def getRepeated (pf : ParsedFlags) (name : String) : Array String := - pf.entries.foldl (init := #[]) fun acc (n, v) => - if n == name then match v with | some s => acc.push s | none => acc else acc - -def insert (pf : ParsedFlags) (name : String) (value : Option String) : ParsedFlags := - { pf with entries := pf.entries.push (name, value) } - -def buildDialectFileMap (pflags : ParsedFlags) : IO Strata.DialectFileMap := do - let preloaded := Strata.Elab.LoadedDialects.builtin - |>.addDialect! Strata.Python.Python - |>.addDialect! Strata.Python.Specs.DDM.PythonSpecs - |>.addDialect! Strata.Core - |>.addDialect! Strata.Boole - |>.addDialect! Strata.Laurel.Laurel - |>.addDialect! Strata.smtReservedKeywordsDialect - |>.addDialect! Strata.SMTCore - |>.addDialect! Strata.SMT - |>.addDialect! Strata.SMTResponse - let mut sp ← Strata.DialectFileMap.new preloaded - for path in pflags.getRepeated "include" do - match ← sp.add path |>.toBaseIO with - | .error msg => exitFailure msg - | .ok sp' => sp := sp' - return sp - -end ParsedFlags - -def parseCheckMode (pflags : ParsedFlags) - (default : VerificationMode := .deductive) : IO VerificationMode := - match pflags.getString "check-mode" with - | .none => pure default - | .some s => match VerificationMode.ofString? s with - | .some m => pure m - | .none => exitFailure s!"Invalid check mode: '{s}'. Must be {VerificationMode.options}." - -def parseCheckLevel (pflags : ParsedFlags) - (default : CheckLevel := .minimal) : IO CheckLevel := - match pflags.getString "check-level" with - | .none => pure default - | .some s => match CheckLevel.ofString? s with - | .some l => pure l - | .none => exitFailure s!"Invalid check level: '{s}'. Must be {CheckLevel.options}." - -/-- Common CLI flags for VerifyOptions fields. - Commands can append these to their own flags list. - Note: `parseOnly`, `typeCheckOnly`, and `checkOnly` are omitted here - because they are specific to the `verify` command. -/ -def verifyOptionsFlags : List Flag := [ - { name := "check-mode", - help := s!"Check mode: {VerificationMode.options}. Default: 'deductive'.", - takesArg := .arg "mode" }, - { name := "check-level", - help := s!"Check level: {CheckLevel.options}. Default: 'minimal'.", - takesArg := .arg "level" }, - { name := "verbose", help := "Enable verbose output." }, - { name := "quiet", help := "Suppress warnings on stderr." }, - { name := "profile", help := "Print elapsed time for each pipeline step." }, - { name := "sarif", help := "Write results as SARIF to .sarif." }, - { name := "solver", - help := s!"SMT solver executable (default: {Core.defaultSolver}).", - takesArg := .arg "name" }, - { name := "solver-timeout", - help := "Solver timeout in seconds (default: 10).", - takesArg := .arg "seconds" }, - { name := "vc-directory", - help := "Store VCs in SMT-Lib format in .", - takesArg := .arg "dir" }, - { name := "no-solve", - help := "Generate SMT-Lib files but do not invoke the solver." }, - { name := "stop-on-first-error", - help := "Exit after the first verification error." }, - { name := "unique-bound-names", - help := "Use globally unique names for quantifier-bound variables." }, - { name := "use-array-theory", - help := "Use SMT-LIB Array theory instead of axiomatized maps." }, - { name := "remove-irrelevant-axioms", - help := "Prune irrelevant axioms: 'off', 'aggressive', or 'precise'.", - takesArg := .arg "mode" }, - { name := "overflow-checks", - help := "Comma-separated overflow checks to enable (signed,unsigned,float64,all,none).", - takesArg := .arg "checks" }, - { name := "incremental", - help := "Use incremental solver backend (stdin/stdout) instead of batch file I/O." }, - { name := "path-cap", - help := "Maximum continuing paths between statements. 'none' (default) disables; N merges paths when count exceeds N.", - takesArg := .arg "N|none" } -] - -/-- Build a VerifyOptions from parsed CLI flags, starting from a base config. - Fields not present in the flags keep their base values. - Note: boolean flags can only enable a setting; a `true` in the base - cannot be turned off from the CLI (there is no `--no-X` syntax). -/ -def parseVerifyOptions (pflags : ParsedFlags) - (base : VerifyOptions := VerifyOptions.default) : IO VerifyOptions := do - let checkMode ← parseCheckMode pflags base.checkMode - let checkLevel ← parseCheckLevel pflags base.checkLevel - let solverTimeout ← match pflags.getString "solver-timeout" with - | .none => pure base.solverTimeout - | .some s => match s.toNat? with - | .some n => pure n - | .none => exitFailure s!"Invalid solver timeout: '{s}'" - let noSolve := pflags.getBool "no-solve" - let removeIrrelevantAxioms ← match pflags.getString "remove-irrelevant-axioms" with - | .none => pure base.removeIrrelevantAxioms - | .some "off" => pure .Off - | .some "aggressive" => pure .Aggressive - | .some "precise" => pure .Precise - | .some s => exitFailure s!"Invalid remove-irrelevant-axioms mode: '{s}'. Must be 'off', 'aggressive', or 'precise'." - let overflowChecks := match pflags.getString "overflow-checks" with - | .none => base.overflowChecks - | .some s => s.splitOn "," |>.foldl (fun acc c => - match c.trimAscii.toString with - | "signed" => { acc with signedBV := true } - | "unsigned" => { acc with unsignedBV := true } - | "float64" => { acc with float64 := true } - | "none" => { signedBV := false, unsignedBV := false, float64 := false } - | "all" => { signedBV := true, unsignedBV := true, float64 := true } - | _ => acc) { signedBV := false, unsignedBV := false, float64 := false } - let pathCap ← match pflags.getString "path-cap" with - | .none => pure base.pathCap - | .some "none" => pure .none - | .some s => match s.toNat? with - | .some n => if n == 0 then exitFailure "--path-cap must be at least 1 or 'none'." - else pure (.some n) - | .none => exitFailure s!"Invalid path-cap: '{s}'. Must be a positive number or 'none'." - let vcDirectory := (pflags.getString "vc-directory" |>.map (⟨·⟩ : String → System.FilePath)).orElse (fun _ => base.vcDirectory) - let skipSolver := noSolve || base.skipSolver - if skipSolver && vcDirectory.isNone then - exitFailure "--no-solve requires --vc-directory to specify where SMT files are stored." - pure { base with - verbose := if pflags.getBool "verbose" then .normal - else if pflags.getBool "quiet" then .quiet - else base.verbose, - solver := pflags.getString "solver" |>.getD base.solver, - solverTimeout, - checkMode, checkLevel, - stopOnFirstError := pflags.getBool "stop-on-first-error" || base.stopOnFirstError, - uniqueBoundNames := pflags.getBool "unique-bound-names" || base.uniqueBoundNames, - useArrayTheory := pflags.getBool "use-array-theory" || base.useArrayTheory, - removeIrrelevantAxioms, - outputSarif := pflags.getBool "sarif" || base.outputSarif, - profile := pflags.getBool "profile" || base.profile, - incremental := if noSolve then false else pflags.getBool "incremental" || base.incremental, - skipSolver, - alwaysGenerateSMT := noSolve || base.alwaysGenerateSMT, - overflowChecks, - vcDirectory, - pathCap - } - -/-- Additional CLI flags for `LaurelVerifyOptions` fields that are not already - covered by `verifyOptionsFlags`. -/ -def laurelTranslateFlags : List Flag := [ - { name := "keep-all-files", - help := "Store intermediate Laurel and Core programs in .", - takesArg := .arg "dir" } -] - -/-- All CLI flags accepted by Laurel verify commands. -/ -def laurelVerifyOptionsFlags : List Flag := verifyOptionsFlags ++ laurelTranslateFlags - -/-- Build a `LaurelVerifyOptions` from parsed CLI flags. -/ -def parseLaurelVerifyOptions (pflags : ParsedFlags) - (base : LaurelVerifyOptions := default) : IO LaurelVerifyOptions := do - let verifyOptions ← parseVerifyOptions pflags base.verifyOptions - let keepAllFilesPrefix := (pflags.getString "keep-all-files").orElse - (fun _ => base.translateOptions.keepAllFilesPrefix) - let translateOptions : LaurelTranslateOptions := - { base.translateOptions with - keepAllFilesPrefix - overflowChecks := verifyOptions.overflowChecks - profile := verifyOptions.profile } - return { translateOptions, verifyOptions } - -/-- Read and parse a Strata program file, loading the Core, C_Simp, and B3CST - dialects. Returns the parsed program and the input context (for source - location resolution), or an array of error messages on failure. -/ -private def readStrataProgram (file : String) - : IO (Except (Array Lean.Message) (Strata.Program × Lean.Parser.InputContext)) := do - let text ← Strata.Util.readInputSource file - let inputCtx := Lean.Parser.mkInputContext text (Strata.Util.displayName file) - let dctx := Elab.LoadedDialects.builtin - let dctx := dctx.addDialect! Core - let dctx := dctx.addDialect! Boole - let dctx := dctx.addDialect! C_Simp - let dctx := dctx.addDialect! B3CST - let leanEnv ← Lean.mkEmptyEnvironment 0 - match Strata.Elab.elabProgram dctx leanEnv inputCtx with - | .ok pgm => pure (.ok (pgm, inputCtx)) - | .error msgs => pure (.error msgs) - -structure Command where - name : String - args : List String - flags : List Flag := [] - help : String - callback : Vector String args.length → ParsedFlags → IO Unit - -def includeFlag : Flag := - { name := "include", help := "Add a dialect search path.", takesArg := .repeat "path" } - -def checkCommand : Command where - name := "check" - args := [ "file" ] - flags := [includeFlag] - help := "Parse and validate a Strata file (text or Ion). Reports errors and exits." - callback := fun v pflags => do - let fm ← pflags.buildDialectFileMap - let _ ← Strata.readStrataFile fm v[0] - -def toIonCommand : Command where - name := "toIon" - args := [ "input", "output" ] - flags := [includeFlag] - help := "Convert a Strata text file to Ion binary format." - callback := fun v pflags => do - let searchPath ← pflags.buildDialectFileMap - let pd ← Strata.readStrataFile searchPath v[0] - match pd with - | .dialect d => - IO.FS.writeBinFile v[1] d.toIon - | .program pgm => - IO.FS.writeBinFile v[1] pgm.toIon - -def printCommand : Command where - name := "print" - args := [ "file" ] - flags := [includeFlag] - help := "Pretty-print a Strata file (text or Ion) to stdout." - callback := fun v pflags => do - let searchPath ← pflags.buildDialectFileMap - -- Special case for already loaded dialects. - let ld ← searchPath.getLoaded - if mem : v[0] ∈ ld.dialects then - IO.print <| ld.dialects.format v[0] mem - return - let pd ← Strata.readStrataFile searchPath v[0] - match pd with - | .dialect d => - let ld ← searchPath.getLoaded - let .isTrue mem := (inferInstance : Decidable (d.name ∈ ld.dialects)) - | exitInternalError "Internal error reading file." - IO.print <| ld.dialects.format d.name mem - | .program pgm => - IO.print <| toString pgm - -def diffCommand : Command where - name := "diff" - args := [ "file1", "file2" ] - flags := [includeFlag] - help := "Compare two program files for syntactic equality. Reports the first difference found." - callback := fun v pflags => do - let fm ← pflags.buildDialectFileMap - let p1 ← Strata.readStrataFile fm v[0] - let p2 ← Strata.readStrataFile fm v[1] - match p1, p2 with - | .program p1, .program p2 => - if p1.dialect != p2.dialect then - exitFailure s!"Dialects differ: {p1.dialect} and {p2.dialect}" - let Decidable.isTrue eq := (inferInstance : Decidable (p1.commands.size = p2.commands.size)) - | exitFailure s!"Number of commands differ {p1.commands.size} and {p2.commands.size}" - for (c1, c2) in Array.zip p1.commands p2.commands do - if c1 != c2 then - exitFailure s!"Commands differ: {repr c1} and {repr c2}" - | _, _ => - exitFailure "Cannot compare dialect def with another dialect/program." - -def pySpecsCommand : Command where - name := "pySpecs" - args := [ "source_dir", "output_dir" ] - flags := [ - { name := "quiet", help := "Suppress default logging." }, - { name := "log", help := "Enable logging for an event type.", - takesArg := .repeat "event" }, - { name := "skip", - help := "Skip a top-level definition (module.name). Overloads are kept.", - takesArg := .repeat "name" }, - { name := "module", - help := "Translate only the named module (dot-separated). May be repeated.", - takesArg := .repeat "module" } - ] - help := "Translate Python specification files in a directory into Strata DDM Ion format. If --module is given, translates only those modules; otherwise translates all .py files. Creates subdirectories as needed. (Experimental)" - callback := fun v pflags => do - let quiet := pflags.getBool "quiet" - let mut events : Std.HashSet String := {} - if !quiet then - events := events.insert "import" - for e in pflags.getRepeated "log" do - events := events.insert e - let skipNames := pflags.getRepeated "skip" - let modules := pflags.getRepeated "module" - let warningOutput : Strata.WarningOutput := - if quiet then .none else .detail - -- Serialize embedded dialect for Python subprocess - IO.FS.withTempFile fun _handle dialectFile => do - IO.FS.writeBinFile dialectFile Strata.Python.Python.toIon - let r ← Strata.pySpecsDir (events := events) - (skipNames := skipNames) - (modules := modules) - (warningOutput := warningOutput) - v[0] v[1] dialectFile |>.toBaseIO - match r with - | .ok () => pure () - | .error msg => exitFailure msg - -/-- Derive Python source file path from Ion file path. - E.g., "tests/test_foo.python.st.ion" -> "tests/test_foo.py" -/ -def ionPathToPythonPath (ionPath : String) : Option String := - if ionPath.endsWith ".python.st.ion" then - let basePath := ionPath.dropEnd ".python.st.ion".length |>.toString - some (basePath ++ ".py") - else if ionPath.endsWith ".py.ion" then - some (ionPath.dropEnd ".ion".length |>.toString) - else - none - -/-- Try to read Python source file for source location reconstruction -/ -def tryReadPythonSource (ionPath : String) : IO (Option (String × String)) := do - match ionPathToPythonPath ionPath with - | none => return none - | some pyPath => - try - let content ← IO.FS.readFile pyPath - return some (pyPath, content) - catch _ => - return none - -/-- Format related position strings from metadata, if present. -/ -def formatRelatedPositions (md : Imperative.MetaData Core.Expression) - (mfm : Option (String × Lean.FileMap)) : String := - let ranges := Imperative.getRelatedFileRanges md - if ranges.isEmpty then "" else - match mfm with - | none => "" - | some (_, fm) => - let lines := ranges.filterMap fun fr => - if fr.range.isNone then none else - match fr.file with - | .file "" => some "\n Related location: in prelude file" - | .file _ => - let pos := fm.toPosition fr.range.start - some s!"\n Related location: line {pos.line}, col {pos.column}" - String.join lines.toList - -/-! ### pyAnalyzeLaurel result helpers - -The `pyAnalyzeLaurel` command emits two structured lines on stdout: -- `RESULT: ` — machine-readable category, always the last line. -- `DETAIL: ` — human-readable context (error message or VC counts). - -Exit codes follow the common scheme (see `ExitCode` above). -A successful run exits 0 with `RESULT: Analysis success` or `RESULT: Inconclusive`. -/ - -/-- Determines which VC results count as successes and which count as failures - for the purposes of the `pyAnalyzeLaurel` summary and exit code. - Implementation-error results are partitioned out first; the classifier then - partitions the rest into success / failure / inconclusive. - Narrowing `isFailure` (e.g. to only `alwaysFalseAndReachable`) automatically - widens inconclusive. - Future: may be extended with `isWarning` for non-fatal diagnostic categories. -/ -structure ResultClassifier where - isSuccess : Core.VCResult → Bool := (·.isSuccess) - isFailure : Core.VCResult → Bool := (·.isFailure) - -private def printPyAnalyzeResult (category : String) (detail : String) : IO Unit := do - IO.println s!"DETAIL: {detail}" - IO.println s!"RESULT: {category}" - -private def exitPyAnalyzeUserError {α} (message : String) : IO α := do - printPyAnalyzeResult "User error" message - IO.Process.exit ExitCode.userError - -private def exitPyAnalyzeFailuresFound {α} (detail : String) : IO α := do - printPyAnalyzeResult "Failures found" detail - IO.Process.exit ExitCode.failuresFound - -private def exitPyAnalyzeInternalError {α} (message : String) : IO α := do - printPyAnalyzeResult "Internal error" message - IO.Process.exit ExitCode.internalError - -private def exitPyAnalyzeKnownLimitation {α} (message : String) : IO α := do - printPyAnalyzeResult "Known limitation" message - IO.Process.exit ExitCode.knownLimitation - -/-- Print the final RESULT/DETAIL lines based on solver outcomes. - Always called on successful pipeline completion (as opposed to the - exit helpers above, which are called on early pipeline failure). - Classification uses successive partitioning: timeouts and implementation - errors are removed first, then the classifier partitions the rest into - success / failure / inconclusive (guaranteeing disjointness). - Unreachable count is reported as supplementary info. - - Exit-code priority (highest wins): - - Internal error (exit 3): encoding failures or solver crashes - - Failures found (exit 2): assertion violations - - Inconclusive / success / solver timeout (exit 0) -/ -private def printPyAnalyzeSummary (vcResults : Array Core.VCResult) - (checkMode : VerificationMode := .deductive) : IO Unit := do - let classifier : ResultClassifier := - match checkMode with - | .bugFinding | .bugFindingAssumingCompleteSpec => - { isSuccess := (·.isBugFindingSuccess) - isFailure := (·.isBugFindingFailure) } - | _ => {} - -- 1. Partition out implementation errors and timeouts (not classifiable). - let (implError, rest1) := - vcResults.partition (fun r => r.isImplementationError || r.hasSMTError) - let (timeouts, classifiable) := rest1.partition (·.isTimeout) - -- 2. Successive partitioning via the classifier: success → failure → inconclusive. - let (success, rest) := classifiable.partition classifier.isSuccess - let (failure, inconclusive) := rest.partition classifier.isFailure - -- 3. Unreachable is informational (not a separate partition). - let nUnreachable := vcResults.filter (·.isUnreachable) |>.size - let nImplError := implError.size - let nTimeout := timeouts.size - let nSuccess := success.size - let nFailure := failure.size - let nInconclusive := inconclusive.size - let unreachableStr := if nUnreachable > 0 then s!", {nUnreachable} unreachable" else "" - let implErrorStr := if nImplError > 0 then s!", {nImplError} internal errors" else "" - let timeoutStr := if nTimeout > 0 then s!", {nTimeout} solver timeouts" else "" - let counts := s!"{nSuccess} passed, {nFailure} failed, {nInconclusive} inconclusive{unreachableStr}{timeoutStr}{implErrorStr}" - if nImplError > 0 then - exitPyAnalyzeInternalError s!"An unexpected result was produced. {counts}" - else if nFailure > 0 then - exitPyAnalyzeFailuresFound counts - else - let label := - if nTimeout > 0 then "Solver timeout" - else if nInconclusive > 0 then "Inconclusive" - else "Analysis success" - printPyAnalyzeResult label counts - -private def deriveBaseName (file : String) : String := - let name := System.FilePath.fileName file |>.getD file - let suffixes := [".python.st.ion", ".py.ion", ".st.ion", ".st"] - match suffixes.find? (name.endsWith ·) with - | some sfx => (name.dropEnd sfx.length).toString - | none => name - - -def pyAnalyzeLaurelCommand : Command where - name := "pyAnalyzeLaurel" - args := [ "file" ] - flags := verifyOptionsFlags ++ [ - { name := "spec-dir", - help := "Directory containing compiled PySpec Ion files.", - takesArg := .arg "dir" }, - { name := "dispatch", - help := "Dispatch module name (e.g., servicelib).", - takesArg := .repeat "module" }, - { name := "pyspec", - help := "PySpec module name (e.g., servicelib.Storage).", - takesArg := .repeat "module" }, - { name := "keep-all-files", - help := "Store intermediate Laurel and Core programs in .", - takesArg := .arg "dir" }, - { name := "entry-point", - help := "Which procedures to verify: main (main fn only), roots (user procs with no user callers, default), or all (all user procs). Only valid in bugFinding mode.", - takesArg := .arg "mode" }, - { name := "warning-summary", - help := "Write PySpec warning summary as JSON to .", - takesArg := .arg "file" }, - { name := "skip-verification", - help := "Run Python-to-Laurel and Laurel-to-Core translation only (skip SMT verification).", - takesArg := .none }] - help := "Verify a Python Ion program via the Laurel pipeline. Translates Python to Laurel to Core, then runs SMT verification." - callback := fun v pflags => do - let verbose := pflags.getBool "verbose" - let profile := pflags.getBool "profile" - let quiet := pflags.getBool "quiet" - let outputSarif := pflags.getBool "sarif" - let filePath := v[0] - let pySourceOpt ← tryReadPythonSource filePath - let keepDir := pflags.getString "keep-all-files" - let baseName := deriveBaseName filePath - if let some dir := keepDir then - IO.FS.createDirAll dir - - let dispatchModules := pflags.getRepeated "dispatch" - let pyspecModules := pflags.getRepeated "pyspec" - let specDir := pflags.getString "spec-dir" |>.getD "." - unless ← System.FilePath.isDir specDir do - exitFailure s!"spec-dir '{specDir}' does not exist or is not a directory" - let sourcePath := pySourceOpt.map (·.1) - -- Build FileMap for source position resolution. - let mfm : Option (String × Lean.FileMap) := match pySourceOpt with - | some (pyPath, srcText) => some (pyPath, .ofString srcText) - | none => none - let warningSummaryFile := pflags.getString "warning-summary" - let combinedLaurel ← - match ← Strata.pythonAndSpecToLaurel filePath dispatchModules pyspecModules sourcePath - (specDir := specDir) (profile := profile) - (quiet := quiet) - (warningSummaryFile := warningSummaryFile) |>.toBaseIO with - | .ok r => pure r - | .error (.userCode range msg) => - let location := if range.isNone then "" else - match mfm with - | some (_, fm) => - let pos := fm.toPosition range.start - s!" at line {pos.line}, col {pos.column}" - | none => "" - let filePath' := sourcePath.getD filePath - let mut lines := #[ - s!"(set-info :file {Strata.escapeSMTStringLit filePath'})" - ] - unless range.isNone do - lines := lines.push s!"(set-info :start {range.start})" - lines := lines.push s!"(set-info :stop {range.stop})" - lines := lines.push s!"(set-info :error-message {Strata.escapeSMTStringLit msg})" - for line in lines do - IO.println line - IO.FS.writeFile "user_errors.txt" (String.intercalate "\n" lines.toList ++ "\n") - exitPyAnalyzeUserError s!"{msg}{location}" - | .error (.knownLimitation msg) => - exitPyAnalyzeKnownLimitation msg - | .error (.internal msg) => - exitPyAnalyzeInternalError msg - - if verbose then - IO.println "\n==== Laurel Program ====" - IO.println f!"{combinedLaurel}" - - let keepPrefix := keepDir.map (s!"{·}/{baseName}") - - let (coreProgramOption, laurelTranslateErrors, _loweredLaurel, laurelPassStats) ← - profileStep profile "Laurel to Core translation" do - Strata.translateCombinedLaurelWithLowered combinedLaurel - (keepAllFilesPrefix := keepPrefix) (profile := profile) - - if profile && !laurelPassStats.data.isEmpty then - IO.println laurelPassStats.format - - let coreProgram ← - match coreProgramOption with - | none => - exitPyAnalyzeInternalError s!"Laurel to Core translation failed: {laurelTranslateErrors}" - | some core => pure core - - if verbose then - IO.println "\n==== Core Program ====" - IO.print (Core.formatProgram coreProgram) - - -- When --skip-verification is set, report translation diagnostics and exit - -- without running SMT verification (stages 3-4). - if pflags.getBool "skip-verification" then do - if !laurelTranslateErrors.isEmpty then - IO.eprintln "\n==== Errors ====" - for err in laurelTranslateErrors do - IO.eprintln err - if outputSarif then - let files := match mfm with - | some (pyPath, fm) => Map.empty.insert (Strata.Uri.file pyPath) fm - | none => Map.empty - Core.Sarif.writeSarifOutput .deductive files #[] (filePath ++ ".sarif") - let nStrataBug := laurelTranslateErrors.filter (·.type == .StrataBug) |>.length - let nNotYetImpl := laurelTranslateErrors.filter (·.type == .NotYetImplemented) |>.length - let nUserError := laurelTranslateErrors.filter (·.type == .UserError) |>.length - let nWarning := laurelTranslateErrors.filter (·.type == .Warning) |>.length - let counts := s!"{nUserError} user errors, {nWarning} warnings, {nNotYetImpl} not yet implemented, {nStrataBug} internal errors" - if nStrataBug > 0 then - exitPyAnalyzeInternalError s!"Translation produced internal errors. {counts}" - else if nNotYetImpl > 0 then - exitPyAnalyzeKnownLimitation s!"Translation encountered unsupported constructs. {counts}" - else - printPyAnalyzeResult "Analysis success" counts - return - - -- Verify using Core verifier - -- --keep-all-files implies vc-directory if not explicitly set - let baseVcDir := keepDir.map (fun dir => (s!"{dir}/{baseName}" : System.FilePath)) - let pyAnalyzeBase : VerifyOptions := - { VerifyOptions.default with - verbose := .quiet, removeIrrelevantAxioms := .Precise, - vcDirectory := baseVcDir } - let options ← parseVerifyOptions pflags pyAnalyzeBase - let isBugFinding := options.checkMode == .bugFinding - || options.checkMode == .bugFindingAssumingCompleteSpec - - -- Parse --entry-point flag (only supported in bug-finding modes). - let entryPointFlag := pflags.getString "entry-point" - let entryPoint : EntryPoint ← - if isBugFinding then - match entryPointFlag with - | some s => - match EntryPoint.ofString? s with - | some ep => pure ep - | none => - exitPyAnalyzeUserError s!"Invalid --entry-point value '{s}'. Must be {EntryPoint.options}." - | none => pure .roots - else - if entryPointFlag.isSome then - exitPyAnalyzeUserError s!"--entry-point is unsupported in {options.checkMode} mode" - else pure .all - - -- Pick the procedures to verify and set up inlining phases. - let userSourcePath := sourcePath.getD filePath - let (_, userProcNames) := - Strata.splitProcNames coreProgram [userSourcePath] - let (proceduresToVerify, inlinePhases) := - if isBugFinding then - let ⟨p, i⟩ := Core.chooseEntryProceduresAndBuildInlinePhases coreProgram userProcNames entryPoint - (p, [i]) - else (userProcNames, []) - - let vcResults ← profileStep profile "SMT verification" do - match ← Core.verifyProgram coreProgram options - (moreFns := Strata.Python.ReFactory) - (proceduresToVerify := some proceduresToVerify) - (externalPhases := [Strata.frontEndPhase]) - (prefixPhases := inlinePhases) - (keepAllFilesPrefix := keepPrefix) - |>.toBaseIO with - | .ok r => pure r.mergeByAssertion - | .error msg => exitPyAnalyzeInternalError msg - - -- Print translation errors (always on stderr) - if !laurelTranslateErrors.isEmpty then - IO.eprintln "\n==== Errors ====" - for err in laurelTranslateErrors do - IO.eprintln err - - -- Print per-VC results by default, unless SARIF mode is used - if !outputSarif then - let mut s := "" - for vcResult in vcResults do - let fileMap := mfm.map (·.2) - let location := match Imperative.getFileRange vcResult.obligation.metadata with - | some fr => - if fr.range.isNone then "" - else s!"{fr.format fileMap (includeEnd? := false)}" - | none => "" - let messageSuffix := match vcResult.obligation.metadata.getPropertySummary with - | some msg => s!" - {msg}" - | none => s!" - {vcResult.obligation.label}" - let outcomeStr := vcResult.formatOutcome - let loc := if !location.isEmpty then s!"{location}: " else "unknown location: " - s := s ++ s!"{loc}{outcomeStr}{messageSuffix}\n" - IO.print s - -- Output in SARIF format if requested - if outputSarif then - let files := match mfm with - | some (pyPath, fm) => Map.empty.insert (Strata.Uri.file pyPath) fm - | none => Map.empty - Core.Sarif.writeSarifOutput options.checkMode files vcResults (filePath ++ ".sarif") - printPyAnalyzeSummary vcResults options.checkMode - -def pyAnalyzeToGotoCommand : Command where - name := "pyAnalyzeToGoto" - args := [ "file" ] - help := "Translate a Strata Python Ion file to CProver GOTO JSON files." - callback := fun v _ => do - let filePath := v[0] - let pySourceOpt ← tryReadPythonSource filePath - let sourcePathForMetadata := match pySourceOpt with - | some (pyPath, _) => pyPath - | none => filePath - let sourceText := pySourceOpt.map (·.2) - let newPgm ← Strata.pythonDirectToCore filePath sourcePathForMetadata - match Core.inlineProcedures newPgm { doInline := (fun _caller callee _ => callee ≠ "main") } with - | .error e => exitInternalError (toString e) - | .ok newPgm => - -- Type-check the full program (registers Python types like ExceptOrNone) - let Ctx := { Lambda.LContext.default with functions := Strata.Python.PythonFactory, knownTypes := Core.KnownTypes } - let Env := Lambda.TEnv.default - let (tcPgm, _) ← match Core.Program.typeCheck Ctx Env newPgm with - | .ok r => pure r - | .error e => exitInternalError s!"{e.format none}" - -- Find the main procedure - let some mainDecl := tcPgm.decls.find? fun d => - match d with - | .proc p _ => Core.CoreIdent.toPretty p.header.name == "main" - | _ => false - | exitInternalError "No main procedure found" - let some p := mainDecl.getProc? - | exitInternalError "main is not a procedure" - -- Translate procedure to GOTO (mirrors CoreToGOTO.transformToGoto post-typecheck logic) - let baseName := deriveBaseName filePath - let procName := Core.CoreIdent.toPretty p.header.name - let axioms := tcPgm.decls.filterMap fun d => d.getAxiom? - let distincts := tcPgm.decls.filterMap fun d => match d with - | .distinct name es _ => some (name, es) | _ => none - match procedureToGotoCtx Env p sourceText (axioms := axioms) (distincts := distincts) - with - | .error e => exitInternalError s!"{e}" - | .ok (ctx, liftedFuncs) => - let extraSyms ← match collectExtraSymbols tcPgm with - | .ok s => pure (Lean.toJson s) - | .error e => exitInternalError s!"{e}" - let (symtab, goto) ← emitProcWithLifted Env procName ctx liftedFuncs extraSyms - (moduleName := baseName) - let symTabFile := s!"{baseName}.symtab.json" - let gotoFile := s!"{baseName}.goto.json" - writeJsonFile symTabFile symtab - writeJsonFile gotoFile goto - IO.println s!"Written {symTabFile} and {gotoFile}" - -def pyTranslateLaurelCommand : Command where - name := "pyTranslateLaurel" - args := [ "file" ] - flags := [{ name := "pyspec", - help := "PySpec module name (e.g., servicelib.Storage).", - takesArg := .repeat "module" }, - { name := "dispatch", - help := "Dispatch module name (e.g., servicelib).", - takesArg := .repeat "module" }, - { name := "spec-dir", - help := "Directory containing compiled PySpec Ion files.", - takesArg := .arg "dir" }] - help := "Translate a Strata Python Ion file through Laurel to Strata Core. Write results to stdout." - callback := fun v pflags => do - let dispatchModules := pflags.getRepeated "dispatch" - let pyspecModules := pflags.getRepeated "pyspec" - let specDir := pflags.getString "spec-dir" |>.getD "." - unless ← System.FilePath.isDir specDir do - exitFailure s!"spec-dir '{specDir}' does not exist or is not a directory" - let coreProgram ← - match ← Strata.pyTranslateLaurel v[0] dispatchModules pyspecModules (specDir := specDir) |>.toBaseIO with - | .ok r => pure r - | .error msg => exitFailure msg - IO.print coreProgram - -def pyAnalyzeLaurelToGotoCommand : Command where - name := "pyAnalyzeLaurelToGoto" - args := [ "file" ] - flags := [{ name := "pyspec", - help := "PySpec module name (e.g., servicelib.Storage).", - takesArg := .repeat "module" }, - { name := "dispatch", - help := "Dispatch module name (e.g., servicelib).", - takesArg := .repeat "module" }, - { name := "spec-dir", - help := "Directory containing compiled PySpec Ion files.", - takesArg := .arg "dir" }] - help := "Translate a Strata Python Ion file through Laurel to CProver GOTO JSON files." - callback := fun v pflags => do - let filePath := v[0] - let dispatchModules := pflags.getRepeated "dispatch" - let pyspecModules := pflags.getRepeated "pyspec" - let specDir := pflags.getString "spec-dir" |>.getD "." - unless ← System.FilePath.isDir specDir do - exitFailure s!"spec-dir '{specDir}' does not exist or is not a directory" - let (coreProgram, laurelTranslateErrors) ← - match ← Strata.pyTranslateLaurel filePath dispatchModules pyspecModules (specDir := specDir) |>.toBaseIO with - | .ok r => pure r - | .error msg => exitFailure msg - let sourceText := (← tryReadPythonSource filePath).map (·.2) - let baseName := deriveBaseName filePath - match ← Strata.inlineCoreToGotoFiles coreProgram baseName sourceText - (factory := Strata.Python.PythonFactory) |>.toBaseIO with - | .ok () => pure () - | .error msg => exitFailure msg - -def javaGenCommand : Command where - name := "javaGen" - args := [ "dialect", "package", "output-dir" ] - flags := [includeFlag] - help := "Generate Java source files from a DDM dialect definition. Accepts a dialect name (e.g. Laurel) or a dialect file path." - callback := fun v pflags => do - let fm ← pflags.buildDialectFileMap - let ld ← fm.getLoaded - let d ← if mem : v[0] ∈ ld.dialects then - pure ld.dialects[v[0]] - else - match ← Strata.readStrataFile fm v[0] with - | .dialect d => pure d - | .program _ => exitFailure "Expected a dialect file, not a program file." - match Strata.Java.generateDialect d v[1] with - | .ok files => - Strata.Java.writeJavaFiles v[2] v[1] files - IO.println s!"Generated Java files for {d.name} in {v[2]}/{Strata.Java.packageToPath v[1]}" - | .error msg => - exitFailure s!"Error generating Java: {msg}" - -def laurelAnalyzeBinaryCommand : Command where - name := "laurelAnalyzeBinary" - args := [] - flags := laurelVerifyOptionsFlags - help := "Verify Laurel Ion programs read from stdin and print diagnostics. Combines multiple input files." - callback := fun _ pflags => do - let options ← parseLaurelVerifyOptions pflags - let stdinBytes ← (← IO.getStdin).readBinToEnd - let combinedProgram ← Strata.readLaurelIonProgram stdinBytes - let diagnostics ← Strata.Laurel.verifyToDiagnosticModels combinedProgram options - - IO.println s!"==== DIAGNOSTICS ====" - for diag in diagnostics do - IO.println s!"{Std.format diag.fileRange.file}:{diag.fileRange.range.start}-{diag.fileRange.range.stop}: {diag.message}" - -def pySpecToLaurelCommand : Command where - name := "pySpecToLaurel" - args := [ "python_path", "strata_path" ] - help := "Translate a PySpec Ion file to Laurel declarations. The Ion file must already exist." - callback := fun v _ => do - let pythonFile : System.FilePath := v[0] - let strataDir : System.FilePath := v[1] - let some mod := pythonFile.fileStem - | exitFailure s!"No stem {pythonFile}" - let .ok mod := Strata.Python.Specs.ModuleName.ofString mod - | exitFailure s!"Invalid module {mod}" - let ionFile := strataDir / mod.strataFileName - let sigs ← - match ← Strata.Python.Specs.readDDM ionFile |>.toBaseIO with - | .ok t => pure t - | .error msg => exitFailure s!"Could not read {ionFile}: {msg}" - let result := Strata.Python.Specs.ToLaurel.signaturesToLaurel pythonFile sigs "" - if result.errors.size > 0 then - IO.eprintln s!"{result.errors.size} translation warning(s):" - for err in result.errors do - IO.eprintln s!" {err.file}: {err.message}" - let pgm := result.program - IO.println s!"Laurel: {pgm.staticProcedures.length} procedure(s), {pgm.types.length} type(s)" - IO.println s!"Overloads: {result.overloads.size} function(s)" - for td in pgm.types do - IO.println s!" {Strata.Laurel.formatTypeDefinition td}" - for proc in pgm.staticProcedures do - IO.println s!" {Strata.Laurel.formatProcedure proc}" - -def pyResolveOverloadsCommand : Command where - name := "pyResolveOverloads" - args := [ "python_path", "dispatch_ion" ] - help := "Identify which overloaded service modules a \ - Python program uses. Prints one module name per \ - line to stdout." - callback := fun v _ => do - let pythonFile : System.FilePath := v[0] - let dispatchPath := v[1] - -- Read dispatch overload table - let overloads ← - match ← readDispatchOverloads #[dispatchPath] |>.toBaseIO with - | .ok (r, _) => pure r - | .error msg => exitFailure msg - -- Convert .py to Python AST - let stmts ← - IO.FS.withTempFile fun _handle dialectFile => do - IO.FS.writeBinFile dialectFile - Strata.Python.Python.toIon - match ← Strata.Python.pythonToStrata dialectFile pythonFile |>.toBaseIO with - | .ok s => pure s - | .error msg => exitFailure msg - -- Walk AST and collect modules - let state := - Strata.Python.Specs.IdentifyOverloads.resolveOverloads - overloads stmts - for w in state.warnings do - IO.eprintln s!"warning: {w}" - let sorted := state.modules.toArray.qsort (· < ·) - for m in sorted do - IO.println m - -def laurelParseCommand : Command where - name := "laurelParse" - args := [ "file" ] - help := "Parse a Laurel source file (no verification)." - callback := fun v _ => do - let _ ← Strata.readLaurelTextFile v[0] - IO.println "Parse successful" - -def laurelAnalyzeCommand : Command where - name := "laurelAnalyze" - args := [ "file" ] - flags := laurelVerifyOptionsFlags - help := "Analyze a Laurel source file. Write diagnostics to stdout." - callback := fun v pflags => do - let options ← parseLaurelVerifyOptions pflags - let laurelProgram ← Strata.readLaurelTextFile v[0] - let (vcResultsOption, errors) ← Strata.Laurel.verifyToVcResults laurelProgram options - if !errors.isEmpty then - IO.println s!"==== ERRORS ====" - for err in errors do - IO.println s!"{err.message}" - match vcResultsOption with - | none => return - | some vcResults => - IO.println s!"==== RESULTS ====" - for vc in vcResults do - IO.println s!"{vc.obligation.label}: {match vc.outcome with | .ok o => repr o | .error e => toString e}" - -def laurelAnalyzeToGotoCommand : Command where - name := "laurelAnalyzeToGoto" - args := [ "file" ] - help := "Translate a Laurel source file to CProver GOTO JSON files." - callback := fun v _ => do - let path : System.FilePath := v[0] - let content ← IO.FS.readFile path - let laurelProgram ← Strata.parseLaurelText path content - match ← Strata.Laurel.translate {} laurelProgram with - | (none, diags) => exitFailure s!"Core translation errors: {diags.map (·.message)}" - | (some coreProgram, errors) => - let Ctx := { Lambda.LContext.default with functions := Core.Factory, knownTypes := Core.KnownTypes } - let Env := Lambda.TEnv.default - let (tcPgm, _) ← match Core.Program.typeCheck Ctx Env coreProgram with - | .ok r => pure r - | .error e => exitInternalError s!"{e.format none}" - let procs := tcPgm.decls.filterMap fun d => d.getProc? - let funcs := tcPgm.decls.filterMap fun d => - match d.getFunc? with - | some f => - let name := Core.CoreIdent.toPretty f.name - if f.body.isSome && f.typeArgs.isEmpty - && name != "Int.DivT" && name != "Int.ModT" - then some f else none - | none => none - if procs.isEmpty && funcs.isEmpty then exitInternalError "No procedures or functions found" - let baseName := deriveBaseName path.toString - let typeSyms ← match collectExtraSymbols tcPgm with - | .ok s => pure s - | .error e => exitInternalError s!"{e}" - let typeSymsJson := Lean.toJson typeSyms - let sourceText := some content - let axioms := tcPgm.decls.filterMap fun d => d.getAxiom? - let distincts := tcPgm.decls.filterMap fun d => match d with - | .distinct name es _ => some (name, es) | _ => none - let mut symtabPairs : List (String × Lean.Json) := [] - let mut gotoFns : Array Lean.Json := #[] - let mut allLiftedFuncs : List Core.Function := [] - for p in procs do - let procName := Core.CoreIdent.toPretty p.header.name - match procedureToGotoCtx Env p (sourceText := sourceText) (axioms := axioms) (distincts := distincts) - with - | .error e => exitInternalError s!"{e}" - | .ok (ctx, liftedFuncs) => - allLiftedFuncs := allLiftedFuncs ++ liftedFuncs - let json ← IO.ofExcept (CoreToGOTO.CProverGOTO.Context.toJson procName ctx) - match json.symtab with - | .obj m => symtabPairs := symtabPairs ++ m.toList - | _ => pure () - match json.goto with - | .obj m => - match m.toList.find? (·.1 == "functions") with - | some (_, .arr fns) => gotoFns := gotoFns ++ fns - | _ => pure () - | _ => pure () - for f in funcs ++ allLiftedFuncs do - let funcName := Core.CoreIdent.toPretty f.name - match functionToGotoCtx Env f with - | .error e => exitInternalError s!"{e}" - | .ok ctx => - let json ← IO.ofExcept (CoreToGOTO.CProverGOTO.Context.toJson funcName ctx) - match json.symtab with - | .obj m => symtabPairs := symtabPairs ++ m.toList - | _ => pure () - match json.goto with - | .obj m => - match m.toList.find? (·.1 == "functions") with - | some (_, .arr fns) => gotoFns := gotoFns ++ fns - | _ => pure () - | _ => pure () - match typeSymsJson with - | .obj m => symtabPairs := symtabPairs ++ m.toList - | _ => pure () - -- Deduplicate: keep first occurrence of each symbol name (proper function - -- symbols come before basic symbol references from callers) - let mut seen : Std.HashSet String := {} - let mut dedupPairs : List (String × Lean.Json) := [] - for (k, v) in symtabPairs do - if !seen.contains k then - seen := seen.insert k - dedupPairs := dedupPairs ++ [(k, v)] - -- Add CBMC default symbols (architecture constants, builtins) - -- and wrap in {"symbolTable": ...} for symtab2gb - let symtabObj := dedupPairs.foldl - (fun (acc : Std.TreeMap.Raw String Lean.Json) (k, v) => acc.insert k v) - .empty - let symtab := CProverGOTO.wrapSymtab symtabObj (moduleName := baseName) - let goto := Lean.Json.mkObj [("functions", Lean.Json.arr gotoFns)] - let symTabFile := s!"{baseName}.symtab.json" - let gotoFile := s!"{baseName}.goto.json" - writeJsonFile symTabFile symtab - writeJsonFile gotoFile goto - IO.println s!"Written {symTabFile} and {gotoFile}" - -def laurelPrintCommand : Command where - name := "laurelPrint" - args := [] - help := "Read Laurel Ion from stdin and print in concrete syntax to stdout." - callback := fun _ _ => do - let stdinBytes ← (← IO.getStdin).readBinToEnd - let strataFiles ← Strata.readLaurelIonFiles stdinBytes - for strataFile in strataFiles do - IO.println s!"// File: {strataFile.filePath}" - let p := strataFile.program - let c := p.formatContext {} - let s := p.formatState - let fmt := p.commands.foldl (init := f!"") fun f cmd => - f ++ (Strata.mformat cmd c s).format - IO.println (fmt.pretty 100) - IO.println "" - -def prettyPrintCore (p : Core.Program) : String := - let decls := p.decls.map fun d => - let s := toString (Std.format d) - -- Add newlines after major sections in procedures - s.replace "preconditions:" "\n preconditions:" - |>.replace "postconditions:" "\n postconditions:" - |>.replace "body:" "\n body:\n " - |>.replace "assert [" "\n assert [" - |>.replace "init (" "\n init (" - |>.replace "while (" "\n while (" - |>.replace "if (" "\n if (" - |>.replace "call [" "\n call [" - |>.replace "else{" "\n else {" - |>.replace "}}" "}\n }" - String.intercalate "\n" decls - -def laurelToCoreCommand : Command where - name := "laurelToCore" - args := [ "file" ] - help := "Translate a Laurel source file to Core and print to stdout." - callback := fun v _ => do - let laurelProgram ← Strata.readLaurelTextFile v[0] - let (coreProgramOption, errors) ← Strata.Laurel.translate {} laurelProgram - if !errors.isEmpty then - IO.println s!"Core translation errors: {errors.map (·.message)}" - match coreProgramOption with - | none => return - | some coreProgram => IO.println (prettyPrintCore coreProgram) - -/-- Print a string word-wrapped to `width` columns with `indent` spaces of indentation. -/ -private def printIndented (indent : Nat) (s : String) (width : Nat := 80) : IO Unit := do - let pad := "".pushn ' ' indent - let words := s.splitOn " " |>.filter (!·.isEmpty) - let mut line := pad - let mut first := true - for word in words do - if first then - line := line ++ word - first := false - else if line.length + 1 + word.length > width then - IO.println line - line := pad ++ word - else - line := line ++ " " ++ word - unless line.length ≤ indent do - IO.println line - -structure CommandGroup where - name : String - commands : List Command - commonFlags : List Flag := [] - -private def validPasses := - "inlineProcedures, loopElim, callElim, filterProcedures, removeIrrelevantAxioms" - -/-- A single transform pass together with the `--procedures`/`--functions` - that were specified immediately after it on the command line. -/ -private structure PassConfig where - name : String - procedures : List String := [] - functions : List String := [] -deriving Inhabited - -/-- Walk the ordered flag entries and bind each `--procedures`/`--functions` - to the most recent `--pass`. -/ -private def buildPassConfigs (entries : Array (String × Option String)) - : IO (Array PassConfig) := do - let mut configs : Array PassConfig := #[] - for (flag, value) in entries do - match flag with - | "pass" => configs := configs.push { name := value.getD "" } - | "procedures" => - let some cur := configs.back? | exitFailure "--procedures must appear after a --pass" - let procs := (value.getD "").splitToList (· == ',') - configs := configs.pop.push { cur with procedures := cur.procedures ++ procs } - | "functions" => - let some cur := configs.back? | exitFailure "--functions must appear after a --pass" - let fns := (value.getD "").splitToList (· == ',') - configs := configs.pop.push { cur with functions := cur.functions ++ fns } - | _ => pure () - return configs - -def transformCommand : Command where - name := "transform" - args := [ "file" ] - flags := [ - { name := "pass", - help := s!"Transform pass to apply (repeatable, applied left to right). \ - Valid passes: {validPasses}. \ - --procedures and --functions after a --pass apply to that pass.", - takesArg := .repeat "name" }, - { name := "procedures", - help := "Comma-separated procedure names for the preceding --pass. \ - For filterProcedures: procedures to keep. \ - For inlineProcedures: procedures to inline.", - takesArg := .repeat "procs" }, - { name := "functions", - help := "Comma-separated function names for the preceding --pass (used by removeIrrelevantAxioms).", - takesArg := .repeat "funcs" }] - help := "Apply one or more transforms to a Core program and print the result." - callback := fun v pflags => do - let file := v[0] - let passConfigs ← buildPassConfigs pflags.entries - if passConfigs.isEmpty then - exitFailure s!"No --pass specified. Valid passes: {validPasses}." - -- Read and parse the Core program - let (pgm, _) ← match ← readStrataProgram file with - | .ok r => pure r - | .error msgs => - for e in msgs do println! s!"Error: {← e.toString}" - exitFailure s!"{msgs.size} parse error(s)" - match Strata.genericToCore pgm with - | .error msg => - exitFailure msg - | .ok initProgram => - -- Validate and convert pass configs to TransformPass values - let mut passes : List Strata.Core.TransformPass := [] - for pc in passConfigs do - match pc.name with - | "inlineProcedures" => - let opts : Core.InlineTransformOptions := - if pc.procedures.isEmpty then {} - else { doInline := (fun _caller callee _ => callee ∈ pc.procedures) } - passes := passes ++ [.inlineProcedures opts] - | "loopElim" => - passes := passes ++ [.loopElim] - | "callElim" => - passes := passes ++ [.callElim] - | "filterProcedures" => - if pc.procedures.isEmpty then - exitFailure "filterProcedures requires --procedures" - passes := passes ++ [.filterProcedures pc.procedures] - | "removeIrrelevantAxioms" => - if pc.functions.isEmpty then - exitFailure "removeIrrelevantAxioms requires --functions" - passes := passes ++ [.removeIrrelevantAxioms pc.functions] - | other => - exitFailure s!"Unknown pass '{other}'. Valid passes: {validPasses}." - -- Run all passes in a single CoreTransformM chain so fresh variable - -- counters accumulate and cached analyses are reused across passes. - match Strata.Core.runTransforms initProgram passes with - | .ok program => IO.print (Core.formatProgram program) - | .error e => exitFailure s!"Transform failed: {e}" - -def verifyCommand : Command where - name := "verify" - args := [ "file" ] - flags := verifyOptionsFlags ++ [ - { name := "check", help := "Process up until SMT generation, but don't solve." }, - { name := "type-check", help := "Exit after semantic dialect's type inference/checking." }, - { name := "parse-only", help := "Exit after DDM parsing and type checking." }, - { name := "output-format", help := "Output format (only 'sarif' supported).", takesArg := .arg "format" }, - { name := "procedures", help := "Verify only the specified procedures (comma-separated).", takesArg := .arg "procs" }] - help := "Verify a Strata program file (.core.st, .csimp.st, or .b3.st)." - callback := fun v pflags => do - let file := v[0] - let proceduresToVerify := pflags.getString "procedures" |>.map (·.splitToList (· == ',')) - let opts ← parseVerifyOptions pflags { VerifyOptions.default with verbose := .quiet } - let opts := { opts with - checkOnly := pflags.getBool "check", - typeCheckOnly := pflags.getBool "type-check", - parseOnly := pflags.getBool "parse-only", - outputSarif := opts.outputSarif || pflags.getString "output-format" == some "sarif" } - let (pgm, inputCtx) ← match ← readStrataProgram file with - | .ok r => pure r - | .error errors => - for e in errors do - let msg ← e.toString - println! s!"Error: {msg}" - println! f!"Finished with {errors.size} errors." - IO.Process.exit ExitCode.userError - println! s!"Successfully parsed." - if opts.parseOnly then return - if opts.typeCheckOnly then - let ans := if file.endsWith ".csimp.st" then - C_Simp.typeCheck pgm opts - else if pgm.dialect == "Boole" then - Boole.typeCheck pgm opts - else - typeCheck inputCtx pgm opts - match ans with - | .error e => - println! f!"{e.formatRange (some inputCtx.fileMap) true} {e.message}" - IO.Process.exit ExitCode.userError - | .ok _ => - println! f!"Program typechecked." - return - -- Full verification - let vcResults ← try - if file.endsWith ".csimp.st" then - C_Simp.verify pgm opts - else if file.endsWith ".b3.st" || file.endsWith ".b3cst.st" then - let ast ← match B3.Verifier.programToB3AST pgm with - | Except.error msg => throw (IO.userError s!"Failed to convert to B3 AST: {msg}") - | Except.ok ast => pure ast - let solver ← B3.Verifier.createInteractiveSolver opts.solver - let reports ← B3.Verifier.programToSMT ast solver - for report in reports do - IO.println s!"\nProcedure: {report.procedureName}" - for (result, _) in report.results do - let marker := if result.result.isError then "✗" else "✓" - let desc := match result.result with - | .error .counterexample => "counterexample found" - | .error .unknown => "unknown" - | .error .refuted => "refuted" - | .success .verified => "verified" - | .success .reachable => "reachable" - | .success .reachabilityUnknown => "reachability unknown" - IO.println s!" {marker} {desc}" - pure #[] - else if pgm.dialect == "Boole" then - Boole.verify opts.solver pgm inputCtx proceduresToVerify opts - else - verify pgm inputCtx proceduresToVerify opts - catch e => - println! f!"{e}" - IO.Process.exit ExitCode.internalError - if opts.outputSarif then - if file.endsWith ".csimp.st" then - println! "SARIF output is not supported for C_Simp files (.csimp.st) because location metadata is not preserved during translation to Core." - else - let uri := Strata.Uri.file file - let files := Map.empty.insert uri inputCtx.fileMap - Core.Sarif.writeSarifOutput opts.checkMode files vcResults (file ++ ".sarif") - for vcResult in vcResults do - let posStr := Imperative.MetaData.formatFileRangeD vcResult.obligation.metadata (some inputCtx.fileMap) - println! f!"{posStr} [{vcResult.obligation.label}]: \ - {vcResult.formatOutcome}" - let success := vcResults.all Core.VCResult.isSuccess - if success && !opts.checkOnly then - println! f!"All {vcResults.size} goals passed." - else if success && opts.checkOnly then - println! f!"Skipping verification." - else - let provedGoalCount := (vcResults.filter Core.VCResult.isSuccess).size - let failedGoalCount := (vcResults.filter Core.VCResult.isNotSuccess).size - -- Encoding failures, solver crashes, or per-check SMT errors (exit 3) - let hasImplError := vcResults.any (fun r => r.isImplementationError || r.hasSMTError) - -- Assertion violations that are not timeouts or internal errors (exit 2) - let hasFailure := vcResults.any (fun r => !r.isSuccess && !r.isTimeout && !r.isImplementationError && !r.hasSMTError) - println! f!"Finished with {provedGoalCount} goals passed, {failedGoalCount} failed." - if hasImplError then - IO.Process.exit ExitCode.internalError - else if hasFailure then - IO.Process.exit ExitCode.failuresFound - -def pyInterpretCommand : Command where - name := "pyInterpret" - args := [ "file" ] - flags := [{ name := "fuel", help := "Maximum execution steps.", takesArg := .arg "n" }] - ++ laurelTranslateFlags - help := "Interpret a Python Ion program concretely (Python → Laurel → Core → execute)." - callback := fun v pflags => do - let filePath := v[0] - let keepDir := pflags.getString "keep-all-files" - let fuel ← match pflags.getString "fuel" with - | some s => match s.toNat? with - | .some n => pure n - | .none => exitFailure s!"Invalid fuel: '{s}'" - | none => pure 10000 - - let (core, _diags) ← - match ← Strata.pythonAndSpecToLaurel filePath (specDir := ".") |>.toBaseIO with - | .ok laurel => - if let some dir := keepDir then - IO.FS.createDirAll dir - IO.FS.writeFile (dir ++ "/laurel.st") (toString (Std.format laurel)) - match ← Strata.translateCombinedLaurel laurel with - | (some core, diags) => pure (core, diags) - | (none, diags) => exitFailure s!"Laurel to Core translation failed: {diags}" - | .error msg => exitFailure (toString msg) - if let some dir := keepDir then - IO.FS.writeFile (dir ++ "/core.st") (toString (Std.format core)) - let core ← match Core.typeCheck Core.VerifyOptions.quiet core - (moreFns := Strata.Python.ReFactory) with - | .ok prog => pure prog - | .error e => - println! s!"Core type checking failed: {e.message}" - IO.Process.exit ExitCode.userError - match core.run with - | .ok E => - let mainProc := Core.Program.Procedure.find? core ⟨"__main__", ()⟩ - let outputNames := match mainProc with - | some p => p.header.outputs.keys.map (·.name) - | none => [] - let (lhs, exprEnv) := Core.Env.genVars outputNames E.exprEnv - let E := { E with exprEnv } - let E := Core.Statement.Command.runCall lhs "__main__" [] fuel E - match E.error with - | none => - IO.println "Execution completed successfully." - | some e => - IO.println s!"{Std.format e}" - IO.Process.exit ExitCode.failuresFound - | .error diag => - IO.eprintln s!"Error: {diag}" - IO.Process.exit ExitCode.failuresFound - -def commandGroups : List CommandGroup := [ - { name := "Core" - commands := [verifyCommand, transformCommand, checkCommand, toIonCommand, printCommand, diffCommand] - commonFlags := [includeFlag] }, - { name := "Code Generation" - commands := [javaGenCommand] }, - { name := "Python" - commands := [pyAnalyzeLaurelCommand, - pyResolveOverloadsCommand, - pySpecsCommand, pySpecToLaurelCommand, - pyAnalyzeLaurelToGotoCommand, - pyAnalyzeToGotoCommand, - pyTranslateLaurelCommand, - pyInterpretCommand] }, - { name := "Laurel" - commands := [laurelAnalyzeCommand, laurelAnalyzeBinaryCommand, - laurelAnalyzeToGotoCommand, laurelParseCommand, - laurelPrintCommand, laurelToCoreCommand] }, -] - -def commandList : List Command := - commandGroups.foldl (init := []) fun acc g => acc ++ g.commands - -def commandMap : Std.HashMap String Command := - commandList.foldl (init := {}) fun m c => m.insert c.name c - -/-- Print a single flag's name and help text at the given indentation. -/ -private def printFlag (indent : Nat) (flag : Flag) : IO Unit := do - let pad := "".pushn ' ' indent - match flag.takesArg with - | .arg argName | .repeat argName => - IO.println s!"{pad}--{flag.name} <{argName}> {flag.help}" - | .none => - IO.println s!"{pad}--{flag.name} {flag.help}" - -/-- Print help for all command groups. -/ -private def printGlobalHelp : IO Unit := do - IO.println "Usage: strata [flags]...\n" - IO.println "Command-line utilities for working with Strata.\n" - for group in commandGroups do - IO.println s!"{group.name}:" - for cmd in group.commands do - let cmdLine := cmd.args.foldl (init := cmd.name) fun s a => s!"{s} <{a}>" - IO.println s!" {cmdLine}" - printIndented 4 cmd.help - let perCmdFlags := cmd.flags.filter fun f => - !group.commonFlags.any fun cf => cf.name == f.name - if !perCmdFlags.isEmpty then - IO.println "" - IO.println " Flags:" - for flag in perCmdFlags do - printFlag 6 flag - IO.println "" - if !group.commonFlags.isEmpty then - IO.println " Common flags:" - for flag in group.commonFlags do - printFlag 4 flag - IO.println "" - -/-- Print help for a single command. -/ -private def printCommandHelp (cmd : Command) : IO Unit := do - let cmdLine := cmd.args.foldl (init := s!"strata {cmd.name}") fun s a => s!"{s} <{a}>" - let flagSummary := cmd.flags.foldl (init := "") fun s f => - match f.takesArg with - | .arg argName | .repeat argName => s!"{s} [--{f.name} <{argName}>]" - | .none => s!"{s} [--{f.name}]" - IO.println s!"Usage: {cmdLine}{flagSummary}\n" - printIndented 0 cmd.help - if !cmd.flags.isEmpty then - IO.println "\nFlags:" - for flag in cmd.flags do - printFlag 2 flag - -/-- Parse interleaved flags and positional arguments. Returns the collected - positional arguments and parsed flags. -/ -private def parseArgs (cmdName : String) - (flagMap : Std.HashMap String Flag) - (acc : Array String) (pflags : ParsedFlags) - (cmdArgs : List String) : IO (Array String × ParsedFlags) := do - match cmdArgs with - | arg :: cmdArgs => - if arg.startsWith "--" then - let raw := (arg.drop 2).toString - -- Support --flag=value syntax by splitting on first '=' - let (flagName, inlineValue) ← match raw.splitOn "=" with - | name :: value :: rest => - if !rest.isEmpty then - exitCmdFailure cmdName s!"Invalid option format: {arg}. Values must not contain '='." - pure (name, some value) - | _ => pure (raw, none) - match flagMap[flagName]? with - | some flag => - match flag.takesArg with - | .none => - parseArgs cmdName flagMap acc (pflags.insert flagName Option.none) cmdArgs - | .arg _ => - match inlineValue with - | some value => - parseArgs cmdName flagMap acc (pflags.insert flagName (some value)) cmdArgs - | none => - let value :: cmdArgs := cmdArgs - | exitCmdFailure cmdName s!"Expected value after {arg}." - parseArgs cmdName flagMap acc (pflags.insert flagName (some value)) cmdArgs - | .repeat _ => - match inlineValue with - | some value => - parseArgs cmdName flagMap acc (pflags.insert flagName (some value)) cmdArgs - | none => - let value :: cmdArgs := cmdArgs - | exitCmdFailure cmdName s!"Expected value after {arg}." - parseArgs cmdName flagMap acc (pflags.insert flagName (some value)) cmdArgs - | none => - exitCmdFailure cmdName s!"Unknown option {arg}." - else - parseArgs cmdName flagMap (acc.push arg) pflags cmdArgs - | [] => - pure (acc, pflags) - -public -def main (args : List String) : IO Unit := do - try do - match args with - | ["--help"] => printGlobalHelp - | cmd :: args => - match commandMap[cmd]? with - | none => exitFailure s!"Expected subcommand, got {cmd}." - | some cmd => - -- Handle per-command help before parsing flags. - if args.contains "--help" then - printCommandHelp cmd - return - -- Index the command's flags by name for O(1) lookup during parsing. - let flagMap : Std.HashMap String Flag := - cmd.flags.foldl (init := {}) fun m f => m.insert f.name f - -- Split raw args into positional arguments and parsed flags. - let (args, pflags) ← parseArgs cmd.name flagMap #[] {} args - if p : args.size = cmd.args.length then - cmd.callback ⟨args, p⟩ pflags - else - exitCmdFailure cmd.name s!"{cmd.name} expects {cmd.args.length} argument(s)." - | [] => do - exitFailure "Expected subcommand." - catch e => - exitFailure e.toString +def main (args : List String) : IO Unit := + runCommandMap commandMap commandGroups args diff --git a/StrataMainLib.lean b/StrataMainLib.lean new file mode 100644 index 0000000000..c58f839c8f --- /dev/null +++ b/StrataMainLib.lean @@ -0,0 +1,1560 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +-- Library with utilities for working with Strata files. +import Lean.Parser.Extension +import Strata.Backends.CBMC.CollectSymbols +import Strata.Backends.CBMC.GOTO.CoreToGOTOPipeline +import Strata.DDM.Integration.Java.Gen +import Strata.Languages.Core.Verifier +import Strata.Languages.Core.SarifOutput +import Strata.Languages.Core.ProgramEval +import Strata.Languages.Core.StatementEval +import Strata.Languages.C_Simp.Verify +import Strata.Languages.B3.Verifier.Program +import Strata.Languages.Laurel.LaurelCompilationPipeline +import Strata.Languages.Boole.Boole +import Strata.Languages.Boole.Verify +import Strata.Languages.Python.Python +import Strata.Languages.Python.Specs.IdentifyOverloads +import Strata.Languages.Python.Specs.ToLaurel +import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator +import Strata.Languages.Laurel.Laurel +import Strata.Languages.Core.EntryPoint +import Strata.Transform.ProcedureInlining +import Strata.Util.IO + +import Strata.SimpleAPI +import Strata.Util.Profile +import Strata.Util.Json +import Strata.DDM.BuiltinDialects +import Strata.DDM.Util.String +import Strata.Languages.Python.PyFactory +import Strata.Languages.Python.Specs +import Strata.Languages.Python.Specs.DDM +import Strata.Languages.Python.ReadPython + +open Strata + +open Core (VerifyOptions VerboseMode VerificationMode CheckLevel EntryPoint) +open Laurel (LaurelVerifyOptions LaurelTranslateOptions) + +/-! ## Exit codes + +All `strata` subcommands use a common exit code scheme: + +| Code | Category | Meaning | +|------|--------------------|-----------------------------------------------------------| +| 0 | Success | Analysis passed, inconclusive, or `--no-solve` completed. | +| 1 | User error | Bad input: invalid arguments, malformed source, etc. | +| 2 | Failures found | Analysis completed and found failures. | +| 3 | Internal error | SMT encoding failure, solver crash, or translation bug. | +| 4 | Known limitation | Intentionally unsupported language construct. | + +Codes 1–2 are **user-actionable** (fix the input or the code under analysis). +Codes 3–4 are **tool-side** (report as a bug or wait for support). +Exit 0 covers success, inconclusive results, and solver timeouts. -/ + +namespace ExitCode + def userError : UInt8 := 1 + def failuresFound : UInt8 := 2 + def internalError : UInt8 := 3 + def knownLimitation : UInt8 := 4 +end ExitCode + +def exitFailure {α} (message : String) (hint : String := "strata --help") : IO α := do + IO.eprintln s!"Exception: {message}\n\nRun {hint} for additional help." + IO.Process.exit ExitCode.userError + +/-- Exit with code 1 for user errors (bad input, malformed source, etc.). -/ +def exitUserError {α} (message : String) : IO α := do + IO.eprintln s!"❌ {message}" + IO.Process.exit ExitCode.userError + +/-- Exit with code 2 for analysis failures found. -/ +def exitFailuresFound {α} (message : String) : IO α := do + IO.eprintln s!"Failures found: {message}" + IO.Process.exit ExitCode.failuresFound + +/-- Exit with code 3 for internal errors (tool limitations or crashes). -/ +def exitInternalError {α} (message : String) : IO α := do + IO.eprintln s!"Exception: {message}" + IO.Process.exit ExitCode.internalError + +/-- Exit with code 4 for known limitations (unsupported constructs). -/ +def exitKnownLimitation {α} (message : String) : IO α := do + IO.eprintln s!"Known limitation: {message}" + IO.Process.exit ExitCode.knownLimitation + +/-- Like `exitFailure` but tailors the help hint to a specific subcommand. -/ +def exitCmdFailure {α} (cmdName : String) (message : String) : IO α := + exitFailure message (hint := s!"strata {cmdName} --help") + +/-- How a flag consumes arguments. -/ +inductive FlagArg where + | none -- boolean flag, e.g. --verbose + | arg (name : String) -- takes one value, e.g. --output + | repeat (name : String) -- takes one value, may appear multiple times, e.g. --include + +/-- A flag that a command accepts. -/ +structure Flag where + name : String -- flag name without "--", used as lookup key + help : String + takesArg : FlagArg := .none + +/-- Parsed flags from the command line. Stored as an ordered array so that + command-line position is preserved (needed by `transform` to bind + `--procedures`/`--functions` to the preceding `--pass`). + For `.arg` flags that appear more than once, `getString` returns the + **last** occurrence (last-writer-wins). -/ +structure ParsedFlags where + entries : Array (String × Option String) := #[] + +namespace ParsedFlags + +def getBool (pf : ParsedFlags) (name : String) : Bool := + pf.entries.any (·.1 == name) + +def getString (pf : ParsedFlags) (name : String) : Option String := + -- Scan from the end so last occurrence wins. + match pf.entries.findRev? (·.1 == name) with + | some (_, some v) => some v + | _ => Option.none + +def getRepeated (pf : ParsedFlags) (name : String) : Array String := + pf.entries.foldl (init := #[]) fun acc (n, v) => + if n == name then match v with | some s => acc.push s | none => acc else acc + +def insert (pf : ParsedFlags) (name : String) (value : Option String) : ParsedFlags := + { pf with entries := pf.entries.push (name, value) } + +def buildDialectFileMap (pflags : ParsedFlags) : IO Strata.DialectFileMap := do + let preloaded := Strata.Elab.LoadedDialects.builtin + |>.addDialect! Strata.Python.Python + |>.addDialect! Strata.Python.Specs.DDM.PythonSpecs + |>.addDialect! Strata.Core + |>.addDialect! Strata.Boole + |>.addDialect! Strata.Laurel.Laurel + |>.addDialect! Strata.smtReservedKeywordsDialect + |>.addDialect! Strata.SMTCore + |>.addDialect! Strata.SMT + |>.addDialect! Strata.SMTResponse + let mut sp ← Strata.DialectFileMap.new preloaded + for path in pflags.getRepeated "include" do + match ← sp.add path |>.toBaseIO with + | .error msg => exitFailure msg + | .ok sp' => sp := sp' + return sp + +end ParsedFlags + +def parseCheckMode (pflags : ParsedFlags) + (default : VerificationMode := .deductive) : IO VerificationMode := + match pflags.getString "check-mode" with + | .none => pure default + | .some s => match VerificationMode.ofString? s with + | .some m => pure m + | .none => exitFailure s!"Invalid check mode: '{s}'. Must be {VerificationMode.options}." + +def parseCheckLevel (pflags : ParsedFlags) + (default : CheckLevel := .minimal) : IO CheckLevel := + match pflags.getString "check-level" with + | .none => pure default + | .some s => match CheckLevel.ofString? s with + | .some l => pure l + | .none => exitFailure s!"Invalid check level: '{s}'. Must be {CheckLevel.options}." + +/-- Common CLI flags for VerifyOptions fields. + Commands can append these to their own flags list. + Note: `parseOnly`, `typeCheckOnly`, and `checkOnly` are omitted here + because they are specific to the `verify` command. -/ +def verifyOptionsFlags : List Flag := [ + { name := "check-mode", + help := s!"Check mode: {VerificationMode.options}. Default: 'deductive'.", + takesArg := .arg "mode" }, + { name := "check-level", + help := s!"Check level: {CheckLevel.options}. Default: 'minimal'.", + takesArg := .arg "level" }, + { name := "verbose", help := "Enable verbose output." }, + { name := "quiet", help := "Suppress warnings on stderr." }, + { name := "profile", help := "Print elapsed time for each pipeline step." }, + { name := "sarif", help := "Write results as SARIF to .sarif." }, + { name := "solver", + help := s!"SMT solver executable (default: {Core.defaultSolver}).", + takesArg := .arg "name" }, + { name := "solver-timeout", + help := "Solver timeout in seconds (default: 10).", + takesArg := .arg "seconds" }, + { name := "vc-directory", + help := "Store VCs in SMT-Lib format in .", + takesArg := .arg "dir" }, + { name := "no-solve", + help := "Generate SMT-Lib files but do not invoke the solver." }, + { name := "stop-on-first-error", + help := "Exit after the first verification error." }, + { name := "unique-bound-names", + help := "Use globally unique names for quantifier-bound variables." }, + { name := "use-array-theory", + help := "Use SMT-LIB Array theory instead of axiomatized maps." }, + { name := "remove-irrelevant-axioms", + help := "Prune irrelevant axioms: 'off', 'aggressive', or 'precise'.", + takesArg := .arg "mode" }, + { name := "overflow-checks", + help := "Comma-separated overflow checks to enable (signed,unsigned,float64,all,none).", + takesArg := .arg "checks" }, + { name := "incremental", + help := "Use incremental solver backend (stdin/stdout) instead of batch file I/O." }, + { name := "path-cap", + help := "Maximum continuing paths between statements. 'none' (default) disables; N merges paths when count exceeds N.", + takesArg := .arg "N|none" } +] + +/-- Build a VerifyOptions from parsed CLI flags, starting from a base config. + Fields not present in the flags keep their base values. + Note: boolean flags can only enable a setting; a `true` in the base + cannot be turned off from the CLI (there is no `--no-X` syntax). -/ +def parseVerifyOptions (pflags : ParsedFlags) + (base : VerifyOptions := VerifyOptions.default) : IO VerifyOptions := do + let checkMode ← parseCheckMode pflags base.checkMode + let checkLevel ← parseCheckLevel pflags base.checkLevel + let solverTimeout ← match pflags.getString "solver-timeout" with + | .none => pure base.solverTimeout + | .some s => match s.toNat? with + | .some n => pure n + | .none => exitFailure s!"Invalid solver timeout: '{s}'" + let noSolve := pflags.getBool "no-solve" + let removeIrrelevantAxioms ← match pflags.getString "remove-irrelevant-axioms" with + | .none => pure base.removeIrrelevantAxioms + | .some "off" => pure .Off + | .some "aggressive" => pure .Aggressive + | .some "precise" => pure .Precise + | .some s => exitFailure s!"Invalid remove-irrelevant-axioms mode: '{s}'. Must be 'off', 'aggressive', or 'precise'." + let overflowChecks := match pflags.getString "overflow-checks" with + | .none => base.overflowChecks + | .some s => s.splitOn "," |>.foldl (fun acc c => + match c.trimAscii.toString with + | "signed" => { acc with signedBV := true } + | "unsigned" => { acc with unsignedBV := true } + | "float64" => { acc with float64 := true } + | "none" => { signedBV := false, unsignedBV := false, float64 := false } + | "all" => { signedBV := true, unsignedBV := true, float64 := true } + | _ => acc) { signedBV := false, unsignedBV := false, float64 := false } + let pathCap ← match pflags.getString "path-cap" with + | .none => pure base.pathCap + | .some "none" => pure .none + | .some s => match s.toNat? with + | .some n => if n == 0 then exitFailure "--path-cap must be at least 1 or 'none'." + else pure (.some n) + | .none => exitFailure s!"Invalid path-cap: '{s}'. Must be a positive number or 'none'." + let vcDirectory := (pflags.getString "vc-directory" |>.map (⟨·⟩ : String → System.FilePath)).orElse (fun _ => base.vcDirectory) + let skipSolver := noSolve || base.skipSolver + if skipSolver && vcDirectory.isNone then + exitFailure "--no-solve requires --vc-directory to specify where SMT files are stored." + pure { base with + verbose := if pflags.getBool "verbose" then .normal + else if pflags.getBool "quiet" then .quiet + else base.verbose, + solver := pflags.getString "solver" |>.getD base.solver, + solverTimeout, + checkMode, checkLevel, + stopOnFirstError := pflags.getBool "stop-on-first-error" || base.stopOnFirstError, + uniqueBoundNames := pflags.getBool "unique-bound-names" || base.uniqueBoundNames, + useArrayTheory := pflags.getBool "use-array-theory" || base.useArrayTheory, + removeIrrelevantAxioms, + outputSarif := pflags.getBool "sarif" || base.outputSarif, + profile := pflags.getBool "profile" || base.profile, + incremental := if noSolve then false else pflags.getBool "incremental" || base.incremental, + skipSolver, + alwaysGenerateSMT := noSolve || base.alwaysGenerateSMT, + overflowChecks, + vcDirectory, + pathCap + } + +/-- Additional CLI flags for `LaurelVerifyOptions` fields that are not already + covered by `verifyOptionsFlags`. -/ +def laurelTranslateFlags : List Flag := [ + { name := "keep-all-files", + help := "Store intermediate Laurel and Core programs in .", + takesArg := .arg "dir" } +] + +/-- All CLI flags accepted by Laurel verify commands. -/ +def laurelVerifyOptionsFlags : List Flag := verifyOptionsFlags ++ laurelTranslateFlags + +/-- Build a `LaurelVerifyOptions` from parsed CLI flags. -/ +def parseLaurelVerifyOptions (pflags : ParsedFlags) + (base : LaurelVerifyOptions := default) : IO LaurelVerifyOptions := do + let verifyOptions ← parseVerifyOptions pflags base.verifyOptions + let keepAllFilesPrefix := (pflags.getString "keep-all-files").orElse + (fun _ => base.translateOptions.keepAllFilesPrefix) + let translateOptions : LaurelTranslateOptions := + { base.translateOptions with + keepAllFilesPrefix + overflowChecks := verifyOptions.overflowChecks + profile := verifyOptions.profile } + return { translateOptions, verifyOptions } + +/-- Read and parse a Strata program file, loading the Core, C_Simp, and B3CST + dialects. Returns the parsed program and the input context (for source + location resolution), or an array of error messages on failure. -/ +private def readStrataProgram (file : String) + : IO (Except (Array Lean.Message) (Strata.Program × Lean.Parser.InputContext)) := do + let text ← Strata.Util.readInputSource file + let inputCtx := Lean.Parser.mkInputContext text (Strata.Util.displayName file) + let dctx := Elab.LoadedDialects.builtin + let dctx := dctx.addDialect! Core + let dctx := dctx.addDialect! Boole + let dctx := dctx.addDialect! C_Simp + let dctx := dctx.addDialect! B3CST + let leanEnv ← Lean.mkEmptyEnvironment 0 + match Strata.Elab.elabProgram dctx leanEnv inputCtx with + | .ok pgm => pure (.ok (pgm, inputCtx)) + | .error msgs => pure (.error msgs) + +structure Command where + name : String + args : List String + flags : List Flag := [] + help : String + callback : Vector String args.length → ParsedFlags → IO Unit + +def includeFlag : Flag := + { name := "include", help := "Add a dialect search path.", takesArg := .repeat "path" } + +def checkCommand : Command where + name := "check" + args := [ "file" ] + flags := [includeFlag] + help := "Parse and validate a Strata file (text or Ion). Reports errors and exits." + callback := fun v pflags => do + let fm ← pflags.buildDialectFileMap + let _ ← Strata.readStrataFile fm v[0] + +def toIonCommand : Command where + name := "toIon" + args := [ "input", "output" ] + flags := [includeFlag] + help := "Convert a Strata text file to Ion binary format." + callback := fun v pflags => do + let searchPath ← pflags.buildDialectFileMap + let pd ← Strata.readStrataFile searchPath v[0] + match pd with + | .dialect d => + IO.FS.writeBinFile v[1] d.toIon + | .program pgm => + IO.FS.writeBinFile v[1] pgm.toIon + +def printCommand : Command where + name := "print" + args := [ "file" ] + flags := [includeFlag] + help := "Pretty-print a Strata file (text or Ion) to stdout." + callback := fun v pflags => do + let searchPath ← pflags.buildDialectFileMap + -- Special case for already loaded dialects. + let ld ← searchPath.getLoaded + if mem : v[0] ∈ ld.dialects then + IO.print <| ld.dialects.format v[0] mem + return + let pd ← Strata.readStrataFile searchPath v[0] + match pd with + | .dialect d => + let ld ← searchPath.getLoaded + let .isTrue mem := (inferInstance : Decidable (d.name ∈ ld.dialects)) + | exitInternalError "Internal error reading file." + IO.print <| ld.dialects.format d.name mem + | .program pgm => + IO.print <| toString pgm + +def diffCommand : Command where + name := "diff" + args := [ "file1", "file2" ] + flags := [includeFlag] + help := "Compare two program files for syntactic equality. Reports the first difference found." + callback := fun v pflags => do + let fm ← pflags.buildDialectFileMap + let p1 ← Strata.readStrataFile fm v[0] + let p2 ← Strata.readStrataFile fm v[1] + match p1, p2 with + | .program p1, .program p2 => + if p1.dialect != p2.dialect then + exitFailure s!"Dialects differ: {p1.dialect} and {p2.dialect}" + let Decidable.isTrue eq := (inferInstance : Decidable (p1.commands.size = p2.commands.size)) + | exitFailure s!"Number of commands differ {p1.commands.size} and {p2.commands.size}" + for (c1, c2) in Array.zip p1.commands p2.commands do + if c1 != c2 then + exitFailure s!"Commands differ: {repr c1} and {repr c2}" + | _, _ => + exitFailure "Cannot compare dialect def with another dialect/program." + +def pySpecsCommand : Command where + name := "pySpecs" + args := [ "source_dir", "output_dir" ] + flags := [ + { name := "quiet", help := "Suppress default logging." }, + { name := "log", help := "Enable logging for an event type.", + takesArg := .repeat "event" }, + { name := "skip", + help := "Skip a top-level definition (module.name). Overloads are kept.", + takesArg := .repeat "name" }, + { name := "module", + help := "Translate only the named module (dot-separated). May be repeated.", + takesArg := .repeat "module" } + ] + help := "Translate Python specification files in a directory into Strata DDM Ion format. If --module is given, translates only those modules; otherwise translates all .py files. Creates subdirectories as needed. (Experimental)" + callback := fun v pflags => do + let quiet := pflags.getBool "quiet" + let mut events : Std.HashSet String := {} + if !quiet then + events := events.insert "import" + for e in pflags.getRepeated "log" do + events := events.insert e + let skipNames := pflags.getRepeated "skip" + let modules := pflags.getRepeated "module" + let warningOutput : Strata.WarningOutput := + if quiet then .none else .detail + -- Serialize embedded dialect for Python subprocess + IO.FS.withTempFile fun _handle dialectFile => do + IO.FS.writeBinFile dialectFile Strata.Python.Python.toIon + let r ← Strata.pySpecsDir (events := events) + (skipNames := skipNames) + (modules := modules) + (warningOutput := warningOutput) + v[0] v[1] dialectFile |>.toBaseIO + match r with + | .ok () => pure () + | .error msg => exitFailure msg + +/-- Derive Python source file path from Ion file path. + E.g., "tests/test_foo.python.st.ion" -> "tests/test_foo.py" -/ +def ionPathToPythonPath (ionPath : String) : Option String := + if ionPath.endsWith ".python.st.ion" then + let basePath := ionPath.dropEnd ".python.st.ion".length |>.toString + some (basePath ++ ".py") + else if ionPath.endsWith ".py.ion" then + some (ionPath.dropEnd ".ion".length |>.toString) + else + none + +/-- Try to read Python source file for source location reconstruction -/ +def tryReadPythonSource (ionPath : String) : IO (Option (String × String)) := do + match ionPathToPythonPath ionPath with + | none => return none + | some pyPath => + try + let content ← IO.FS.readFile pyPath + return some (pyPath, content) + catch _ => + return none + +/-- Format related position strings from metadata, if present. -/ +def formatRelatedPositions (md : Imperative.MetaData Core.Expression) + (mfm : Option (String × Lean.FileMap)) : String := + let ranges := Imperative.getRelatedFileRanges md + if ranges.isEmpty then "" else + match mfm with + | none => "" + | some (_, fm) => + let lines := ranges.filterMap fun fr => + if fr.range.isNone then none else + match fr.file with + | .file "" => some "\n Related location: in prelude file" + | .file _ => + let pos := fm.toPosition fr.range.start + some s!"\n Related location: line {pos.line}, col {pos.column}" + String.join lines.toList + +/-! ### pyAnalyzeLaurel result helpers + +The `pyAnalyzeLaurel` command emits two structured lines on stdout: +- `RESULT: ` — machine-readable category, always the last line. +- `DETAIL: ` — human-readable context (error message or VC counts). + +Exit codes follow the common scheme (see `ExitCode` above). +A successful run exits 0 with `RESULT: Analysis success` or `RESULT: Inconclusive`. -/ + +/-- Determines which VC results count as successes and which count as failures + for the purposes of the `pyAnalyzeLaurel` summary and exit code. + Implementation-error results are partitioned out first; the classifier then + partitions the rest into success / failure / inconclusive. + Narrowing `isFailure` (e.g. to only `alwaysFalseAndReachable`) automatically + widens inconclusive. + Future: may be extended with `isWarning` for non-fatal diagnostic categories. -/ +structure ResultClassifier where + isSuccess : Core.VCResult → Bool := (·.isSuccess) + isFailure : Core.VCResult → Bool := (·.isFailure) + +private def printPyAnalyzeResult (category : String) (detail : String) : IO Unit := do + IO.println s!"DETAIL: {detail}" + IO.println s!"RESULT: {category}" + +private def exitPyAnalyzeUserError {α} (message : String) : IO α := do + printPyAnalyzeResult "User error" message + IO.Process.exit ExitCode.userError + +private def exitPyAnalyzeFailuresFound {α} (detail : String) : IO α := do + printPyAnalyzeResult "Failures found" detail + IO.Process.exit ExitCode.failuresFound + +private def exitPyAnalyzeInternalError {α} (message : String) : IO α := do + printPyAnalyzeResult "Internal error" message + IO.Process.exit ExitCode.internalError + +private def exitPyAnalyzeKnownLimitation {α} (message : String) : IO α := do + printPyAnalyzeResult "Known limitation" message + IO.Process.exit ExitCode.knownLimitation + +/-- Print the final RESULT/DETAIL lines based on solver outcomes. + Always called on successful pipeline completion (as opposed to the + exit helpers above, which are called on early pipeline failure). + Classification uses successive partitioning: timeouts and implementation + errors are removed first, then the classifier partitions the rest into + success / failure / inconclusive (guaranteeing disjointness). + Unreachable count is reported as supplementary info. + + Exit-code priority (highest wins): + - Internal error (exit 3): encoding failures or solver crashes + - Failures found (exit 2): assertion violations + - Inconclusive / success / solver timeout (exit 0) -/ +private def printPyAnalyzeSummary (vcResults : Array Core.VCResult) + (checkMode : VerificationMode := .deductive) : IO Unit := do + let classifier : ResultClassifier := + match checkMode with + | .bugFinding | .bugFindingAssumingCompleteSpec => + { isSuccess := (·.isBugFindingSuccess) + isFailure := (·.isBugFindingFailure) } + | _ => {} + -- 1. Partition out implementation errors and timeouts (not classifiable). + let (implError, rest1) := + vcResults.partition (fun r => r.isImplementationError || r.hasSMTError) + let (timeouts, classifiable) := rest1.partition (·.isTimeout) + -- 2. Successive partitioning via the classifier: success → failure → inconclusive. + let (success, rest) := classifiable.partition classifier.isSuccess + let (failure, inconclusive) := rest.partition classifier.isFailure + -- 3. Unreachable is informational (not a separate partition). + let nUnreachable := vcResults.filter (·.isUnreachable) |>.size + let nImplError := implError.size + let nTimeout := timeouts.size + let nSuccess := success.size + let nFailure := failure.size + let nInconclusive := inconclusive.size + let unreachableStr := if nUnreachable > 0 then s!", {nUnreachable} unreachable" else "" + let implErrorStr := if nImplError > 0 then s!", {nImplError} internal errors" else "" + let timeoutStr := if nTimeout > 0 then s!", {nTimeout} solver timeouts" else "" + let counts := s!"{nSuccess} passed, {nFailure} failed, {nInconclusive} inconclusive{unreachableStr}{timeoutStr}{implErrorStr}" + if nImplError > 0 then + exitPyAnalyzeInternalError s!"An unexpected result was produced. {counts}" + else if nFailure > 0 then + exitPyAnalyzeFailuresFound counts + else + let label := + if nTimeout > 0 then "Solver timeout" + else if nInconclusive > 0 then "Inconclusive" + else "Analysis success" + printPyAnalyzeResult label counts + +private def deriveBaseName (file : String) : String := + let name := System.FilePath.fileName file |>.getD file + let suffixes := [".python.st.ion", ".py.ion", ".st.ion", ".st"] + match suffixes.find? (name.endsWith ·) with + | some sfx => (name.dropEnd sfx.length).toString + | none => name + + +def pyAnalyzeLaurelCommand : Command where + name := "pyAnalyzeLaurel" + args := [ "file" ] + flags := verifyOptionsFlags ++ [ + { name := "spec-dir", + help := "Directory containing compiled PySpec Ion files.", + takesArg := .arg "dir" }, + { name := "dispatch", + help := "Dispatch module name (e.g., servicelib).", + takesArg := .repeat "module" }, + { name := "pyspec", + help := "PySpec module name (e.g., servicelib.Storage).", + takesArg := .repeat "module" }, + { name := "keep-all-files", + help := "Store intermediate Laurel and Core programs in .", + takesArg := .arg "dir" }, + { name := "entry-point", + help := "Which procedures to verify: main (main fn only), roots (user procs with no user callers, default), or all (all user procs). Only valid in bugFinding mode.", + takesArg := .arg "mode" }, + { name := "warning-summary", + help := "Write PySpec warning summary as JSON to .", + takesArg := .arg "file" }, + { name := "skip-verification", + help := "Run Python-to-Laurel and Laurel-to-Core translation only (skip SMT verification).", + takesArg := .none }] + help := "Verify a Python Ion program via the Laurel pipeline. Translates Python to Laurel to Core, then runs SMT verification." + callback := fun v pflags => do + let verbose := pflags.getBool "verbose" + let profile := pflags.getBool "profile" + let quiet := pflags.getBool "quiet" + let outputSarif := pflags.getBool "sarif" + let filePath := v[0] + let pySourceOpt ← tryReadPythonSource filePath + let keepDir := pflags.getString "keep-all-files" + let baseName := deriveBaseName filePath + if let some dir := keepDir then + IO.FS.createDirAll dir + + let dispatchModules := pflags.getRepeated "dispatch" + let pyspecModules := pflags.getRepeated "pyspec" + let specDir := pflags.getString "spec-dir" |>.getD "." + unless ← System.FilePath.isDir specDir do + exitFailure s!"spec-dir '{specDir}' does not exist or is not a directory" + let sourcePath := pySourceOpt.map (·.1) + -- Build FileMap for source position resolution. + let mfm : Option (String × Lean.FileMap) := match pySourceOpt with + | some (pyPath, srcText) => some (pyPath, .ofString srcText) + | none => none + let warningSummaryFile := pflags.getString "warning-summary" + let combinedLaurel ← + match ← Strata.pythonAndSpecToLaurel filePath dispatchModules pyspecModules sourcePath + (specDir := specDir) (profile := profile) + (quiet := quiet) + (warningSummaryFile := warningSummaryFile) |>.toBaseIO with + | .ok r => pure r + | .error (.userCode range msg) => + let location := if range.isNone then "" else + match mfm with + | some (_, fm) => + let pos := fm.toPosition range.start + s!" at line {pos.line}, col {pos.column}" + | none => "" + let filePath' := sourcePath.getD filePath + let mut lines := #[ + s!"(set-info :file {Strata.escapeSMTStringLit filePath'})" + ] + unless range.isNone do + lines := lines.push s!"(set-info :start {range.start})" + lines := lines.push s!"(set-info :stop {range.stop})" + lines := lines.push s!"(set-info :error-message {Strata.escapeSMTStringLit msg})" + for line in lines do + IO.println line + IO.FS.writeFile "user_errors.txt" (String.intercalate "\n" lines.toList ++ "\n") + exitPyAnalyzeUserError s!"{msg}{location}" + | .error (.knownLimitation msg) => + exitPyAnalyzeKnownLimitation msg + | .error (.internal msg) => + exitPyAnalyzeInternalError msg + + if verbose then + IO.println "\n==== Laurel Program ====" + IO.println f!"{combinedLaurel}" + + let keepPrefix := keepDir.map (s!"{·}/{baseName}") + + let (coreProgramOption, laurelTranslateErrors, _loweredLaurel, laurelPassStats) ← + profileStep profile "Laurel to Core translation" do + Strata.translateCombinedLaurelWithLowered combinedLaurel + (keepAllFilesPrefix := keepPrefix) (profile := profile) + + if profile && !laurelPassStats.data.isEmpty then + IO.println laurelPassStats.format + + let coreProgram ← + match coreProgramOption with + | none => + exitPyAnalyzeInternalError s!"Laurel to Core translation failed: {laurelTranslateErrors}" + | some core => pure core + + if verbose then + IO.println "\n==== Core Program ====" + IO.print (Core.formatProgram coreProgram) + + -- When --skip-verification is set, report translation diagnostics and exit + -- without running SMT verification (stages 3-4). + if pflags.getBool "skip-verification" then do + if !laurelTranslateErrors.isEmpty then + IO.eprintln "\n==== Errors ====" + for err in laurelTranslateErrors do + IO.eprintln err + if outputSarif then + let files := match mfm with + | some (pyPath, fm) => Map.empty.insert (Strata.Uri.file pyPath) fm + | none => Map.empty + Core.Sarif.writeSarifOutput .deductive files #[] (filePath ++ ".sarif") + let nStrataBug := laurelTranslateErrors.filter (·.type == .StrataBug) |>.length + let nNotYetImpl := laurelTranslateErrors.filter (·.type == .NotYetImplemented) |>.length + let nUserError := laurelTranslateErrors.filter (·.type == .UserError) |>.length + let nWarning := laurelTranslateErrors.filter (·.type == .Warning) |>.length + let counts := s!"{nUserError} user errors, {nWarning} warnings, {nNotYetImpl} not yet implemented, {nStrataBug} internal errors" + if nStrataBug > 0 then + exitPyAnalyzeInternalError s!"Translation produced internal errors. {counts}" + else if nNotYetImpl > 0 then + exitPyAnalyzeKnownLimitation s!"Translation encountered unsupported constructs. {counts}" + else + printPyAnalyzeResult "Analysis success" counts + return + + -- Verify using Core verifier + -- --keep-all-files implies vc-directory if not explicitly set + let baseVcDir := keepDir.map (fun dir => (s!"{dir}/{baseName}" : System.FilePath)) + let pyAnalyzeBase : VerifyOptions := + { VerifyOptions.default with + verbose := .quiet, removeIrrelevantAxioms := .Precise, + vcDirectory := baseVcDir } + let options ← parseVerifyOptions pflags pyAnalyzeBase + let isBugFinding := options.checkMode == .bugFinding + || options.checkMode == .bugFindingAssumingCompleteSpec + + -- Parse --entry-point flag (only supported in bug-finding modes). + let entryPointFlag := pflags.getString "entry-point" + let entryPoint : EntryPoint ← + if isBugFinding then + match entryPointFlag with + | some s => + match EntryPoint.ofString? s with + | some ep => pure ep + | none => + exitPyAnalyzeUserError s!"Invalid --entry-point value '{s}'. Must be {EntryPoint.options}." + | none => pure .roots + else + if entryPointFlag.isSome then + exitPyAnalyzeUserError s!"--entry-point is unsupported in {options.checkMode} mode" + else pure .all + + -- Pick the procedures to verify and set up inlining phases. + let userSourcePath := sourcePath.getD filePath + let (_, userProcNames) := + Strata.splitProcNames coreProgram [userSourcePath] + let (proceduresToVerify, inlinePhases) := + if isBugFinding then + let ⟨p, i⟩ := Core.chooseEntryProceduresAndBuildInlinePhases coreProgram userProcNames entryPoint + (p, [i]) + else (userProcNames, []) + + let vcResults ← profileStep profile "SMT verification" do + match ← Core.verifyProgram coreProgram options + (moreFns := Strata.Python.ReFactory) + (proceduresToVerify := some proceduresToVerify) + (externalPhases := [Strata.frontEndPhase]) + (prefixPhases := inlinePhases) + (keepAllFilesPrefix := keepPrefix) + |>.toBaseIO with + | .ok r => pure r.mergeByAssertion + | .error msg => exitPyAnalyzeInternalError msg + + -- Print translation errors (always on stderr) + if !laurelTranslateErrors.isEmpty then + IO.eprintln "\n==== Errors ====" + for err in laurelTranslateErrors do + IO.eprintln err + + -- Print per-VC results by default, unless SARIF mode is used + if !outputSarif then + let mut s := "" + for vcResult in vcResults do + let fileMap := mfm.map (·.2) + let location := match Imperative.getFileRange vcResult.obligation.metadata with + | some fr => + if fr.range.isNone then "" + else s!"{fr.format fileMap (includeEnd? := false)}" + | none => "" + let messageSuffix := match vcResult.obligation.metadata.getPropertySummary with + | some msg => s!" - {msg}" + | none => s!" - {vcResult.obligation.label}" + let outcomeStr := vcResult.formatOutcome + let loc := if !location.isEmpty then s!"{location}: " else "unknown location: " + s := s ++ s!"{loc}{outcomeStr}{messageSuffix}\n" + IO.print s + -- Output in SARIF format if requested + if outputSarif then + let files := match mfm with + | some (pyPath, fm) => Map.empty.insert (Strata.Uri.file pyPath) fm + | none => Map.empty + Core.Sarif.writeSarifOutput options.checkMode files vcResults (filePath ++ ".sarif") + printPyAnalyzeSummary vcResults options.checkMode + +def pyAnalyzeToGotoCommand : Command where + name := "pyAnalyzeToGoto" + args := [ "file" ] + help := "Translate a Strata Python Ion file to CProver GOTO JSON files." + callback := fun v _ => do + let filePath := v[0] + let pySourceOpt ← tryReadPythonSource filePath + let sourcePathForMetadata := match pySourceOpt with + | some (pyPath, _) => pyPath + | none => filePath + let sourceText := pySourceOpt.map (·.2) + let newPgm ← Strata.pythonDirectToCore filePath sourcePathForMetadata + match Core.inlineProcedures newPgm { doInline := (fun _caller callee _ => callee ≠ "main") } with + | .error e => exitInternalError (toString e) + | .ok newPgm => + -- Type-check the full program (registers Python types like ExceptOrNone) + let Ctx := { Lambda.LContext.default with functions := Strata.Python.PythonFactory, knownTypes := Core.KnownTypes } + let Env := Lambda.TEnv.default + let (tcPgm, _) ← match Core.Program.typeCheck Ctx Env newPgm with + | .ok r => pure r + | .error e => exitInternalError s!"{e.format none}" + -- Find the main procedure + let some mainDecl := tcPgm.decls.find? fun d => + match d with + | .proc p _ => Core.CoreIdent.toPretty p.header.name == "main" + | _ => false + | exitInternalError "No main procedure found" + let some p := mainDecl.getProc? + | exitInternalError "main is not a procedure" + -- Translate procedure to GOTO (mirrors CoreToGOTO.transformToGoto post-typecheck logic) + let baseName := deriveBaseName filePath + let procName := Core.CoreIdent.toPretty p.header.name + let axioms := tcPgm.decls.filterMap fun d => d.getAxiom? + let distincts := tcPgm.decls.filterMap fun d => match d with + | .distinct name es _ => some (name, es) | _ => none + match procedureToGotoCtx Env p sourceText (axioms := axioms) (distincts := distincts) + with + | .error e => exitInternalError s!"{e}" + | .ok (ctx, liftedFuncs) => + let extraSyms ← match collectExtraSymbols tcPgm with + | .ok s => pure (Lean.toJson s) + | .error e => exitInternalError s!"{e}" + let (symtab, goto) ← emitProcWithLifted Env procName ctx liftedFuncs extraSyms + (moduleName := baseName) + let symTabFile := s!"{baseName}.symtab.json" + let gotoFile := s!"{baseName}.goto.json" + writeJsonFile symTabFile symtab + writeJsonFile gotoFile goto + IO.println s!"Written {symTabFile} and {gotoFile}" + +def pyTranslateLaurelCommand : Command where + name := "pyTranslateLaurel" + args := [ "file" ] + flags := [{ name := "pyspec", + help := "PySpec module name (e.g., servicelib.Storage).", + takesArg := .repeat "module" }, + { name := "dispatch", + help := "Dispatch module name (e.g., servicelib).", + takesArg := .repeat "module" }, + { name := "spec-dir", + help := "Directory containing compiled PySpec Ion files.", + takesArg := .arg "dir" }] + help := "Translate a Strata Python Ion file through Laurel to Strata Core. Write results to stdout." + callback := fun v pflags => do + let dispatchModules := pflags.getRepeated "dispatch" + let pyspecModules := pflags.getRepeated "pyspec" + let specDir := pflags.getString "spec-dir" |>.getD "." + unless ← System.FilePath.isDir specDir do + exitFailure s!"spec-dir '{specDir}' does not exist or is not a directory" + let coreProgram ← + match ← Strata.pyTranslateLaurel v[0] dispatchModules pyspecModules (specDir := specDir) |>.toBaseIO with + | .ok r => pure r + | .error msg => exitFailure msg + IO.print coreProgram + +def pyAnalyzeLaurelToGotoCommand : Command where + name := "pyAnalyzeLaurelToGoto" + args := [ "file" ] + flags := [{ name := "pyspec", + help := "PySpec module name (e.g., servicelib.Storage).", + takesArg := .repeat "module" }, + { name := "dispatch", + help := "Dispatch module name (e.g., servicelib).", + takesArg := .repeat "module" }, + { name := "spec-dir", + help := "Directory containing compiled PySpec Ion files.", + takesArg := .arg "dir" }] + help := "Translate a Strata Python Ion file through Laurel to CProver GOTO JSON files." + callback := fun v pflags => do + let filePath := v[0] + let dispatchModules := pflags.getRepeated "dispatch" + let pyspecModules := pflags.getRepeated "pyspec" + let specDir := pflags.getString "spec-dir" |>.getD "." + unless ← System.FilePath.isDir specDir do + exitFailure s!"spec-dir '{specDir}' does not exist or is not a directory" + let (coreProgram, laurelTranslateErrors) ← + match ← Strata.pyTranslateLaurel filePath dispatchModules pyspecModules (specDir := specDir) |>.toBaseIO with + | .ok r => pure r + | .error msg => exitFailure msg + let sourceText := (← tryReadPythonSource filePath).map (·.2) + let baseName := deriveBaseName filePath + match ← Strata.inlineCoreToGotoFiles coreProgram baseName sourceText + (factory := Strata.Python.PythonFactory) |>.toBaseIO with + | .ok () => pure () + | .error msg => exitFailure msg + +def javaGenCommand : Command where + name := "javaGen" + args := [ "dialect", "package", "output-dir" ] + flags := [includeFlag] + help := "Generate Java source files from a DDM dialect definition. Accepts a dialect name (e.g. Laurel) or a dialect file path." + callback := fun v pflags => do + let fm ← pflags.buildDialectFileMap + let ld ← fm.getLoaded + let d ← if mem : v[0] ∈ ld.dialects then + pure ld.dialects[v[0]] + else + match ← Strata.readStrataFile fm v[0] with + | .dialect d => pure d + | .program _ => exitFailure "Expected a dialect file, not a program file." + match Strata.Java.generateDialect d v[1] with + | .ok files => + Strata.Java.writeJavaFiles v[2] v[1] files + IO.println s!"Generated Java files for {d.name} in {v[2]}/{Strata.Java.packageToPath v[1]}" + | .error msg => + exitFailure s!"Error generating Java: {msg}" + +def laurelAnalyzeBinaryCommand : Command where + name := "laurelAnalyzeBinary" + args := [] + flags := laurelVerifyOptionsFlags + help := "Verify Laurel Ion programs read from stdin and print diagnostics. Combines multiple input files." + callback := fun _ pflags => do + let options ← parseLaurelVerifyOptions pflags + let stdinBytes ← (← IO.getStdin).readBinToEnd + let combinedProgram ← Strata.readLaurelIonProgram stdinBytes + let diagnostics ← Strata.Laurel.verifyToDiagnosticModels combinedProgram options + + IO.println s!"==== DIAGNOSTICS ====" + for diag in diagnostics do + IO.println s!"{Std.format diag.fileRange.file}:{diag.fileRange.range.start}-{diag.fileRange.range.stop}: {diag.message}" + +def pySpecToLaurelCommand : Command where + name := "pySpecToLaurel" + args := [ "python_path", "strata_path" ] + help := "Translate a PySpec Ion file to Laurel declarations. The Ion file must already exist." + callback := fun v _ => do + let pythonFile : System.FilePath := v[0] + let strataDir : System.FilePath := v[1] + let some mod := pythonFile.fileStem + | exitFailure s!"No stem {pythonFile}" + let .ok mod := Strata.Python.Specs.ModuleName.ofString mod + | exitFailure s!"Invalid module {mod}" + let ionFile := strataDir / mod.strataFileName + let sigs ← + match ← Strata.Python.Specs.readDDM ionFile |>.toBaseIO with + | .ok t => pure t + | .error msg => exitFailure s!"Could not read {ionFile}: {msg}" + let result := Strata.Python.Specs.ToLaurel.signaturesToLaurel pythonFile sigs "" + if result.errors.size > 0 then + IO.eprintln s!"{result.errors.size} translation warning(s):" + for err in result.errors do + IO.eprintln s!" {err.file}: {err.message}" + let pgm := result.program + IO.println s!"Laurel: {pgm.staticProcedures.length} procedure(s), {pgm.types.length} type(s)" + IO.println s!"Overloads: {result.overloads.size} function(s)" + for td in pgm.types do + IO.println s!" {Strata.Laurel.formatTypeDefinition td}" + for proc in pgm.staticProcedures do + IO.println s!" {Strata.Laurel.formatProcedure proc}" + +def pyResolveOverloadsCommand : Command where + name := "pyResolveOverloads" + args := [ "python_path", "dispatch_ion" ] + help := "Identify which overloaded service modules a \ + Python program uses. Prints one module name per \ + line to stdout." + callback := fun v _ => do + let pythonFile : System.FilePath := v[0] + let dispatchPath := v[1] + -- Read dispatch overload table + let overloads ← + match ← readDispatchOverloads #[dispatchPath] |>.toBaseIO with + | .ok (r, _) => pure r + | .error msg => exitFailure msg + -- Convert .py to Python AST + let stmts ← + IO.FS.withTempFile fun _handle dialectFile => do + IO.FS.writeBinFile dialectFile + Strata.Python.Python.toIon + match ← Strata.Python.pythonToStrata dialectFile pythonFile |>.toBaseIO with + | .ok s => pure s + | .error msg => exitFailure msg + -- Walk AST and collect modules + let state := + Strata.Python.Specs.IdentifyOverloads.resolveOverloads + overloads stmts + for w in state.warnings do + IO.eprintln s!"warning: {w}" + let sorted := state.modules.toArray.qsort (· < ·) + for m in sorted do + IO.println m + +def laurelParseCommand : Command where + name := "laurelParse" + args := [ "file" ] + help := "Parse a Laurel source file (no verification)." + callback := fun v _ => do + let _ ← Strata.readLaurelTextFile v[0] + IO.println "Parse successful" + +def laurelAnalyzeCommand : Command where + name := "laurelAnalyze" + args := [ "file" ] + flags := laurelVerifyOptionsFlags + help := "Analyze a Laurel source file. Write diagnostics to stdout." + callback := fun v pflags => do + let options ← parseLaurelVerifyOptions pflags + let laurelProgram ← Strata.readLaurelTextFile v[0] + let (vcResultsOption, errors) ← Strata.Laurel.verifyToVcResults laurelProgram options + if !errors.isEmpty then + IO.println s!"==== ERRORS ====" + for err in errors do + IO.println s!"{err.message}" + match vcResultsOption with + | none => return + | some vcResults => + IO.println s!"==== RESULTS ====" + for vc in vcResults do + IO.println s!"{vc.obligation.label}: {match vc.outcome with | .ok o => repr o | .error e => toString e}" + +def laurelAnalyzeToGotoCommand : Command where + name := "laurelAnalyzeToGoto" + args := [ "file" ] + help := "Translate a Laurel source file to CProver GOTO JSON files." + callback := fun v _ => do + let path : System.FilePath := v[0] + let content ← IO.FS.readFile path + let laurelProgram ← Strata.parseLaurelText path content + match ← Strata.Laurel.translate {} laurelProgram with + | (none, diags) => exitFailure s!"Core translation errors: {diags.map (·.message)}" + | (some coreProgram, errors) => + let Ctx := { Lambda.LContext.default with functions := Core.Factory, knownTypes := Core.KnownTypes } + let Env := Lambda.TEnv.default + let (tcPgm, _) ← match Core.Program.typeCheck Ctx Env coreProgram with + | .ok r => pure r + | .error e => exitInternalError s!"{e.format none}" + let procs := tcPgm.decls.filterMap fun d => d.getProc? + let funcs := tcPgm.decls.filterMap fun d => + match d.getFunc? with + | some f => + let name := Core.CoreIdent.toPretty f.name + if f.body.isSome && f.typeArgs.isEmpty + && name != "Int.DivT" && name != "Int.ModT" + then some f else none + | none => none + if procs.isEmpty && funcs.isEmpty then exitInternalError "No procedures or functions found" + let baseName := deriveBaseName path.toString + let typeSyms ← match collectExtraSymbols tcPgm with + | .ok s => pure s + | .error e => exitInternalError s!"{e}" + let typeSymsJson := Lean.toJson typeSyms + let sourceText := some content + let axioms := tcPgm.decls.filterMap fun d => d.getAxiom? + let distincts := tcPgm.decls.filterMap fun d => match d with + | .distinct name es _ => some (name, es) | _ => none + let mut symtabPairs : List (String × Lean.Json) := [] + let mut gotoFns : Array Lean.Json := #[] + let mut allLiftedFuncs : List Core.Function := [] + for p in procs do + let procName := Core.CoreIdent.toPretty p.header.name + match procedureToGotoCtx Env p (sourceText := sourceText) (axioms := axioms) (distincts := distincts) + with + | .error e => exitInternalError s!"{e}" + | .ok (ctx, liftedFuncs) => + allLiftedFuncs := allLiftedFuncs ++ liftedFuncs + let json ← IO.ofExcept (CoreToGOTO.CProverGOTO.Context.toJson procName ctx) + match json.symtab with + | .obj m => symtabPairs := symtabPairs ++ m.toList + | _ => pure () + match json.goto with + | .obj m => + match m.toList.find? (·.1 == "functions") with + | some (_, .arr fns) => gotoFns := gotoFns ++ fns + | _ => pure () + | _ => pure () + for f in funcs ++ allLiftedFuncs do + let funcName := Core.CoreIdent.toPretty f.name + match functionToGotoCtx Env f with + | .error e => exitInternalError s!"{e}" + | .ok ctx => + let json ← IO.ofExcept (CoreToGOTO.CProverGOTO.Context.toJson funcName ctx) + match json.symtab with + | .obj m => symtabPairs := symtabPairs ++ m.toList + | _ => pure () + match json.goto with + | .obj m => + match m.toList.find? (·.1 == "functions") with + | some (_, .arr fns) => gotoFns := gotoFns ++ fns + | _ => pure () + | _ => pure () + match typeSymsJson with + | .obj m => symtabPairs := symtabPairs ++ m.toList + | _ => pure () + -- Deduplicate: keep first occurrence of each symbol name (proper function + -- symbols come before basic symbol references from callers) + let mut seen : Std.HashSet String := {} + let mut dedupPairs : List (String × Lean.Json) := [] + for (k, v) in symtabPairs do + if !seen.contains k then + seen := seen.insert k + dedupPairs := dedupPairs ++ [(k, v)] + -- Add CBMC default symbols (architecture constants, builtins) + -- and wrap in {"symbolTable": ...} for symtab2gb + let symtabObj := dedupPairs.foldl + (fun (acc : Std.TreeMap.Raw String Lean.Json) (k, v) => acc.insert k v) + .empty + let symtab := CProverGOTO.wrapSymtab symtabObj (moduleName := baseName) + let goto := Lean.Json.mkObj [("functions", Lean.Json.arr gotoFns)] + let symTabFile := s!"{baseName}.symtab.json" + let gotoFile := s!"{baseName}.goto.json" + writeJsonFile symTabFile symtab + writeJsonFile gotoFile goto + IO.println s!"Written {symTabFile} and {gotoFile}" + +def laurelPrintCommand : Command where + name := "laurelPrint" + args := [] + help := "Read Laurel Ion from stdin and print in concrete syntax to stdout." + callback := fun _ _ => do + let stdinBytes ← (← IO.getStdin).readBinToEnd + let strataFiles ← Strata.readLaurelIonFiles stdinBytes + for strataFile in strataFiles do + IO.println s!"// File: {strataFile.filePath}" + let p := strataFile.program + let c := p.formatContext {} + let s := p.formatState + let fmt := p.commands.foldl (init := f!"") fun f cmd => + f ++ (Strata.mformat cmd c s).format + IO.println (fmt.pretty 100) + IO.println "" + +def prettyPrintCore (p : Core.Program) : String := + let decls := p.decls.map fun d => + let s := toString (Std.format d) + -- Add newlines after major sections in procedures + s.replace "preconditions:" "\n preconditions:" + |>.replace "postconditions:" "\n postconditions:" + |>.replace "body:" "\n body:\n " + |>.replace "assert [" "\n assert [" + |>.replace "init (" "\n init (" + |>.replace "while (" "\n while (" + |>.replace "if (" "\n if (" + |>.replace "call [" "\n call [" + |>.replace "else{" "\n else {" + |>.replace "}}" "}\n }" + String.intercalate "\n" decls + +def laurelToCoreCommand : Command where + name := "laurelToCore" + args := [ "file" ] + help := "Translate a Laurel source file to Core and print to stdout." + callback := fun v _ => do + let laurelProgram ← Strata.readLaurelTextFile v[0] + let (coreProgramOption, errors) ← Strata.Laurel.translate {} laurelProgram + if !errors.isEmpty then + IO.println s!"Core translation errors: {errors.map (·.message)}" + match coreProgramOption with + | none => return + | some coreProgram => IO.println (prettyPrintCore coreProgram) + +/-- Print a string word-wrapped to `width` columns with `indent` spaces of indentation. -/ +private def printIndented (indent : Nat) (s : String) (width : Nat := 80) : IO Unit := do + let pad := "".pushn ' ' indent + let words := s.splitOn " " |>.filter (!·.isEmpty) + let mut line := pad + let mut first := true + for word in words do + if first then + line := line ++ word + first := false + else if line.length + 1 + word.length > width then + IO.println line + line := pad ++ word + else + line := line ++ " " ++ word + unless line.length ≤ indent do + IO.println line + +structure CommandGroup where + name : String + commands : List Command + commonFlags : List Flag := [] + +private def validPasses := + "inlineProcedures, loopElim, callElim, filterProcedures, removeIrrelevantAxioms" + +/-- A single transform pass together with the `--procedures`/`--functions` + that were specified immediately after it on the command line. -/ +private structure PassConfig where + name : String + procedures : List String := [] + functions : List String := [] +deriving Inhabited + +/-- Walk the ordered flag entries and bind each `--procedures`/`--functions` + to the most recent `--pass`. -/ +private def buildPassConfigs (entries : Array (String × Option String)) + : IO (Array PassConfig) := do + let mut configs : Array PassConfig := #[] + for (flag, value) in entries do + match flag with + | "pass" => configs := configs.push { name := value.getD "" } + | "procedures" => + let some cur := configs.back? | exitFailure "--procedures must appear after a --pass" + let procs := (value.getD "").splitToList (· == ',') + configs := configs.pop.push { cur with procedures := cur.procedures ++ procs } + | "functions" => + let some cur := configs.back? | exitFailure "--functions must appear after a --pass" + let fns := (value.getD "").splitToList (· == ',') + configs := configs.pop.push { cur with functions := cur.functions ++ fns } + | _ => pure () + return configs + +def transformCommand : Command where + name := "transform" + args := [ "file" ] + flags := [ + { name := "pass", + help := s!"Transform pass to apply (repeatable, applied left to right). \ + Valid passes: {validPasses}. \ + --procedures and --functions after a --pass apply to that pass.", + takesArg := .repeat "name" }, + { name := "procedures", + help := "Comma-separated procedure names for the preceding --pass. \ + For filterProcedures: procedures to keep. \ + For inlineProcedures: procedures to inline.", + takesArg := .repeat "procs" }, + { name := "functions", + help := "Comma-separated function names for the preceding --pass (used by removeIrrelevantAxioms).", + takesArg := .repeat "funcs" }] + help := "Apply one or more transforms to a Core program and print the result." + callback := fun v pflags => do + let file := v[0] + let passConfigs ← buildPassConfigs pflags.entries + if passConfigs.isEmpty then + exitFailure s!"No --pass specified. Valid passes: {validPasses}." + -- Read and parse the Core program + let (pgm, _) ← match ← readStrataProgram file with + | .ok r => pure r + | .error msgs => + for e in msgs do println! s!"Error: {← e.toString}" + exitFailure s!"{msgs.size} parse error(s)" + match Strata.genericToCore pgm with + | .error msg => + exitFailure msg + | .ok initProgram => + -- Validate and convert pass configs to TransformPass values + let mut passes : List Strata.Core.TransformPass := [] + for pc in passConfigs do + match pc.name with + | "inlineProcedures" => + let opts : Core.InlineTransformOptions := + if pc.procedures.isEmpty then {} + else { doInline := (fun _caller callee _ => callee ∈ pc.procedures) } + passes := passes ++ [.inlineProcedures opts] + | "loopElim" => + passes := passes ++ [.loopElim] + | "callElim" => + passes := passes ++ [.callElim] + | "filterProcedures" => + if pc.procedures.isEmpty then + exitFailure "filterProcedures requires --procedures" + passes := passes ++ [.filterProcedures pc.procedures] + | "removeIrrelevantAxioms" => + if pc.functions.isEmpty then + exitFailure "removeIrrelevantAxioms requires --functions" + passes := passes ++ [.removeIrrelevantAxioms pc.functions] + | other => + exitFailure s!"Unknown pass '{other}'. Valid passes: {validPasses}." + -- Run all passes in a single CoreTransformM chain so fresh variable + -- counters accumulate and cached analyses are reused across passes. + match Strata.Core.runTransforms initProgram passes with + | .ok program => IO.print (Core.formatProgram program) + | .error e => exitFailure s!"Transform failed: {e}" + +def verifyCommand : Command where + name := "verify" + args := [ "file" ] + flags := verifyOptionsFlags ++ [ + { name := "check", help := "Process up until SMT generation, but don't solve." }, + { name := "type-check", help := "Exit after semantic dialect's type inference/checking." }, + { name := "parse-only", help := "Exit after DDM parsing and type checking." }, + { name := "output-format", help := "Output format (only 'sarif' supported).", takesArg := .arg "format" }, + { name := "procedures", help := "Verify only the specified procedures (comma-separated).", takesArg := .arg "procs" }] + help := "Verify a Strata program file (.core.st, .csimp.st, or .b3.st)." + callback := fun v pflags => do + let file := v[0] + let proceduresToVerify := pflags.getString "procedures" |>.map (·.splitToList (· == ',')) + let opts ← parseVerifyOptions pflags { VerifyOptions.default with verbose := .quiet } + let opts := { opts with + checkOnly := pflags.getBool "check", + typeCheckOnly := pflags.getBool "type-check", + parseOnly := pflags.getBool "parse-only", + outputSarif := opts.outputSarif || pflags.getString "output-format" == some "sarif" } + let (pgm, inputCtx) ← match ← readStrataProgram file with + | .ok r => pure r + | .error errors => + for e in errors do + let msg ← e.toString + println! s!"Error: {msg}" + println! f!"Finished with {errors.size} errors." + IO.Process.exit ExitCode.userError + println! s!"Successfully parsed." + if opts.parseOnly then return + if opts.typeCheckOnly then + let ans := if file.endsWith ".csimp.st" then + C_Simp.typeCheck pgm opts + else if pgm.dialect == "Boole" then + Boole.typeCheck pgm opts + else + typeCheck inputCtx pgm opts + match ans with + | .error e => + println! f!"{e.formatRange (some inputCtx.fileMap) true} {e.message}" + IO.Process.exit ExitCode.userError + | .ok _ => + println! f!"Program typechecked." + return + -- Full verification + let vcResults ← try + if file.endsWith ".csimp.st" then + C_Simp.verify pgm opts + else if file.endsWith ".b3.st" || file.endsWith ".b3cst.st" then + let ast ← match B3.Verifier.programToB3AST pgm with + | Except.error msg => throw (IO.userError s!"Failed to convert to B3 AST: {msg}") + | Except.ok ast => pure ast + let solver ← B3.Verifier.createInteractiveSolver opts.solver + let reports ← B3.Verifier.programToSMT ast solver + for report in reports do + IO.println s!"\nProcedure: {report.procedureName}" + for (result, _) in report.results do + let marker := if result.result.isError then "✗" else "✓" + let desc := match result.result with + | .error .counterexample => "counterexample found" + | .error .unknown => "unknown" + | .error .refuted => "refuted" + | .success .verified => "verified" + | .success .reachable => "reachable" + | .success .reachabilityUnknown => "reachability unknown" + IO.println s!" {marker} {desc}" + pure #[] + else if pgm.dialect == "Boole" then + Boole.verify opts.solver pgm inputCtx proceduresToVerify opts + else + verify pgm inputCtx proceduresToVerify opts + catch e => + println! f!"{e}" + IO.Process.exit ExitCode.internalError + if opts.outputSarif then + if file.endsWith ".csimp.st" then + println! "SARIF output is not supported for C_Simp files (.csimp.st) because location metadata is not preserved during translation to Core." + else + let uri := Strata.Uri.file file + let files := Map.empty.insert uri inputCtx.fileMap + Core.Sarif.writeSarifOutput opts.checkMode files vcResults (file ++ ".sarif") + for vcResult in vcResults do + let posStr := Imperative.MetaData.formatFileRangeD vcResult.obligation.metadata (some inputCtx.fileMap) + println! f!"{posStr} [{vcResult.obligation.label}]: \ + {vcResult.formatOutcome}" + let success := vcResults.all Core.VCResult.isSuccess + if success && !opts.checkOnly then + println! f!"All {vcResults.size} goals passed." + else if success && opts.checkOnly then + println! f!"Skipping verification." + else + let provedGoalCount := (vcResults.filter Core.VCResult.isSuccess).size + let failedGoalCount := (vcResults.filter Core.VCResult.isNotSuccess).size + -- Encoding failures, solver crashes, or per-check SMT errors (exit 3) + let hasImplError := vcResults.any (fun r => r.isImplementationError || r.hasSMTError) + -- Assertion violations that are not timeouts or internal errors (exit 2) + let hasFailure := vcResults.any (fun r => !r.isSuccess && !r.isTimeout && !r.isImplementationError && !r.hasSMTError) + println! f!"Finished with {provedGoalCount} goals passed, {failedGoalCount} failed." + if hasImplError then + IO.Process.exit ExitCode.internalError + else if hasFailure then + IO.Process.exit ExitCode.failuresFound + +def pyInterpretCommand : Command where + name := "pyInterpret" + args := [ "file" ] + flags := [{ name := "fuel", help := "Maximum execution steps.", takesArg := .arg "n" }] + ++ laurelTranslateFlags + help := "Interpret a Python Ion program concretely (Python → Laurel → Core → execute)." + callback := fun v pflags => do + let filePath := v[0] + let keepDir := pflags.getString "keep-all-files" + let fuel ← match pflags.getString "fuel" with + | some s => match s.toNat? with + | .some n => pure n + | .none => exitFailure s!"Invalid fuel: '{s}'" + | none => pure 10000 + + let (core, _diags) ← + match ← Strata.pythonAndSpecToLaurel filePath (specDir := ".") |>.toBaseIO with + | .ok laurel => + if let some dir := keepDir then + IO.FS.createDirAll dir + IO.FS.writeFile (dir ++ "/laurel.st") (toString (Std.format laurel)) + match ← Strata.translateCombinedLaurel laurel with + | (some core, diags) => pure (core, diags) + | (none, diags) => exitFailure s!"Laurel to Core translation failed: {diags}" + | .error msg => exitFailure (toString msg) + if let some dir := keepDir then + IO.FS.writeFile (dir ++ "/core.st") (toString (Std.format core)) + let core ← match Core.typeCheck Core.VerifyOptions.quiet core + (moreFns := Strata.Python.ReFactory) with + | .ok prog => pure prog + | .error e => + println! s!"Core type checking failed: {e.message}" + IO.Process.exit ExitCode.userError + match core.run with + | .ok E => + let mainProc := Core.Program.Procedure.find? core ⟨"__main__", ()⟩ + let outputNames := match mainProc with + | some p => p.header.outputs.keys.map (·.name) + | none => [] + let (lhs, exprEnv) := Core.Env.genVars outputNames E.exprEnv + let E := { E with exprEnv } + let E := Core.Statement.Command.runCall lhs "__main__" [] fuel E + match E.error with + | none => + IO.println "Execution completed successfully." + | some e => + IO.println s!"{Std.format e}" + IO.Process.exit ExitCode.failuresFound + | .error diag => + IO.eprintln s!"Error: {diag}" + IO.Process.exit ExitCode.failuresFound + +def commandGroups : List CommandGroup := [ + { name := "Core" + commands := [verifyCommand, transformCommand, checkCommand, toIonCommand, printCommand, diffCommand] + commonFlags := [includeFlag] }, + { name := "Code Generation" + commands := [javaGenCommand] }, + { name := "Python" + commands := [pyAnalyzeLaurelCommand, + pyResolveOverloadsCommand, + pySpecsCommand, pySpecToLaurelCommand, + pyAnalyzeLaurelToGotoCommand, + pyAnalyzeToGotoCommand, + pyTranslateLaurelCommand, + pyInterpretCommand] }, + { name := "Laurel" + commands := [laurelAnalyzeCommand, laurelAnalyzeBinaryCommand, + laurelAnalyzeToGotoCommand, laurelParseCommand, + laurelPrintCommand, laurelToCoreCommand] }, +] + +def commandList : List Command := + commandGroups.foldl (init := []) fun acc g => acc ++ g.commands + +def commandMap : Std.HashMap String Command := + commandList.foldl (init := {}) fun m c => m.insert c.name c + +/-- Print a single flag's name and help text at the given indentation. -/ +private def printFlag (indent : Nat) (flag : Flag) : IO Unit := do + let pad := "".pushn ' ' indent + match flag.takesArg with + | .arg argName | .repeat argName => + IO.println s!"{pad}--{flag.name} <{argName}> {flag.help}" + | .none => + IO.println s!"{pad}--{flag.name} {flag.help}" + +/-- Print help for all command groups. -/ +def printGlobalHelp (groups : List CommandGroup := commandGroups) : IO Unit := do + IO.println "Usage: strata [flags]...\n" + IO.println "Command-line utilities for working with Strata.\n" + for group in groups do + IO.println s!"{group.name}:" + for cmd in group.commands do + let cmdLine := cmd.args.foldl (init := cmd.name) fun s a => s!"{s} <{a}>" + IO.println s!" {cmdLine}" + printIndented 4 cmd.help + let perCmdFlags := cmd.flags.filter fun f => + !group.commonFlags.any fun cf => cf.name == f.name + if !perCmdFlags.isEmpty then + IO.println "" + IO.println " Flags:" + for flag in perCmdFlags do + printFlag 6 flag + IO.println "" + if !group.commonFlags.isEmpty then + IO.println " Common flags:" + for flag in group.commonFlags do + printFlag 4 flag + IO.println "" + +/-- Print help for a single command. -/ +def printCommandHelp (cmd : Command) : IO Unit := do + let cmdLine := cmd.args.foldl (init := s!"strata {cmd.name}") fun s a => s!"{s} <{a}>" + let flagSummary := cmd.flags.foldl (init := "") fun s f => + match f.takesArg with + | .arg argName | .repeat argName => s!"{s} [--{f.name} <{argName}>]" + | .none => s!"{s} [--{f.name}]" + IO.println s!"Usage: {cmdLine}{flagSummary}\n" + printIndented 0 cmd.help + if !cmd.flags.isEmpty then + IO.println "\nFlags:" + for flag in cmd.flags do + printFlag 2 flag + +/-- Parse interleaved flags and positional arguments. Returns the collected + positional arguments and parsed flags. -/ +def parseArgs (cmdName : String) + (flagMap : Std.HashMap String Flag) + (acc : Array String) (pflags : ParsedFlags) + (cmdArgs : List String) : IO (Array String × ParsedFlags) := do + match cmdArgs with + | arg :: cmdArgs => + if arg.startsWith "--" then + let raw := (arg.drop 2).toString + -- Support --flag=value syntax by splitting on first '=' + let (flagName, inlineValue) ← match raw.splitOn "=" with + | name :: value :: rest => + if !rest.isEmpty then + exitCmdFailure cmdName s!"Invalid option format: {arg}. Values must not contain '='." + pure (name, some value) + | _ => pure (raw, none) + match flagMap[flagName]? with + | some flag => + match flag.takesArg with + | .none => + parseArgs cmdName flagMap acc (pflags.insert flagName Option.none) cmdArgs + | .arg _ => + match inlineValue with + | some value => + parseArgs cmdName flagMap acc (pflags.insert flagName (some value)) cmdArgs + | none => + let value :: cmdArgs := cmdArgs + | exitCmdFailure cmdName s!"Expected value after {arg}." + parseArgs cmdName flagMap acc (pflags.insert flagName (some value)) cmdArgs + | .repeat _ => + match inlineValue with + | some value => + parseArgs cmdName flagMap acc (pflags.insert flagName (some value)) cmdArgs + | none => + let value :: cmdArgs := cmdArgs + | exitCmdFailure cmdName s!"Expected value after {arg}." + parseArgs cmdName flagMap acc (pflags.insert flagName (some value)) cmdArgs + | none => + exitCmdFailure cmdName s!"Unknown option {arg}." + else + parseArgs cmdName flagMap (acc.push arg) pflags cmdArgs + | [] => + pure (acc, pflags) + +/-- Dispatch CLI arguments against a command map. This is the shared entry point + that both the default executable and downstream custom executables use. -/ +def runCommandMap (map : Std.HashMap String Command) + (groups : List CommandGroup) (args : List String) : IO Unit := do + try do + match args with + | ["--help"] => printGlobalHelp groups + | cmd :: args => + match map[cmd]? with + | none => exitFailure s!"Expected subcommand, got {cmd}." + | some cmd => + -- Handle per-command help before parsing flags. + if args.contains "--help" then + printCommandHelp cmd + return + -- Index the command's flags by name for O(1) lookup during parsing. + let flagMap : Std.HashMap String Flag := + cmd.flags.foldl (init := {}) fun m f => m.insert f.name f + -- Split raw args into positional arguments and parsed flags. + let (args, pflags) ← parseArgs cmd.name flagMap #[] {} args + if p : args.size = cmd.args.length then + cmd.callback ⟨args, p⟩ pflags + else + exitCmdFailure cmd.name s!"{cmd.name} expects {cmd.args.length} argument(s)." + | [] => do + exitFailure "Expected subcommand." + catch e => + exitFailure e.toString diff --git a/lakefile.toml b/lakefile.toml index 5110d270ac..b1b4d644de 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -12,6 +12,9 @@ rev = "bump_to_v4.29.0-rc8" [[lean_lib]] name = "Strata" +[[lean_lib]] +name = "StrataMainLib" + [[lean_exe]] name = "strata" root = "StrataMain" From 7c3a3f0c99e7b69143d5e965cbe41815a53c9ade Mon Sep 17 00:00:00 2001 From: Michael Tautschnig Date: Tue, 19 May 2026 10:46:47 +0200 Subject: [PATCH 11/28] Add resolution diagnostic for multi-output procedure in expression position (#1116) When a StaticCall to a multi-output procedure appears in expression position (not as the RHS of an Assign), emit an error diagnostic: the extra outputs would be silently discarded, which is a semantic bug (e.g., error channels lost). The diagnostic is suppressed when the call is the direct RHS of an assignment (where the target count check already validates arity). Includes a test in ResolutionKindTests demonstrating the diagnostic. By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: Kiro --- Strata/Languages/Laurel/Resolution.lean | 36 +++++++++++++++++++ .../Languages/Laurel/ResolutionKindTests.lean | 13 +++++++ 2 files changed, 49 insertions(+) diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index 16bcf1333f..71c1510d91 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -213,6 +213,10 @@ structure ResolveState where /-- When resolving inside an instance procedure, the owning composite type name. Used by `resolveFieldRef` to resolve `self.field` when `self` has type `Any`. -/ instanceTypeName : Option String := none + /-- True when resolving inside an expression where the value is used (e.g., as an + argument to another call or operator). Multi-output calls are only diagnosed + in value context, not in statement position or direct assignment RHS. -/ + inValueContext : Bool := false @[expose] abbrev ResolveM := StateM ResolveState @@ -358,7 +362,10 @@ def resolveStmtExpr (exprMd : StmtExprMd) : ResolveM StmtExprMd := do | AstNode.mk expr source => let val' ← match _: expr with | .IfThenElse cond thenBr elseBr => + let saved := (← get).inValueContext + modify fun s => { s with inValueContext := true } let cond' ← resolveStmtExpr cond + modify fun s => { s with inValueContext := saved } let thenBr' ← resolveStmtExpr thenBr let elseBr' ← elseBr.attach.mapM (fun a => have := a.property; resolveStmtExpr a.val) pure (.IfThenElse cond' thenBr' elseBr') @@ -367,7 +374,10 @@ def resolveStmtExpr (exprMd : StmtExprMd) : ResolveM StmtExprMd := do let stmts' ← stmts.mapM resolveStmtExpr pure (.Block stmts' label) | .While cond invs dec body => + let saved := (← get).inValueContext + modify fun s => { s with inValueContext := true } let cond' ← resolveStmtExpr cond + modify fun s => { s with inValueContext := saved } let invs' ← invs.attach.mapM (fun a => have := a.property; resolveStmtExpr a.val) let dec' ← dec.attach.mapM (fun a => have := a.property; resolveStmtExpr a.val) let body' ← resolveStmtExpr body @@ -437,10 +447,30 @@ def resolveStmtExpr (exprMd : StmtExprMd) : ResolveM StmtExprMd := do | .StaticCall callee args => let callee' ← resolveRef callee source (expected := #[.parameter, .staticProcedure, .datatypeConstructor, .constant]) + -- Resolve arguments in value context (their results are used as values) + let saved := (← get).inValueContext + modify fun s => { s with inValueContext := true } let args' ← args.mapM resolveStmtExpr + modify fun s => { s with inValueContext := saved } + -- Multi-output procedures must not appear in value context: the extra + -- outputs (e.g. error channels) would be silently discarded. + let s ← get + if s.inValueContext then + let outputCount := match s.scope.get? callee'.text with + | some (_, .staticProcedure proc) => proc.outputs.length + | some (_, .instanceProcedure _ proc) => proc.outputs.length + | _ => 0 + if outputCount > 1 then + let diag := diagnosticFromSource source + s!"Multi-output procedure '{callee'.text}' used in expression position; it returns {outputCount} values but only one can be used here. Use a multi-target assignment instead." + modify fun s => { s with errors := s.errors.push diag } pure (.StaticCall callee' args') | .PrimitiveOp op args => + -- Resolve arguments in value context + let saved := (← get).inValueContext + modify fun s => { s with inValueContext := true } let args' ← args.mapM resolveStmtExpr + modify fun s => { s with inValueContext := saved } pure (.PrimitiveOp op args') | .New ref => let ref' ← resolveRef ref source @@ -482,10 +512,16 @@ def resolveStmtExpr (exprMd : StmtExprMd) : ResolveM StmtExprMd := do let val' ← resolveStmtExpr val pure (.Fresh val') | .Assert ⟨condExpr, summary⟩ => + let saved := (← get).inValueContext + modify fun s => { s with inValueContext := true } let cond' ← resolveStmtExpr condExpr + modify fun s => { s with inValueContext := saved } pure (.Assert { condition := cond', summary }) | .Assume cond => + let saved := (← get).inValueContext + modify fun s => { s with inValueContext := true } let cond' ← resolveStmtExpr cond + modify fun s => { s with inValueContext := saved } pure (.Assume cond') | .ProveBy val proof => let val' ← resolveStmtExpr val diff --git a/StrataTest/Languages/Laurel/ResolutionKindTests.lean b/StrataTest/Languages/Laurel/ResolutionKindTests.lean index acbef556b6..6c58bcd573 100644 --- a/StrataTest/Languages/Laurel/ResolutionKindTests.lean +++ b/StrataTest/Languages/Laurel/ResolutionKindTests.lean @@ -97,4 +97,17 @@ composite Foo extends nat { } #guard_msgs (error, drop all) in #eval testInputWithOffset "ExtendConstrained" extendConstrained 90 processResolution +/-! ## Multi-output procedure used in expression position -/ + +def multiOutputInExpr := r" +procedure multi(x: int) returns (a: int, b: int) opaque; +procedure test() opaque { + assert multi(1) == 1 +// ^^^^^^^^ error: Multi-output procedure 'multi' used in expression position +}; +" + +#guard_msgs (error, drop all) in +#eval testInputWithOffset "MultiOutputInExpr" multiOutputInExpr 100 processResolution + end Laurel From 42fc6e94238e1f18279d4fff8d667dd59c2e866b Mon Sep 17 00:00:00 2001 From: Michael Tautschnig Date: Tue, 19 May 2026 10:47:18 +0200 Subject: [PATCH 12/28] Reject singleton operand lists in leftAssocOp and leftAssocOpBitVec (#1110) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Both helpers' error message already said 'expected at least two arguments', but the destructuring `let a :: as := as | throw ...` only rejected the empty list: a singleton like `.app .add [x]` or `.app .bvadd [x]` silently returned just `x`. This diverged from `Denote.leftAssoc`, which uses `let t₁ :: t₂ :: ts := ts | none` and returns `none` for fewer than two operands. Tighten the pattern to `a :: b :: as := as | throw ...` and seed the `foldl` with `mkApp2 op a b` so the helper's semantics now match the existing error message and `Denote.leftAssoc`. Empty-operand lists continue to throw with the same message as before. This affects every variadic caller: `.app .and`, `.app .or`, `.app .add`, `.app .sub`, `.app .mul`, `.app .div`, `.app .mod`, plus `.app .bvadd`, `.app .bvsub`, `.app .bvmul`, `.app .bvand`, `.app .bvor`, `.app .bvxor`. The Strata Core SMT encoder does not produce singleton applications of any of these ops (ripgrep'd across `SMTEncoder.lean`, `Factory.lean`, and `B3/Verifier/Expression.lean`: every construction passes at least two operands), so well-formed queries are unaffected. Zero-operand placeholders like `Term.app Op.and [] .bool` that appear as "unreachable" fallbacks in `SMTEncoder.lean` were already rejected by `translateTerm` before this change, and remain rejected. Regression tests in StrataTest/DL/SMT/TranslateTests.lean cover: - singleton `.app .add`, `.app .and`, `.app .bvadd`, `.app .bvand` (one per helper+typeclass combination), - empty-operand `.app .add` (unchanged behaviour), - ternary `.app .add` producing `1 + 2 + 3 = 6` (preserves left associativity past the new 2-operand seed). Each singleton-rejection test fails on the previous commit (the term silently translates to its sole operand) and passes here. By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: Kiro Co-authored-by: keyboardDrummer-bot --- Strata/DL/SMT/Translate.lean | 18 ++++-- StrataTest/DL/SMT/TranslateTests.lean | 84 +++++++++++++++++++++++++++ 2 files changed, 97 insertions(+), 5 deletions(-) diff --git a/Strata/DL/SMT/Translate.lean b/Strata/DL/SMT/Translate.lean index c6de9007fa..1b761271b0 100644 --- a/Strata/DL/SMT/Translate.lean +++ b/Strata/DL/SMT/Translate.lean @@ -369,8 +369,12 @@ def translateTerm (t : SMT.Term) : TranslateM (Expr × Expr) := do leftAssocOp mkIntMul as | .app .div as _ => leftAssocOp mkIntDiv as + | .app .mod [x, y] _ => + let (α, x) ← translateTerm x + let (_, y) ← translateTerm y + return (α, mkApp2 mkIntMod x y) | .app .mod as _ => - leftAssocOp mkIntMod as + throw m!"Error: 'mod' expects exactly two operands, got '{as.length}'" | .app .abs [a] _ => let (_, a) ← translateTerm a let c := mkApp2 mkIntLT a (toExpr (0 : Int)) @@ -545,16 +549,20 @@ def translateTerm (t : SMT.Term) : TranslateM (Expr × Expr) := do | t => throw m!"Error: unsupported term '{repr t}'" where leftAssocOp (op : Expr) (as : List SMT.Term) : TranslateM (Expr × Expr) := do - let a :: as := as | throw m!"Error: expected at least two arguments for '{op}', got '{as.length}'" + let a :: b :: as := as + | throw m!"Error: expected at least two arguments for '{op}', got '{as.length}'" let (α, a) ← translateTerm a + let (_, b) ← translateTerm b let as ← as.mapM (translateTerm · >>= pure ∘ Prod.snd) - return (α, as.foldl (mkApp2 op) a) + return (α, as.foldl (mkApp2 op) (mkApp2 op a b)) leftAssocOpBitVec (op : Nat → Expr) (as : List SMT.Term) : TranslateM (Expr × Expr) := do - let a :: as := as | throw m!"Error: expected at least two arguments for BitVec op, got '{as.length}'" + let a :: b :: as := as + | throw m!"Error: expected at least two arguments for BitVec op, got '{as.length}'" let (α, a) ← translateTerm a + let (_, b) ← translateTerm b let op := op (← getBitVecWidth α) let as ← as.mapM (translateTerm · >>= pure ∘ Prod.snd) - return (α, as.foldl (mkApp2 op) a) + return (α, as.foldl (mkApp2 op) (mkApp2 op a b)) /-- Translate assumptions and a conclusion into a right-associated implication diff --git a/StrataTest/DL/SMT/TranslateTests.lean b/StrataTest/DL/SMT/TranslateTests.lean index 43c7c93611..aee007efbc 100644 --- a/StrataTest/DL/SMT/TranslateTests.lean +++ b/StrataTest/DL/SMT/TranslateTests.lean @@ -140,3 +140,87 @@ info: ∀ (α : Type → Type → Type) [inst : ∀ (α_1 α_2 : Type), Nonempty [(.app .str_concat [(.prim (.bool true)), (.prim (.string "hi"))] (.prim .string)), (.prim (.string "hi"))] (.prim .bool)) + +-- `leftAssocOp` and `leftAssocOpBitVec` require at least two operands, +-- matching the existing error message and `Denote.leftAssoc`. Singletons +-- used to silently pass through the first operand; now they throw. + +/-- error: Error: expected at least two arguments for 'HAdd.hAdd', got '1' -/ +#guard_msgs in +#eval + elabQuery {} [] + (.app .eq + [(.app .add [(.prim (.int 0))] (.prim .int)), + (.prim (.int 0))] + (.prim .bool)) + +/-- error: Error: expected at least two arguments for 'And', got '1' -/ +#guard_msgs in +#eval + elabQuery {} [] + (.app .and + [(.app .eq [(.prim (.int 0)), (.prim (.int 0))] (.prim .bool))] + (.prim .bool)) + +/-- error: Error: expected at least two arguments for BitVec op, got '1' -/ +#guard_msgs in +#eval + let a : SMT.TermVar := { id := "a", ty := .prim (.bitvec 8) } + elabQuery {} [] + (.quant .all [a] a + (.app .eq + [(.app .bvadd [(.var a)] (.prim (.bitvec 8))), (.var a)] + (.prim .bool))) + +/-- error: Error: expected at least two arguments for BitVec op, got '1' -/ +#guard_msgs in +#eval + let a : SMT.TermVar := { id := "a", ty := .prim (.bitvec 8) } + elabQuery {} [] + (.quant .all [a] a + (.app .eq + [(.app .bvand [(.var a)] (.prim (.bitvec 8))), (.var a)] + (.prim .bool))) + +-- Empty-operand lists are still rejected, as before. + +/-- error: Error: expected at least two arguments for 'HAdd.hAdd', got '0' -/ +#guard_msgs in +#eval + elabQuery {} [] + (.app .eq [(.app .add [] (.prim .int)), (.prim (.int 0))] (.prim .bool)) + +-- Binary and ternary uses still produce the expected left-associated Expr. + +/-- info: 1 + 2 + 3 = 6 -/ +#guard_msgs in +#eval + elabQuery {} [] + (.app .eq + [(.app .add + [(.prim (.int 1)), (.prim (.int 2)), (.prim (.int 3))] + (.prim .int)), + (.prim (.int 6))] + (.prim .bool)) + +-- `.app .mod` is strictly binary in the SMT-Lib `Ints` theory and in +-- `Denote.denoteTerm`, so `translateTerm` now rejects any other arity rather +-- than silently lowering e.g. `.app .mod [x, y, z]` to `(x % y) % z`. + +/-- info: 10 % 3 = 1 -/ +#guard_msgs in +#eval + elabQuery {} [] + (.app .eq + [(.app .mod [(.prim (.int 10)), (.prim (.int 3))] (.prim .int)), + (.prim (.int 1))] + (.prim .bool)) + +/-- error: Error: 'mod' expects exactly two operands, got '3' -/ +#guard_msgs in +#eval + elabQuery {} [] + (.app .eq + [(.app .mod [(.prim (.int 10)), (.prim (.int 3)), (.prim (.int 2))] (.prim .int)), + (.prim (.int 1))] + (.prim .bool)) From 18878bd066555537af7347bbcbb6448d49e917a1 Mon Sep 17 00:00:00 2001 From: Michael Tautschnig Date: Tue, 19 May 2026 16:22:00 +0200 Subject: [PATCH 13/28] ANFEncoder: iterate to fixpoint to eliminate nested duplicates (#1135) The ANF encoder extracts duplicated subexpressions into fresh variables, but the existing single-pass implementation can leave large duplicated sub-subexpressions behind. Root cause: `removeSubsumed` drops candidate duplicates that are subexpressions of other (larger) candidate duplicates, to avoid creating redundant variable declarations. But this means that if only the outer expression appears at the top level, the inner dupes are hidden inside the lifted var declaration and never extracted. Example (from PyAnalyzeLaurel benchmark check_storage_costs): Original: assert Any_to_bool(Any_get(response, "Datapoints")) ... After partial evaluation, Any_to_bool inlines its 7-branch body, each branch referencing the argument. With Any_get also inlined as an `ite (is-DictStrAny response) (DictStrAny_get ...) (List_get ...)`, the Any_get expression ends up duplicated 62 times inside a single assert. Old ANF output: var $__anf.0 : bool := <9KB body with 62 duplicates of Any_get>; assert $__anf.0 New ANF output (after iteration): var $__anf.3 : Any := Any_get(response, "Datapoints"); var $__anf.0 : bool := ; assert $__anf.0 Effect: VC file size for VCs on one benchmark drops from 32KB to 11KB (~65% reduction), and another benchmark now completes verification at 36s where it previously hit a 60s timeout. By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: Kiro --- Strata/Transform/ANFEncoder.lean | 101 +++++++++++++++++----- StrataTest/Transform/ANFEncoderTests.lean | 33 +++++++ 2 files changed, 112 insertions(+), 22 deletions(-) diff --git a/Strata/Transform/ANFEncoder.lean b/Strata/Transform/ANFEncoder.lean index 39390bb321..6f30267052 100644 --- a/Strata/Transform/ANFEncoder.lean +++ b/Strata/Transform/ANFEncoder.lean @@ -83,8 +83,20 @@ private def findDuplicates (exprs : List Expression.Expr) : List Expression.Expr /-- Replace all occurrences of any target with its corresponding replacement in an expression. Computes hashes bottom-up to avoid redundant traversals. - The map stores (target, replacement) pairs keyed by hash. -/ -def replaceExprs (replacements : Std.HashMap UInt64 (Expression.Expr × Expression.Expr)) + + The map values are lists of (target, replacement) pairs so that distinct + expressions sharing the same `LExpr.hashExpr` do not displace each other + on insertion. On lookup we walk the list with structural `==` to find + the matching target. The expected list length is 1 for typical inputs; + a non-trivial collision only adds the cost of a few extra `==` + comparisons. + + Collision safety is load-bearing for `anfEncodeBody`'s termination + argument: it guarantees that every duplicate found by + `findANFEncoderTargets` is actually rewritten by this function on the + same pass, so no unreplaced duplicate can survive into the next + iteration. -/ +def replaceExprs (replacements : Std.HashMap UInt64 (List (Expression.Expr × Expression.Expr))) (e : Expression.Expr) : Expression.Expr := (go e).2 where @@ -121,11 +133,15 @@ where let e' : Expression.Expr := .quant m k name ty tr' body' let kh : UInt64 := match k with | .all => 0 | .exist => 1 check (LExpr.hashQuantExpr kh (hash name) (LExpr.hashOptTy ty) htr hbody) e' - /-- Check if the hash matches a replacement target. -/ + /-- Check if the hash matches a replacement target. Walks the list of + pairs at this hash bucket and uses structural `==` to find the target, + so collisions never silently drop or misroute a replacement. -/ check (h : UInt64) (e : Expression.Expr) : UInt64 × Expression.Expr := match replacements[h]? with - | some (target, replacement) => - if e == target then (h, replacement) else (h, e) + | some pairs => + match pairs.find? (fun (t, _) => e == t) with + | some (_, replacement) => (h, replacement) + | none => (h, e) | none => (h, e) /-- Collect all subexpression hashes from an expression, @@ -190,26 +206,67 @@ private def findANFEncoderTargets (exprs : List Expression.Expr) : /-- Deduplicate a procedure's body by extracting common subexpressions into `var` declarations prepended to the body. Returns the modified body and the next available dedup index. + Assumes single-assignment (SSA-like) property of the post-PE Core IR: variables are assigned only once, so structurally equal expressions - always denote the same value within a procedure body. -/ + always denote the same value within a procedure body. + + Iterates to a fixpoint: a single pass cannot extract everything because + `removeSubsumed` deliberately drops duplicate subexpressions that are + contained in other (larger) duplicate expressions, to avoid creating + redundant `var` declarations. After the larger duplicate is lifted into + its own var declaration, those previously-subsumed inner duplicates + appear once in the new var-decl init and possibly again elsewhere in the + body, at which point the next iteration can extract them. + + Termination. Let `S(body)` be the set of distinct non-leaf, no-bvar + subexpressions of `body`. Then: + * `findANFEncoderTargets body ⊆ S(body)` and `S(body)` is finite. + * Each iteration replaces every occurrence of every target with a + fresh `fvar`. Fresh `fvar`s are leaves and are filtered out of all + future `S(...)` (via `!e.isLeaf`). + * Each new var-decl init is one of the just-extracted targets, which + was already in `S(body)`, so `S(newBody) ⊆ S(body)`. + * After extraction, every extracted target appears at most once in the + new body (in its own var-decl init), so it is no longer in + `findANFEncoderTargets newBody`. + Hence the iteration count is bounded by `|S(initial body)|`, which is in + turn bounded by the total expression size of the body. We pass that + bound as `fuel` so the recursion is structurally decreasing. -/ def anfEncodeBody (body : Statements) (startIdx : Nat) : Statements × Nat := - let targets := findANFEncoderTargets ((Statements.collectExprs body).flatMap collectSubexprs) - -- Build all var declarations and the replacement map - let (revDecls, replacements, nextIdx) := targets.foldl (fun (decls, repMap, idx) dup => - let freshName : CoreIdent := ⟨s!"{anfVarPrefix}{idx}", ()⟩ - let freshTy := dup.typeOf - let freshVar : Expression.Expr := .fvar () freshName freshTy - let ty : Expression.Ty := match freshTy with - | some mty => LTy.forAll [] mty - | none => LTy.forAll ["α"] (.ftvar "α") - let varDecl := Statement.init freshName ty (.det dup) .empty - let h := LExpr.hashExpr dup - (varDecl :: decls, repMap.insert h (dup, freshVar), idx + 1) - ) ([], ({} : Std.HashMap UInt64 (Expression.Expr × Expression.Expr)), startIdx) - -- Single pass: replace all targets at once - let body' := Statements.mapExprs (replaceExprs replacements) body - (revDecls.reverse ++ body', nextIdx) + let fuel := (Statements.collectExprs body).foldl (fun acc e => acc + LExpr.size _ e) 0 + go fuel body startIdx +where + go (fuel : Nat) (body : Statements) (startIdx : Nat) : Statements × Nat := + match fuel with + | 0 => (body, startIdx) + | fuel' + 1 => + let targets := findANFEncoderTargets ((Statements.collectExprs body).flatMap collectSubexprs) + if targets.isEmpty then + (body, startIdx) + else + -- Build all var declarations and the replacement map. The map value + -- is a list of (target, replacement) pairs to be collision-safe under + -- `LExpr.hashExpr`; see `replaceExprs` above. + let (revDecls, replacements, nextIdx) := targets.foldl (fun (decls, repMap, idx) dup => + let freshName : CoreIdent := ⟨s!"{anfVarPrefix}{idx}", ()⟩ + let freshTy := dup.typeOf + let freshVar : Expression.Expr := .fvar () freshName freshTy + let ty : Expression.Ty := match freshTy with + | some mty => LTy.forAll [] mty + | none => LTy.forAll ["α"] (.ftvar "α") + let varDecl := Statement.init freshName ty (.det dup) .empty + let h := LExpr.hashExpr dup + let pairs := repMap.getD h [] + (varDecl :: decls, repMap.insert h ((dup, freshVar) :: pairs), idx + 1) + ) ([], ({} : Std.HashMap UInt64 (List (Expression.Expr × Expression.Expr))), startIdx) + -- Replace all targets at once in the original body. + let body' := Statements.mapExprs (replaceExprs replacements) body + let newBody := revDecls.reverse ++ body' + -- Iterate: the newly-prepended var declarations may themselves + -- contain duplicated subexpressions that `removeSubsumed` dropped in + -- this pass. + go fuel' newBody nextIdx /-- Deduplicate all procedures in a program. Returns the modified program and whether any changes were made. -/ diff --git a/StrataTest/Transform/ANFEncoderTests.lean b/StrataTest/Transform/ANFEncoderTests.lean index 835b8230af..f40337acb8 100644 --- a/StrataTest/Transform/ANFEncoderTests.lean +++ b/StrataTest/Transform/ANFEncoderTests.lean @@ -138,4 +138,37 @@ procedure test (x : int, y : int) #guard_msgs in #eval IO.println (toString (anfEncodeProgram (translateCore uniqueSubexprProg)).2) +/-! ## Multi-pass: outer subsumes inner duplicate -/ + +-- `(x + 1) * 2` and `x + 1` are both duplicated, but `x + 1` is a subexpression +-- of `(x + 1) * 2` and so is dropped by `removeSubsumed` in pass 1. After pass +-- 1 lifts `(x + 1) * 2` into a var declaration, `x + 1` appears once in that +-- var-decl init AND once in the third assert, exposing a fresh duplicate that +-- pass 2 then extracts. Without fixpoint iteration the third assert would +-- still hold a free `(x + 1)` that duplicates the var-decl's init. +private def nestedDupProg := +#strata +program Core; +procedure test(x : int) { + assert ((x + 1) * 2 > 0); + assert ((x + 1) * 2 < 100); + assert (x + 1 > 50); +}; +#end + +/-- +info: program Core; + +procedure test (x : int) +{ + var $__anf.1 : int := x + 1; + var $__anf.0 : int := $__anf.1 * 2; + assert [assert_0]: $__anf.0 > 0; + assert [assert_1]: $__anf.0 < 100; + assert [assert_2]: $__anf.1 > 50; +}; +-/ +#guard_msgs in +#eval IO.println (toString (anfEncodeProgram (translateCore nestedDupProg)).2) + end Core.ANFEncoder.Tests From 53a3df5345ba8c09e5c1443b609f09369a556335 Mon Sep 17 00:00:00 2001 From: Michael Tautschnig Date: Tue, 19 May 2026 16:51:36 +0200 Subject: [PATCH 14/28] ci: extract install-cvc5, install-z3, restore-lake-cache into composite actions (#1137) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The same ~15-line blocks for installing cvc5, installing z3, and restoring the lake cache were duplicated across ci.yml's three jobs (build_and_test_lean, check_pending_python, build_python), cbmc.yml, and python-fuzz.yml. Robin asked for this to be consolidated as part of the #984 review (flagged non-blocking there, handled here). Introduce three composite actions under .github/actions/: - install-cvc5: downloads the static cvc5 release zip, makes the binary available either on $GITHUB_PATH ('path', default) or in /usr/local/bin ('system'). Version defaults to 1.2.1. - install-z3: same shape for z3, version defaults to 4.15.2. This fixes a latent bug: cbmc.yml and build_and_test_lean used different aarch64 archive names ('arm64-glibc-2.34' vs. 'arm64-win'); the consolidated action uses the correct glibc-2.34 one for both. - restore-lake-cache: wraps actions/cache/restore@v5 with the established key pattern lake------ plus the three fallback keys dropping each trailing component. Exposes a 'fail-on-cache-miss' input for jobs that depend on a cache saved for the same SHA by build_and_test_lean. Rewire ci.yml and cbmc.yml to use the new actions: - ci.yml: build_and_test_lean: install-cvc5, install-z3, restore-lake-cache. check_pending_python: install-cvc5 (system), restore-lake-cache (fail-on-cache-miss: true). build_python: install-cvc5 (system), restore-lake-cache (fail-on-cache-miss: true). (The pip-based z3 install here is deliberately left as-is — it is a different install flow.) - cbmc.yml: install-cvc5, install-z3, restore-lake-cache (fail-on-cache-miss: true). Net change: -108 lines of duplicated shell, +17 lines of action usage across the two workflow files, with the reusable definitions ready to be adopted by python-fuzz.yml and any future workflows. actionlint reports no new warnings (the pre-existing save-always warning on cbmc.yml line 22 is unrelated). By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: Kiro --- .github/actions/install-cvc5/action.yml | 52 +++++++++++ .github/actions/install-z3/action.yml | 55 +++++++++++ .github/actions/restore-lake-cache/action.yml | 82 ++++++++++++++++ .github/actions/save-lake-cache/action.yml | 35 +++++++ .github/workflows/cbmc.yml | 40 +------- .github/workflows/ci.yml | 93 ++++--------------- 6 files changed, 245 insertions(+), 112 deletions(-) create mode 100644 .github/actions/install-cvc5/action.yml create mode 100644 .github/actions/install-z3/action.yml create mode 100644 .github/actions/restore-lake-cache/action.yml create mode 100644 .github/actions/save-lake-cache/action.yml diff --git a/.github/actions/install-cvc5/action.yml b/.github/actions/install-cvc5/action.yml new file mode 100644 index 0000000000..3ba8055209 --- /dev/null +++ b/.github/actions/install-cvc5/action.yml @@ -0,0 +1,52 @@ +# Copyright Strata Contributors +# SPDX-License-Identifier: Apache-2.0 OR MIT +name: Install cvc5 +description: > + Download a static cvc5 build and put it on the PATH. Supports both + x86_64 and aarch64 Linux runners. Consolidates the cvc5 install logic + previously duplicated across ci.yml and cbmc.yml; intended to also be + adopted by the python-fuzz workflow once that lands (see + https://github.com/strata-org/Strata/pull/984). + +inputs: + version: + description: cvc5 release tag (e.g. "1.2.1"). + required: false + default: "1.2.1" + install-to: + description: > + Where to make the cvc5 binary available. One of: + "path" (default) — prepend the unpacked bin/ directory to $GITHUB_PATH. + "system" — sudo cp the cvc5 binary into /usr/local/bin/. + required: false + default: "path" + +runs: + using: composite + steps: + - name: Download cvc5 + shell: bash + run: | + set -eu + ARCH=$(uname -m) + case "$ARCH" in + x86_64) ARCH_NAME="x86_64" ;; + aarch64|arm64) ARCH_NAME="arm64" ;; + *) echo "Unsupported architecture: $ARCH" >&2; exit 1 ;; + esac + URL="https://github.com/cvc5/cvc5/releases/download/cvc5-${{ inputs.version }}/cvc5-Linux-${ARCH_NAME}-static.zip" + wget -q "$URL" + unzip -q "cvc5-Linux-${ARCH_NAME}-static.zip" + chmod +x "cvc5-Linux-${ARCH_NAME}-static/bin/cvc5" + case "${{ inputs.install-to }}" in + path) + echo "$GITHUB_WORKSPACE/cvc5-Linux-${ARCH_NAME}-static/bin/" >> "$GITHUB_PATH" + ;; + system) + sudo cp "cvc5-Linux-${ARCH_NAME}-static/bin/cvc5" /usr/local/bin/ + ;; + *) + echo "Unknown install-to value: ${{ inputs.install-to }}" >&2 + exit 2 + ;; + esac diff --git a/.github/actions/install-z3/action.yml b/.github/actions/install-z3/action.yml new file mode 100644 index 0000000000..86d6c52839 --- /dev/null +++ b/.github/actions/install-z3/action.yml @@ -0,0 +1,55 @@ +# Copyright Strata Contributors +# SPDX-License-Identifier: Apache-2.0 OR MIT +name: Install z3 +description: > + Download a z3 release and put it on the PATH. Supports x86_64 and + aarch64 Linux runners. Consolidates the z3 install logic previously + duplicated across ci.yml and cbmc.yml. + +inputs: + version: + description: z3 release tag (e.g. "4.15.2"). + required: false + default: "4.15.2" + install-to: + description: > + Where to make the z3 binary available. One of: + "path" (default) — prepend the unpacked bin/ directory to $GITHUB_PATH. + "system" — sudo cp the z3 binary into /usr/local/bin/. + required: false + default: "path" + +runs: + using: composite + steps: + - name: Download z3 + shell: bash + run: | + set -eu + ARCH=$(uname -m) + case "$ARCH" in + x86_64) + URL="https://github.com/Z3Prover/z3/releases/download/z3-${{ inputs.version }}/z3-${{ inputs.version }}-x64-glibc-2.39.zip" + ARCHIVE_NAME="z3-${{ inputs.version }}-x64-glibc-2.39" + ;; + aarch64|arm64) + URL="https://github.com/Z3Prover/z3/releases/download/z3-${{ inputs.version }}/z3-${{ inputs.version }}-arm64-glibc-2.34.zip" + ARCHIVE_NAME="z3-${{ inputs.version }}-arm64-glibc-2.34" + ;; + *) echo "Unsupported architecture: $ARCH" >&2; exit 1 ;; + esac + wget -q "$URL" + unzip -q "${ARCHIVE_NAME}.zip" + chmod +x "${ARCHIVE_NAME}/bin/z3" + case "${{ inputs.install-to }}" in + path) + echo "$GITHUB_WORKSPACE/${ARCHIVE_NAME}/bin/" >> "$GITHUB_PATH" + ;; + system) + sudo cp "${ARCHIVE_NAME}/bin/z3" /usr/local/bin/ + ;; + *) + echo "Unknown install-to value: ${{ inputs.install-to }}" >&2 + exit 2 + ;; + esac diff --git a/.github/actions/restore-lake-cache/action.yml b/.github/actions/restore-lake-cache/action.yml new file mode 100644 index 0000000000..9151866cfd --- /dev/null +++ b/.github/actions/restore-lake-cache/action.yml @@ -0,0 +1,82 @@ +# Copyright Strata Contributors +# SPDX-License-Identifier: Apache-2.0 OR MIT +name: Restore lake cache +description: > + Thin wrapper around actions/cache/restore@v5 that uses the standard + Strata cache-key pattern: + lake------ + with three fallback keys dropping each trailing component in turn. + Consolidates the ~15-line cache block previously duplicated across + ci.yml's build_and_test_lean, check_pending_python, build_python and + cbmc.yml; intended to also be adopted by the python-fuzz workflow once + that lands (see https://github.com/strata-org/Strata/pull/984). + +inputs: + fail-on-cache-miss: + description: > + If 'true', the step fails when no cache entry matches. Use this in + jobs that depend on a cache saved by an upstream job for the same + SHA (see https://github.com/strata-org/Strata/issues/952). + required: false + default: "false" + path: + description: Cache path(s), newline-separated. + required: false + default: ".lake" + key-prefix: + description: > + Prefix used in the cache key. The action also hashes the + repo-root `lean-toolchain` and `lake-manifest.json`, so changing + only this prefix is appropriate for caches keyed on the same + root-level Lean build (e.g. distinguishing different artifact + names with the same source set). Sub-projects with their own + toolchain/manifest do not currently fit this action and should + not reuse it as-is. + required: false + default: "lake" + use-restore-keys: + description: > + Must be the string `'true'` or `'false'`. + + If `'true'` (default), include three fallback `restore-keys` so + that a near match (same toolchain/manifest/.st files but different + SHA) is used when no exact-SHA cache exists. + + Set to `'false'` for downstream jobs that depend on a cache saved + by an upstream job for the *same* SHA (typically together with + `fail-on-cache-miss: 'true'`); see + https://github.com/strata-org/Strata/issues/952. With fallback + keys present, `fail-on-cache-miss` only triggers when every + fallback also misses, which silently allows stale cross-SHA cache + matches and defeats the safety net. + required: false + default: "true" + +outputs: + cache-hit: + description: Whether a cache entry was restored (see actions/cache/restore@v5). + value: ${{ steps.restore-with-fallback.outputs.cache-hit || steps.restore-exact.outputs.cache-hit }} + +runs: + using: composite + steps: + - name: Restore lake cache (with fallback keys) + id: restore-with-fallback + if: inputs.use-restore-keys != 'false' + uses: actions/cache/restore@v5 + with: + path: ${{ inputs.path }} + key: ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }}-${{ github.sha }} + restore-keys: | + ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }} + ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }} + ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }} + fail-on-cache-miss: ${{ inputs.fail-on-cache-miss }} + - name: Restore lake cache (exact SHA only) + id: restore-exact + if: inputs.use-restore-keys == 'false' + uses: actions/cache/restore@v5 + with: + path: ${{ inputs.path }} + key: ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }}-${{ github.sha }} + fail-on-cache-miss: ${{ inputs.fail-on-cache-miss }} diff --git a/.github/actions/save-lake-cache/action.yml b/.github/actions/save-lake-cache/action.yml new file mode 100644 index 0000000000..5754371b87 --- /dev/null +++ b/.github/actions/save-lake-cache/action.yml @@ -0,0 +1,35 @@ +# Copyright Strata Contributors +# SPDX-License-Identifier: Apache-2.0 OR MIT +name: Save lake cache +description: > + Save the lake build cache using the canonical Strata cache-key pattern. + Companion to `restore-lake-cache`: the two actions share the same key + construction so downstream jobs that consume the saved cache via + `restore-lake-cache` with `use-restore-keys: "false"` will hit it + reliably. + + Use this in workflows that produce a fresh build (typically the + `build_and_test_lean` job in ci.yml) to share the result with + downstream jobs at the same SHA. + +inputs: + path: + description: Cache path(s), newline-separated. + required: false + default: ".lake" + key-prefix: + description: > + Cache-key prefix; must match the `key-prefix` passed to the + companion `restore-lake-cache` action so that the exact-SHA + restore keys line up. + required: false + default: "lake" + +runs: + using: composite + steps: + - name: Save lake cache + uses: actions/cache/save@v5 + with: + path: ${{ inputs.path }} + key: ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }}-${{ github.sha }} diff --git a/.github/workflows/cbmc.yml b/.github/workflows/cbmc.yml index b188473bfe..f4c557045e 100644 --- a/.github/workflows/cbmc.yml +++ b/.github/workflows/cbmc.yml @@ -13,38 +13,9 @@ jobs: - name: Checkout uses: actions/checkout@v6 - name: Install cvc5 - shell: bash - run: | - ARCH=$(uname -m) - if [ "$ARCH" = "x86_64" ]; then - ARCH_NAME="x86_64" - elif [ "$ARCH" = "aarch64" ] || [ "$ARCH" = "arm64" ]; then - ARCH_NAME="arm64" - else - echo "Unsupported architecture: $ARCH" - exit 1 - fi - wget -q https://github.com/cvc5/cvc5/releases/download/cvc5-1.2.1/cvc5-Linux-${ARCH_NAME}-static.zip - unzip -q cvc5-Linux-${ARCH_NAME}-static.zip - chmod +x cvc5-Linux-${ARCH_NAME}-static/bin/cvc5 - echo "$GITHUB_WORKSPACE/cvc5-Linux-${ARCH_NAME}-static/bin/" >> $GITHUB_PATH + uses: ./.github/actions/install-cvc5 - name: Install z3 - shell: bash - run: | - ARCH=$(uname -m) - if [ "$ARCH" = "x86_64" ]; then - wget -q https://github.com/Z3Prover/z3/releases/download/z3-4.15.2/z3-4.15.2-x64-glibc-2.39.zip - ARCHIVE_NAME="z3-4.15.2-x64-glibc-2.39" - elif [ "$ARCH" = "aarch64" ] || [ "$ARCH" = "arm64" ]; then - wget -q https://github.com/Z3Prover/z3/releases/download/z3-4.15.2/z3-4.15.2-arm64-glibc-2.34.zip - ARCHIVE_NAME="z3-4.15.2-arm64-glibc-2.34" - else - echo "Unsupported architecture: $ARCH" - exit 1 - fi - unzip -q "${ARCHIVE_NAME}.zip" - chmod +x "${ARCHIVE_NAME}/bin/z3" - echo "$GITHUB_WORKSPACE/${ARCHIVE_NAME}/bin/" >> $GITHUB_PATH + uses: ./.github/actions/install-z3 - name: Prepare ccache uses: actions/cache@v5 with: @@ -77,11 +48,10 @@ jobs: # The cache is safe to use here because we just saved it for this exact SHA # in the build_and_test_lean job from ci.yml # https://github.com/strata-org/Strata/issues/952 - uses: actions/cache/restore@v5 + uses: ./.github/actions/restore-lake-cache with: - path: .lake - key: lake-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }}-${{ github.sha }} - fail-on-cache-miss: true + fail-on-cache-miss: "true" + use-restore-keys: "false" - name: Build Strata uses: leanprover/lean-action@v1 with: diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index d01fc1ed7c..9772e523dd 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -32,40 +32,9 @@ jobs: - name: Checkout uses: actions/checkout@v6 - name: Install cvc5 - shell: bash - run: | - ARCH=$(uname -m) - if [ "$ARCH" = "x86_64" ]; then - ARCH_NAME="x86_64" - elif [ "$ARCH" = "aarch64" ] || [ "$ARCH" = "arm64" ]; then - ARCH_NAME="arm64" - else - echo "Unsupported architecture: $ARCH" - exit 1 - fi - wget https://github.com/cvc5/cvc5/releases/download/cvc5-1.2.1/cvc5-Linux-${ARCH_NAME}-static.zip - unzip cvc5-Linux-${ARCH_NAME}-static.zip - chmod +x cvc5-Linux-${ARCH_NAME}-static/bin/cvc5 - echo "$GITHUB_WORKSPACE/cvc5-Linux-${ARCH_NAME}-static/bin/" >> $GITHUB_PATH + uses: ./.github/actions/install-cvc5 - name: Install z3 - shell: bash - run: | - ARCH=$(uname -m) - if [ "$ARCH" = "x86_64" ]; then - ARCH_NAME="x86_64" - wget https://github.com/Z3Prover/z3/releases/download/z3-4.15.2/z3-4.15.2-x64-glibc-2.39.zip - ARCHIVE_NAME="z3-4.15.2-x64-glibc-2.39" - elif [ "$ARCH" = "aarch64" ] || [ "$ARCH" = "arm64" ]; then - ARCH_NAME="arm64" - wget https://github.com/Z3Prover/z3/releases/download/z3-4.15.2/z3-4.15.2-arm64-glibc-2.34.zip - ARCHIVE_NAME="z3-4.15.2-arm64-win" - else - echo "Unsupported architecture: $ARCH" - exit 1 - fi - unzip "${ARCHIVE_NAME}.zip" - chmod +x "${ARCHIVE_NAME}/bin/z3" - echo "$GITHUB_WORKSPACE/${ARCHIVE_NAME}/bin/" >> $GITHUB_PATH + uses: ./.github/actions/install-z3 - name: Install .NET uses: actions/setup-dotnet@v5 with: @@ -74,14 +43,7 @@ jobs: # Only use the caches on PRs because there is a risk of stale results: # https://github.com/strata-org/Strata/issues/952 if: github.event_name == 'pull_request' - uses: actions/cache/restore@v5 - with: - path: .lake - key: lake-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }}-${{ github.sha }} - restore-keys: | - lake-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }} - lake-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }} - lake-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }} + uses: ./.github/actions/restore-lake-cache - name: Download ion-java jar for Java codegen test run: wget -q -O StrataTestExtra/DDM/Integration/Java/testdata/ion-java-1.11.11.jar https://github.com/amazon-ion/ion-java/releases/download/v1.11.11/ion-java-1.11.11.jar - name: Build and test Strata @@ -92,10 +54,7 @@ jobs: - name: Run tests (excluding Python) run: lake test -- --exclude Languages.Python - name: Save lake cache - uses: actions/cache/save@v5 - with: - path: .lake - key: lake-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }}-${{ github.sha }} + uses: ./.github/actions/save-lake-cache - name: Verify Java testdata is up to date run: | StrataTestExtra/DDM/Integration/Java/regenerate-testdata.sh @@ -156,26 +115,19 @@ jobs: # The cache is safe to use here because we just saved it for this exact SHA # in the build_and_test_lean job # https://github.com/strata-org/Strata/issues/952 - uses: actions/cache/restore@v5 + uses: ./.github/actions/restore-lake-cache with: - path: .lake - key: lake-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }}-${{ github.sha }} - fail-on-cache-miss: true + fail-on-cache-miss: "true" + use-restore-keys: "false" - name: Install Lean uses: leanprover/lean-action@v1 with: auto-config: false build: false - name: Install cvc5 - shell: bash - run: | - ARCH=$(uname -m) - if [ "$ARCH" = "x86_64" ]; then ARCH_NAME="x86_64" - elif [ "$ARCH" = "aarch64" ] || [ "$ARCH" = "arm64" ]; then ARCH_NAME="arm64" - else echo "Unsupported architecture: $ARCH"; exit 1; fi - wget -q https://github.com/cvc5/cvc5/releases/download/cvc5-1.2.1/cvc5-Linux-${ARCH_NAME}-static.zip - unzip -q cvc5-Linux-${ARCH_NAME}-static.zip - sudo cp cvc5-Linux-${ARCH_NAME}-static/bin/cvc5 /usr/local/bin/ + uses: ./.github/actions/install-cvc5 + with: + install-to: system - name: Check pending tests for newly passing working-directory: StrataTest/Languages/Python shell: bash @@ -271,11 +223,10 @@ jobs: # The cache is safe to use here because we just saved it for this exact SHA # in the build_and_test_lean job from ci.yml # https://github.com/strata-org/Strata/issues/952 - uses: actions/cache/restore@v5 + uses: ./.github/actions/restore-lake-cache with: - path: .lake - key: lake-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }}-${{ github.sha }} - fail-on-cache-miss: true + fail-on-cache-miss: "true" + use-restore-keys: "false" - name: Install Lean (for lake env) uses: leanprover/lean-action@v1 with: @@ -283,21 +234,9 @@ jobs: build: false use-github-cache: false - name: Install cvc5 - shell: bash - run: | - ARCH=$(uname -m) - if [ "$ARCH" = "x86_64" ]; then - ARCH_NAME="x86_64" - elif [ "$ARCH" = "aarch64" ] || [ "$ARCH" = "arm64" ]; then - ARCH_NAME="arm64" - else - echo "Unsupported architecture: $ARCH" - exit 1 - fi - wget https://github.com/cvc5/cvc5/releases/download/cvc5-1.2.1/cvc5-Linux-${ARCH_NAME}-static.zip - unzip cvc5-Linux-${ARCH_NAME}-static.zip - chmod +x cvc5-Linux-${ARCH_NAME}-static/bin/cvc5 - sudo cp cvc5-Linux-${ARCH_NAME}-static/bin/cvc5 /usr/local/bin/ + uses: ./.github/actions/install-cvc5 + with: + install-to: system - name: Install z3 shell: bash run: | From 04d521542d042312ece1f08e74162e52d40da3c3 Mon Sep 17 00:00:00 2001 From: Fabio Madge Date: Tue, 19 May 2026 20:50:14 +0200 Subject: [PATCH 15/28] Core: Sequence bounds preconditions (#1100) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Blocker for Laurel Seq/Array in #1073. ## Bounds preconditions for `Sequence.select` / `update` / `take` / `drop` Following the `Int.SafeDiv` pattern: | Op | Precondition | |---------------------|-------------------------------------| | `Sequence.select` | `0 <= i && i < Sequence.length(s)` | | `Sequence.update` | `0 <= i && i < Sequence.length(s)` | | `Sequence.take` | `0 <= n && n <= Sequence.length(s)` | | `Sequence.drop` | `0 <= n && n <= Sequence.length(s)` | `Sequence.length` / `empty` / `append` / `build` / `contains` remain total. `PrecondElim` picks the obligations up automatically at call sites in imperative code (via `transformStmt`) and in pure positions like `requires` / `ensures` / quantifier bodies / function bodies (via the synthetic `$$wf` procedures). Obligations carry `propertyType = "outOfBoundsAccess"` (new `MetaData` constant, mirroring `divisionByZero`), flow through a new `PropertyType.outOfBoundsAccess` enum variant and the three metadata-to-PropertyType conversion sites, and render as `"out-of-bounds-access"` in SARIF output. ### Incidental fix While wiring the SARIF classification, I noticed `propertyTypeToClassification` in `SarifOutput.lean` was pre-existing dead code: `vcResultToSarifResult` never set `properties.propertyType`, so every obligation defaulted to `"assert"` in SARIF output. This PR wires it up, so `divisionByZero` and `arithmeticOverflow` obligations now also classify correctly in SARIF alongside the new `outOfBoundsAccess`. ## Testing - **`StrataTest/Transform/PrecondElim.lean` Test 10** — `collectPrecondAsserts` attaches `outOfBoundsAccess` metadata for all four partial ops plus a nested `Sequence.select(Sequence.update(...))` call. Mirrors the pattern in `OverflowCheckTest.lean`. Complemented by per-op pretty-print snapshots (`#guard_msgs`) that assert the exact obligation body string — these catch regressions that preserve count and metadata tag but corrupt the obligation body (e.g. passing `.Le` instead of `.Lt` to `mkSeqBoundsPrecond` at a call site, changing the bound-variable name, or swapping the lower/upper bound inside `mkSeqBoundsPrecond`). - **`StrataTest/Languages/Core/Tests/SarifOutputTests.lean`** — property-type classification tests covering all five `PropertyType` variants. Collateral updates to existing tests reflect the new obligations (`Seq.lean`) and updated `requires` on Sequence function signatures (`ProgramEvalTests.lean`). Note: the bounds obligations in `Seq.lean` appear as `true && 0 < length(...)` — the partial evaluator simplifies `0 <= 0` to `true` but does not further simplify `true && X` to `X`. This is a pre-existing evaluator gap, not newly introduced by this PR; the SMT solver discharges the obligation trivially. ## Known downstream impact PR #1073 (Laurel Seq/Array) emits `Sequence.select` / `update` / `take` / `drop` calls from its translation. Its `T18_Sequences` test uses `#guard_msgs(drop info, error)` on a diagnostics-only pipeline, so the test assertions should still pass syntactically — but individual sequence-manipulation programs now require bounds guards to fully verify. PR #1073 has been adjusted accordingly. --- Strata/DL/Imperative/CmdEval.lean | 6 +- Strata/DL/Imperative/EvalContext.lean | 18 ++- Strata/DL/Imperative/MetaData.lean | 3 + Strata/DL/Lambda/IntBoolFactory.lean | 13 +- Strata/Languages/Core/Factory.lean | 61 +++++++- .../Languages/Core/ObligationExtraction.lean | 6 +- Strata/Languages/Core/SarifOutput.lean | 10 +- Strata/Languages/Core/StatementEval.lean | 6 +- Strata/Languages/Core/Verifier.lean | 2 +- Strata/Transform/PrecondElim.lean | 2 + StrataTest/Languages/Core/Examples/Seq.lean | 141 ++++++++++++++++++ .../Core/Tests/ProgramEvalTests.lean | 12 +- .../Core/Tests/SarifOutputTests.lean | 39 ++++- StrataTest/Transform/PrecondElim.lean | 76 ++++++++++ 14 files changed, 359 insertions(+), 36 deletions(-) diff --git a/Strata/DL/Imperative/CmdEval.lean b/Strata/DL/Imperative/CmdEval.lean index 5ee378ef99..c5c99659f2 100644 --- a/Strata/DL/Imperative/CmdEval.lean +++ b/Strata/DL/Imperative/CmdEval.lean @@ -66,11 +66,7 @@ def Cmd.eval [BEq P.Ident] [EC : EvalContext P S] (σ : S) (c : Cmd P) : Cmd P let e := EC.eval σ e let assumptions := EC.getPathConditions σ let c' := .assert label e md - let propType := match md.getPropertyType with - | some s => if s == MetaData.divisionByZero then .divisionByZero - else if s == MetaData.arithmeticOverflow then .arithmeticOverflow - else .assert - | none => .assert + let propType := convertMetaDataPropertyType md match EC.denoteBool e with | some true => -- Proved via evaluation. (c', EC.deferObligation σ (ProofObligation.mk label propType assumptions e md)) diff --git a/Strata/DL/Imperative/EvalContext.lean b/Strata/DL/Imperative/EvalContext.lean index 1f823cb008..941fa3b15f 100644 --- a/Strata/DL/Imperative/EvalContext.lean +++ b/Strata/DL/Imperative/EvalContext.lean @@ -102,12 +102,13 @@ inductive PropertyType where | assert | divisionByZero | arithmeticOverflow + | outOfBoundsAccess deriving Repr, DecidableEq /-- Whether an unreachable path counts as pass for this property type. Assertions pass vacuously when unreachable; covers fail. -/ def PropertyType.passWhenUnreachable : PropertyType → Bool - | .assert | .divisionByZero | .arithmeticOverflow => true + | .assert | .divisionByZero | .arithmeticOverflow | .outOfBoundsAccess => true | .cover => false instance : ToFormat PropertyType where @@ -116,6 +117,21 @@ instance : ToFormat PropertyType where | .assert => "assert" | .divisionByZero => "division by zero check" | .arithmeticOverflow => "arithmetic overflow check" + | .outOfBoundsAccess => "out-of-bounds access check" + +/-- Convert a `MetaData` entry's property-type classification string to the + `PropertyType` enum. Falls back to `.assert` when the metadata carries + no classification or an unrecognized string; callers that emit + propertyType classifications should add a matching arm here. -/ +def convertMetaDataPropertyType {P : PureExpr} [BEq P.Ident] + (md : MetaData P) : PropertyType := + match md.getPropertyType with + | some s => + if s == MetaData.divisionByZero then .divisionByZero + else if s == MetaData.arithmeticOverflow then .arithmeticOverflow + else if s == MetaData.outOfBoundsAccess then .outOfBoundsAccess + else .assert + | none => .assert /-- A proof obligation can be discharged by some backend solver or a dedicated diff --git a/Strata/DL/Imperative/MetaData.lean b/Strata/DL/Imperative/MetaData.lean index f3d3a384d1..28c15c480b 100644 --- a/Strata/DL/Imperative/MetaData.lean +++ b/Strata/DL/Imperative/MetaData.lean @@ -320,6 +320,9 @@ def MetaData.divisionByZero : String := "divisionByZero" /-- Metadata value for arithmetic-overflow property type classification. -/ def MetaData.arithmeticOverflow : String := "arithmeticOverflow" +/-- Metadata value for out-of-bounds-access property type classification. -/ +def MetaData.outOfBoundsAccess : String := "outOfBoundsAccess" + /-- Read the property type classification from metadata, if present. -/ def MetaData.getPropertyType {P : PureExpr} [BEq P.Ident] (md : MetaData P) : Option String := match md.findElem MetaData.propertyType with diff --git a/Strata/DL/Lambda/IntBoolFactory.lean b/Strata/DL/Lambda/IntBoolFactory.lean index a5de45f549..b58a2028ee 100644 --- a/Strata/DL/Lambda/IntBoolFactory.lean +++ b/Strata/DL/Lambda/IntBoolFactory.lean @@ -120,22 +120,27 @@ instance (n : Nat) : LambdaLeanType (.bitvec n) (BitVec n) where These build well-formed `WFLFunc`s that have no `concreteEval` or `body`. -/ -/-- General polymorphic unevaluated function with optional axioms. - Handles any arity and any number of type arguments. -/ +/-- General polymorphic unevaluated function with optional axioms and + preconditions. Handles any arity and any number of type arguments. -/ @[inline] def polyUneval (n : T.Identifier) (typeArgs : List String) (inputs : List (T.Identifier × LMonoTy)) (output : LMonoTy) (axioms : List (LExpr T.mono) := []) + (preconditions : + List (FuncPrecondition (LExpr T.mono) T.Metadata) := []) (h_nodup : List.Nodup (inputs.map (·.1.name)) := by first | decide | grind) (h_ta_nodup : List.Nodup typeArgs := by grind) (h_inputs : ∀ ty, ty ∈ ListMap.values inputs → ty.freeVars ⊆ typeArgs := by first | decide | grind) (h_output : output.freeVars ⊆ typeArgs := by first | decide | grind) + (h_precond : ∀ p, p ∈ preconditions → + (LExpr.freeVars p.expr).map (·.1.name) ⊆ inputs.map (·.1.name) + := by first | decide | grind) (h_ta_no_gen : ∀ ta, ta ∈ typeArgs → ¬ ("$__ty".toList.isPrefixOf ta.toList = true) := by first | decide | grind) : WFLFunc T := ⟨{ name := n, typeArgs := typeArgs, inputs := inputs, output := output, - axioms := axioms }, { + axioms := axioms, preconditions := preconditions }, { arg_nodup := h_nodup body_freevars := by intro b hb; simp at hb concreteEval_argmatch := by intro fn _ _ _ hfn; simp at hfn @@ -144,7 +149,7 @@ def polyUneval (n : T.Identifier) (typeArgs : List String) typeArgs_nodup := h_ta_nodup inputs_typevars_in_typeArgs := h_inputs output_typevars_in_typeArgs := h_output - precond_freevars := by intro p hp; simp at hp + precond_freevars := h_precond typeArgs_no_gen_prefix := h_ta_no_gen }⟩ diff --git a/Strata/Languages/Core/Factory.lean b/Strata/Languages/Core/Factory.lean index 0fedf025c4..67002bf27f 100644 --- a/Strata/Languages/Core/Factory.lean +++ b/Strata/Languages/Core/Factory.lean @@ -499,10 +499,57 @@ def seqAppendFunc : WFLFunc CoreLParams := else #true))] ]) -/- A `Sequence` selection function with type `∀a. Sequence a → int → a`. -/ +/-! ### Sequence bounds preconditions + +`Sequence.select` / `update` / `take` / `drop` carry bounds +preconditions; the other `Sequence.*` ops are total. -/ + +/-- Choice of upper-bound operator in `mkSeqBoundsPrecond`: `Lt` (strict) for + `Sequence.select`/`update`, `Le` (non-strict) for `Sequence.take`/`drop`. + Restricting the parameter to this inductive rather than taking an + arbitrary `WFLFunc` or `LExpr` makes it impossible to attach a partial + operator (which would create a nested precondition obligation) by + accident. -/ +private inductive SeqBoundKind where | Lt | Le + +/-- Returns the *upper-bound* comparison for `mkSeqBoundsPrecond`. + The lower bound is always `0 ≤ x` (see `mkSeqBoundsPrecond`), so this + method characterises only the upper comparison. A future partial + Sequence op requiring a non-`int` comparison (e.g. a bitvector variant) + should introduce a separate helper rather than extend this enum. -/ +private def SeqBoundKind.upperOpExpr : SeqBoundKind → LExpr CoreLParams.mono + | .Lt => (intLtFunc (T := CoreLParams)).opExpr + | .Le => (intLeFunc (T := CoreLParams)).opExpr + +/-- Precondition `0 <= varName && varName `k.upperOpExpr` Sequence.length(seqName)`. + + `seqName` defaults to `"s"` since all four current call sites + (`Sequence.select`/`update`/`take`/`drop`) name their `Sequence a` input + that way. The parameter exists so a future partial Sequence op with a + different input name need only pass it explicitly rather than rely on a + hidden string literal. Either way, mismatches between the function's + declared inputs and the names used here are caught at elaboration by + `polyUneval`'s `h_precond` free-vars check. -/ +private def mkSeqBoundsPrecond + (varName : String) (k : SeqBoundKind) (seqName : String := "s") : + Strata.DL.Util.FuncPrecondition (LExpr CoreLParams.mono) CoreLParams.Metadata := + let sVar : LExpr CoreLParams.mono := .fvar default seqName (some (seqTy mty[%a])) + let xVar : LExpr CoreLParams.mono := .fvar default varName (some mty[int]) + let zero : LExpr CoreLParams.mono := .intConst default 0 + let lenS : LExpr CoreLParams.mono := .app default seqLengthFunc.opExpr sVar + let lower : LExpr CoreLParams.mono := + .app default (.app default (intLeFunc (T := CoreLParams)).opExpr zero) xVar + let upper : LExpr CoreLParams.mono := + .app default (.app default k.upperOpExpr xVar) lenS + ⟨.app default (.app default (boolAndFunc (T := CoreLParams)).opExpr lower) upper, + default⟩ + +/- A `Sequence` selection function with type `∀a. Sequence a → int → a`. + Partial: requires `0 <= i && i < Sequence.length(s)`. -/ def seqSelectFunc : WFLFunc CoreLParams := polyUneval "Sequence.select" ["a"] [("s", seqTy mty[%a]), ("i", mty[int])] mty[%a] + (preconditions := [mkSeqBoundsPrecond "i" .Lt]) /- A `Sequence` build (snoc) function with type `∀a. Sequence a → a → Sequence a`. `build(s, v)` appends a single element `v` to the end of `s`. -/ @@ -555,7 +602,8 @@ def seqBuildFunc : WFLFunc CoreLParams := ]) /- A `Sequence` update function with type `∀a. Sequence a → int → a → Sequence a`. - `update(s, i, v)` returns a sequence identical to `s` except at index `i` where the value is `v`. -/ + `update(s, i, v)` returns a sequence identical to `s` except at index `i` where the value is `v`. + Partial: requires `0 <= i && i < Sequence.length(s)`. -/ def seqUpdateFunc : WFLFunc CoreLParams := polyUneval "Sequence.update" ["a"] [("s", seqTy mty[%a]), ("i", mty[int]), ("v", mty[%a])] @@ -606,6 +654,7 @@ def seqUpdateFunc : WFLFunc CoreLParams := (((~Sequence.select : (Sequence %a) → int → %a) %3) %0) else #true)))] ]) + (preconditions := [mkSeqBoundsPrecond "i" .Lt]) /- A `Sequence` contains function with type `∀a. Sequence a → a → bool`. `contains(s, v)` is true iff there exists an index `i` such that `select(s, i) == v`. -/ @@ -628,7 +677,8 @@ def seqContainsFunc : WFLFunc CoreLParams := ]) /- A `Sequence` take function with type `∀a. Sequence a → int → Sequence a`. - `take(s, n)` returns the first `n` elements of `s`. -/ + `take(s, n)` returns the first `n` elements of `s`. + Partial: requires `0 <= n && n <= Sequence.length(s)`. -/ def seqTakeFunc : WFLFunc CoreLParams := polyUneval "Sequence.take" ["a"] [("s", seqTy mty[%a]), ("n", mty[int])] @@ -664,9 +714,11 @@ def seqTakeFunc : WFLFunc CoreLParams := (((~Sequence.select : (Sequence %a) → int → %a) %2) %0) else #true))] ]) + (preconditions := [mkSeqBoundsPrecond "n" .Le]) /- A `Sequence` drop function with type `∀a. Sequence a → int → Sequence a`. - `drop(s, n)` returns the sequence with the first `n` elements removed. -/ + `drop(s, n)` returns the sequence with the first `n` elements removed. + Partial: requires `0 <= n && n <= Sequence.length(s)`. -/ def seqDropFunc : WFLFunc CoreLParams := polyUneval "Sequence.drop" ["a"] [("s", seqTy mty[%a]), ("n", mty[int])] @@ -709,6 +761,7 @@ def seqDropFunc : WFLFunc CoreLParams := (((~Int.Add : int → int → int) %0) %1)) else #true))] ]) + (preconditions := [mkSeqBoundsPrecond "n" .Le]) def emptyTriggersFunc : WFLFunc CoreLParams := nullaryUneval "Triggers.empty" mty[Triggers] diff --git a/Strata/Languages/Core/ObligationExtraction.lean b/Strata/Languages/Core/ObligationExtraction.lean index 34eb371291..5cd3cd05f4 100644 --- a/Strata/Languages/Core/ObligationExtraction.lean +++ b/Strata/Languages/Core/ObligationExtraction.lean @@ -55,11 +55,7 @@ def extractGo (pc : PathConditions Expression) : Statements → | s :: rest, acc => match s with | .cmd (.cmd (.assert label e md)) => - let propType := match md.getPropertyType with - | some s => if s == MetaData.divisionByZero then .divisionByZero - else if s == MetaData.arithmeticOverflow then .arithmeticOverflow - else .assert - | none => .assert + let propType := convertMetaDataPropertyType md extractGo pc rest (acc.push (ProofObligation.mk label propType pc e md)) | .cmd (.cmd (.cover label e md)) => diff --git a/Strata/Languages/Core/SarifOutput.lean b/Strata/Languages/Core/SarifOutput.lean index 6e69cf014b..7874a9b912 100644 --- a/Strata/Languages/Core/SarifOutput.lean +++ b/Strata/Languages/Core/SarifOutput.lean @@ -29,7 +29,8 @@ def outcomeToLevel (mode : VerificationMode) (property : Imperative.PropertyType match mode, property, outcome.satisfiabilityProperty, outcome.validityProperty with -- Cover satisfied (sat on P∧Q): always pass | _, .cover, .sat _, _ => .none - -- Unreachable (both unsat): deductive=warning for assert/divisionByZero/arithmeticOverflow, error for cover and bugFinding modes + -- Unreachable (both unsat): deductive=warning for assert-like properties + -- (those that pass vacuously), error for cover and bugFinding modes. | .deductive, p, .unsat, .unsat => if p.passWhenUnreachable then .warning else .error | _, _, .unsat, .unsat => .error -- Pass: validity proven (unsat on P∧¬Q) @@ -88,6 +89,7 @@ def extractLocation (files : Map Strata.Uri Lean.FileMap) (md : Imperative.MetaD def propertyTypeToClassification : Imperative.PropertyType → String | .divisionByZero => "division-by-zero" | .arithmeticOverflow => "arithmetic-overflow" + | .outOfBoundsAccess => "out-of-bounds-access" | .cover => "cover" | .assert => "assert" @@ -111,6 +113,8 @@ def extractRelatedLocations (files : Map Strata.Uri Lean.FileMap) (md : Imperati def vcResultToSarifResult (mode : VerificationMode) (files : Map Strata.Uri Lean.FileMap) (vcr : VCResult) : Strata.Sarif.Result := let ruleId := vcr.obligation.label let relatedLocations := extractRelatedLocations files vcr.obligation.metadata + let properties : Strata.Sarif.PropertyBag := + { propertyType := propertyTypeToClassification vcr.obligation.property } match vcr.outcome with | .error err => let level := .error @@ -119,7 +123,7 @@ def vcResultToSarifResult (mode : VerificationMode) (files : Map Strata.Uri Lean let locations := match extractLocation files vcr.obligation.metadata with | some loc => #[locationToSarif loc] | none => #[] - { ruleId, level, message, locations, relatedLocations } + { ruleId, level, message, locations, relatedLocations, properties } | .ok outcome => let level := outcomeToLevel mode vcr.obligation.property outcome let messageText := outcomeToMessage outcome @@ -127,7 +131,7 @@ def vcResultToSarifResult (mode : VerificationMode) (files : Map Strata.Uri Lean let locations := match extractLocation files vcr.obligation.metadata with | some loc => #[locationToSarif loc] | none => #[] - { ruleId, level, message, locations, relatedLocations } + { ruleId, level, message, locations, relatedLocations, properties } /-- Convert VCResults to a SARIF document -/ def vcResultsToSarif (mode : VerificationMode) (files : Map Strata.Uri Lean.FileMap) (vcResults : VCResults) : Strata.Sarif.SarifDocument := diff --git a/Strata/Languages/Core/StatementEval.lean b/Strata/Languages/Core/StatementEval.lean index ce2b35a975..57f800544d 100644 --- a/Strata/Languages/Core/StatementEval.lean +++ b/Strata/Languages/Core/StatementEval.lean @@ -320,11 +320,7 @@ private def createUnreachableAssertObligations Imperative.ProofObligations Expression := asserts.toArray.map (fun (label, md) => - let propType := match md.getPropertyType with - | some s => if s == Imperative.MetaData.divisionByZero then .divisionByZero - else if s == Imperative.MetaData.arithmeticOverflow then .arithmeticOverflow - else .assert - | _ => .assert + let propType := Imperative.convertMetaDataPropertyType md (Imperative.ProofObligation.mk label propType pathConditions (LExpr.true ()) md)) /-- diff --git a/Strata/Languages/Core/Verifier.lean b/Strata/Languages/Core/Verifier.lean index 86441d2fbb..8763abab03 100644 --- a/Strata/Languages/Core/Verifier.lean +++ b/Strata/Languages/Core/Verifier.lean @@ -786,7 +786,7 @@ def label (o : VCOutcome) (property : Imperative.PropertyType) -- Simplified labels for minimal check level else if checkLevel == .minimal then if property.passWhenUnreachable then - -- Assert-like property (assert, divisionByZero, arithmeticOverflow) + -- Assert-like property (i.e. passes vacuously on unreachable paths). if checkMode == .deductive then match o.validityProperty with | .unsat => "pass" diff --git a/Strata/Transform/PrecondElim.lean b/Strata/Transform/PrecondElim.lean index ee77df3440..e16d42c025 100644 --- a/Strata/Transform/PrecondElim.lean +++ b/Strata/Transform/PrecondElim.lean @@ -76,6 +76,8 @@ private def classifyPrecondition (funcName : String) (precondIdx : Nat := 0) : O | .bv ⟨_, .SafeAdd⟩ | .bv ⟨_, .SafeSub⟩ | .bv ⟨_, .SafeMul⟩ | .bv ⟨_, .SafeNeg⟩ | .bv ⟨_, .SafeUAdd⟩ | .bv ⟨_, .SafeUSub⟩ | .bv ⟨_, .SafeUMul⟩ | .bv ⟨_, .SafeUNeg⟩ => some Imperative.MetaData.arithmeticOverflow + | .seq .Select | .seq .Update | .seq .Take | .seq .Drop => + some Imperative.MetaData.outOfBoundsAccess | _ => none /-- diff --git a/StrataTest/Languages/Core/Examples/Seq.lean b/StrataTest/Languages/Core/Examples/Seq.lean index 937c40858d..d124c1d619 100644 --- a/StrataTest/Languages/Core/Examples/Seq.lean +++ b/StrataTest/Languages/Core/Examples/Seq.lean @@ -68,6 +68,13 @@ s_empty: Sequence.length(s) == 0 Obligation: Sequence.length(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30)) == 3 +Label: assert_t_0_calls_Sequence.select_0 +Property: out-of-bounds access check +Assumptions: +s_empty: Sequence.length(s) == 0 +Obligation: +true && 0 < Sequence.length(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30)) + Label: t_0 Property: assert Assumptions: @@ -75,6 +82,13 @@ s_empty: Sequence.length(s) == 0 Obligation: Sequence.select(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), 0) == 10 +Label: assert_t_1_calls_Sequence.select_0 +Property: out-of-bounds access check +Assumptions: +s_empty: Sequence.length(s) == 0 +Obligation: +true && 1 < Sequence.length(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30)) + Label: t_1 Property: assert Assumptions: @@ -82,6 +96,13 @@ s_empty: Sequence.length(s) == 0 Obligation: Sequence.select(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), 1) == 20 +Label: assert_t_2_calls_Sequence.select_0 +Property: out-of-bounds access check +Assumptions: +s_empty: Sequence.length(s) == 0 +Obligation: +true && 2 < Sequence.length(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30)) + Label: t_2 Property: assert Assumptions: @@ -102,14 +123,26 @@ Obligation: t_length Property: assert Result: ✅ pass +Obligation: assert_t_0_calls_Sequence.select_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: t_0 Property: assert Result: ✅ pass +Obligation: assert_t_1_calls_Sequence.select_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: t_1 Property: assert Result: ✅ pass +Obligation: assert_t_2_calls_Sequence.select_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: t_2 Property: assert Result: ✅ pass @@ -185,6 +218,13 @@ s_empty: Sequence.length(s) == 0 Obligation: Sequence.length(Sequence.append(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), Sequence.build(Sequence.build(s, 40), 50))) == 5 +Label: assert_append_elem_0_calls_Sequence.select_0 +Property: out-of-bounds access check +Assumptions: +s_empty: Sequence.length(s) == 0 +Obligation: +true && 0 < Sequence.length(Sequence.append(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), Sequence.build(Sequence.build(s, 40), 50))) + Label: append_elem_0 Property: assert Assumptions: @@ -192,6 +232,13 @@ s_empty: Sequence.length(s) == 0 Obligation: Sequence.select(Sequence.append(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), Sequence.build(Sequence.build(s, 40), 50)), 0) == 10 +Label: assert_append_elem_4_calls_Sequence.select_0 +Property: out-of-bounds access check +Assumptions: +s_empty: Sequence.length(s) == 0 +Obligation: +true && 4 < Sequence.length(Sequence.append(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), Sequence.build(Sequence.build(s, 40), 50))) + Label: append_elem_4 Property: assert Assumptions: @@ -199,6 +246,13 @@ s_empty: Sequence.length(s) == 0 Obligation: Sequence.select(Sequence.append(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), Sequence.build(Sequence.build(s, 40), 50)), 4) == 50 +Label: set_u_calls_Sequence.update_0 +Property: out-of-bounds access check +Assumptions: +s_empty: Sequence.length(s) == 0 +Obligation: +true && 1 < Sequence.length(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30)) + Label: update_length Property: assert Assumptions: @@ -206,6 +260,13 @@ s_empty: Sequence.length(s) == 0 Obligation: Sequence.length(Sequence.update(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), 1, 99)) == 3 +Label: assert_update_same_calls_Sequence.select_0 +Property: out-of-bounds access check +Assumptions: +s_empty: Sequence.length(s) == 0 +Obligation: +true && 1 < Sequence.length(Sequence.update(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), 1, 99)) + Label: update_same Property: assert Assumptions: @@ -213,6 +274,13 @@ s_empty: Sequence.length(s) == 0 Obligation: Sequence.select(Sequence.update(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), 1, 99), 1) == 99 +Label: assert_update_other_calls_Sequence.select_0 +Property: out-of-bounds access check +Assumptions: +s_empty: Sequence.length(s) == 0 +Obligation: +true && 0 < Sequence.length(Sequence.update(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), 1, 99)) + Label: update_other Property: assert Assumptions: @@ -227,6 +295,13 @@ s_empty: Sequence.length(s) == 0 Obligation: Sequence.contains(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), 20) +Label: set_u_calls_Sequence.take_0 +Property: out-of-bounds access check +Assumptions: +s_empty: Sequence.length(s) == 0 +Obligation: +true && 2 <= Sequence.length(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30)) + Label: take_length Property: assert Assumptions: @@ -234,6 +309,13 @@ s_empty: Sequence.length(s) == 0 Obligation: Sequence.length(Sequence.take(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), 2)) == 2 +Label: assert_take_elem_calls_Sequence.select_0 +Property: out-of-bounds access check +Assumptions: +s_empty: Sequence.length(s) == 0 +Obligation: +true && 0 < Sequence.length(Sequence.take(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), 2)) + Label: take_elem Property: assert Assumptions: @@ -241,6 +323,13 @@ s_empty: Sequence.length(s) == 0 Obligation: Sequence.select(Sequence.take(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), 2), 0) == 10 +Label: set_u_calls_Sequence.drop_0 +Property: out-of-bounds access check +Assumptions: +s_empty: Sequence.length(s) == 0 +Obligation: +true && 1 <= Sequence.length(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30)) + Label: drop_length Property: assert Assumptions: @@ -248,6 +337,13 @@ s_empty: Sequence.length(s) == 0 Obligation: Sequence.length(Sequence.drop(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), 1)) == 2 +Label: assert_drop_elem_calls_Sequence.select_0 +Property: out-of-bounds access check +Assumptions: +s_empty: Sequence.length(s) == 0 +Obligation: +true && 0 < Sequence.length(Sequence.drop(Sequence.build(Sequence.build(Sequence.build(s, 10), 20), 30), 1)) + Label: drop_elem Property: assert Assumptions: @@ -261,22 +357,42 @@ Obligation: append_length Property: assert Result: ✅ pass +Obligation: assert_append_elem_0_calls_Sequence.select_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: append_elem_0 Property: assert Result: ✅ pass +Obligation: assert_append_elem_4_calls_Sequence.select_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: append_elem_4 Property: assert Result: ✅ pass +Obligation: set_u_calls_Sequence.update_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: update_length Property: assert Result: ✅ pass +Obligation: assert_update_same_calls_Sequence.select_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: update_same Property: assert Result: ✅ pass +Obligation: assert_update_other_calls_Sequence.select_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: update_other Property: assert Result: ✅ pass @@ -285,18 +401,34 @@ Obligation: contains_yes Property: assert Result: ❓ unknown +Obligation: set_u_calls_Sequence.take_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: take_length Property: assert Result: ✅ pass +Obligation: assert_take_elem_calls_Sequence.select_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: take_elem Property: assert Result: ✅ pass +Obligation: set_u_calls_Sequence.drop_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: drop_length Property: assert Result: ✅ pass +Obligation: assert_drop_elem_calls_Sequence.select_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: drop_elem Property: assert Result: ✅ pass @@ -365,6 +497,11 @@ Property: assert Obligation: Sequence.length(Sequence.build(Sequence.empty(), 42)) == 1 +Label: assert_build_on_empty_elem_calls_Sequence.select_0 +Property: out-of-bounds access check +Obligation: +true && 0 < Sequence.length(Sequence.build(Sequence.empty(), 42)) + Label: build_on_empty_elem Property: assert Obligation: @@ -380,6 +517,10 @@ Obligation: build_on_empty_length Property: assert Result: ✅ pass +Obligation: assert_build_on_empty_elem_calls_Sequence.select_0 +Property: out-of-bounds access check +Result: ✅ pass + Obligation: build_on_empty_elem Property: assert Result: ✅ pass diff --git a/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean b/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean index 51d905cbd8..a415360eeb 100644 --- a/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean +++ b/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean @@ -85,12 +85,16 @@ func update : ∀[k, v]. ((m : (Map k v)) (i : k) (x : v)) → (Map k v); func Sequence.length : ∀[a]. ((s : (Sequence a))) → int; func Sequence.empty : ∀[a]. () → (Sequence a); func Sequence.append : ∀[a]. ((s1 : (Sequence a)) (s2 : (Sequence a))) → (Sequence a); -func Sequence.select : ∀[a]. ((s : (Sequence a)) (i : int)) → a; +func Sequence.select : ∀[a]. ((s : (Sequence a)) (i : int)) → a + requires 0 <= i && i < Sequence.length(s); func Sequence.build : ∀[a]. ((s : (Sequence a)) (v : a)) → (Sequence a); -func Sequence.update : ∀[a]. ((s : (Sequence a)) (i : int) (v : a)) → (Sequence a); +func Sequence.update : ∀[a]. ((s : (Sequence a)) (i : int) (v : a)) → (Sequence a) + requires 0 <= i && i < Sequence.length(s); func Sequence.contains : ∀[a]. ((s : (Sequence a)) (v : a)) → bool; -func Sequence.take : ∀[a]. ((s : (Sequence a)) (n : int)) → (Sequence a); -func Sequence.drop : ∀[a]. ((s : (Sequence a)) (n : int)) → (Sequence a); +func Sequence.take : ∀[a]. ((s : (Sequence a)) (n : int)) → (Sequence a) + requires 0 <= n && n <= Sequence.length(s); +func Sequence.drop : ∀[a]. ((s : (Sequence a)) (n : int)) → (Sequence a) + requires 0 <= n && n <= Sequence.length(s); func Triggers.empty : () → Triggers; func Triggers.addGroup : ((g : TriggerGroup) (t : Triggers)) → Triggers; func TriggerGroup.empty : () → TriggerGroup; diff --git a/StrataTest/Languages/Core/Tests/SarifOutputTests.lean b/StrataTest/Languages/Core/Tests/SarifOutputTests.lean index 98c8cac9b0..ad488d023c 100644 --- a/StrataTest/Languages/Core/Tests/SarifOutputTests.lean +++ b/StrataTest/Languages/Core/Tests/SarifOutputTests.lean @@ -55,9 +55,10 @@ def makeFilesMap (file : String) : Map Strata.Uri Lean.FileMap := Map.empty.insert uri makeFileMap /-- Create a simple proof obligation for testing -/ -def makeObligation (label : String) (md : MetaData Expression := #[]) : ProofObligation Expression := +def makeObligation (label : String) (md : MetaData Expression := #[]) + (property : Imperative.PropertyType := .assert) : ProofObligation Expression := { label := label - property := .assert + property := property assumptions := [] obligation := Lambda.LExpr.boolConst () true metadata := md } @@ -65,8 +66,9 @@ def makeObligation (label : String) (md : MetaData Expression := #[]) : ProofObl /-- Create a VCResult for testing -/ def makeVCResult (label : String) (outcome : VCOutcome) (md : MetaData Expression := #[]) - (lexprModel : LExprModel := []) : VCResult := - { obligation := makeObligation label md + (lexprModel : LExprModel := []) + (property : Imperative.PropertyType := .assert) : VCResult := + { obligation := makeObligation label md property outcome := .ok outcome verbose := .normal lexprModel := lexprModel @@ -345,4 +347,33 @@ def makeVCResult (label : String) (outcome : VCOutcome) let sarif := vcResultsToSarif .deductive files vcResults Strata.Sarif.toJsonString sarif +/-! ## Property classification tests + +The SARIF `properties.propertyType` field should reflect the obligation's +`PropertyType`, not the default `"assert"`. -/ + +private def sarifPropertyType (vcr : VCResult) : String := + let files := makeFilesMap "/test/x.st" + (vcResultToSarifResult .deductive files vcr).properties.propertyType + +/-- info: "assert" -/ +#guard_msgs in +#eval sarifPropertyType (makeVCResult "t" (mkOutcome (.sat []) .unsat) (property := .assert)) + +/-- info: "division-by-zero" -/ +#guard_msgs in +#eval sarifPropertyType (makeVCResult "t" (mkOutcome (.sat []) .unsat) (property := .divisionByZero)) + +/-- info: "arithmetic-overflow" -/ +#guard_msgs in +#eval sarifPropertyType (makeVCResult "t" (mkOutcome (.sat []) .unsat) (property := .arithmeticOverflow)) + +/-- info: "out-of-bounds-access" -/ +#guard_msgs in +#eval sarifPropertyType (makeVCResult "t" (mkOutcome (.sat []) .unsat) (property := .outOfBoundsAccess)) + +/-- info: "cover" -/ +#guard_msgs in +#eval sarifPropertyType (makeVCResult "t" (mkOutcome (.sat []) .unsat) (property := .cover)) + end Core.Sarif.Tests diff --git a/StrataTest/Transform/PrecondElim.lean b/StrataTest/Transform/PrecondElim.lean index 651ec8b0de..3242d25afa 100644 --- a/StrataTest/Transform/PrecondElim.lean +++ b/StrataTest/Transform/PrecondElim.lean @@ -418,4 +418,80 @@ procedure test (inout g : int, y : int) #guard_msgs in #eval (Std.format (transformProgram loopGuardPrecondPgm)) +/-! ### Test 10: `collectPrecondAsserts` tags Sequence bounds obligations with `outOfBoundsAccess` + +Exercises the full `collectPrecondAsserts` path — the code called by +`transformStmt` / `mkContractWFProc` / `mkFuncWFProc` — and inspects the +metadata on the generated assert. Mirrors `OverflowCheckTest.lean`. -/ + +section SeqBoundsObligations + +open Strata Core Lambda Core.PrecondElim Imperative + +/-- Shared fvar fixtures so each per-op case below is a one-liner. -/ +private def fxS : Core.Expression.Expr := .fvar () ⟨"s", ()⟩ (some (Core.seqTy .int)) +private def fxI : Core.Expression.Expr := .fvar () ⟨"i", ()⟩ (some .int) +private def fxV : Core.Expression.Expr := .fvar () ⟨"v", ()⟩ (some .int) +private def fxN : Core.Expression.Expr := .fvar () ⟨"n", ()⟩ (some .int) +private def fxJ : Core.Expression.Expr := .fvar () ⟨"j", ()⟩ (some .int) + +/-- Check that `collectPrecondAsserts` produces exactly `expectedCount` + obligations from `expr`, each tagged with `outOfBoundsAccess`. -/ +private def assertOutOfBoundsObligations + (expr : Core.Expression.Expr) (expectedCount : Nat) : IO Unit := do + let stmts := collectPrecondAsserts Core.Factory expr "test" #[] + assert! stmts.length == expectedCount + for s in stmts do + let md : MetaData Core.Expression := match s with + | Statement.assert _ _ md => md | _ => #[] + assert! md.getPropertyType == some MetaData.outOfBoundsAccess + +-- Sequence.select / update / take / drop each emit one out-of-bounds obligation. +#eval assertOutOfBoundsObligations (LExpr.mkApp () Core.seqSelectOp [fxS, fxI]) 1 +#eval assertOutOfBoundsObligations (LExpr.mkApp () Core.seqUpdateOp [fxS, fxI, fxV]) 1 +#eval assertOutOfBoundsObligations (LExpr.mkApp () Core.seqTakeOp [fxS, fxN]) 1 +#eval assertOutOfBoundsObligations (LExpr.mkApp () Core.seqDropOp [fxS, fxN]) 1 + +-- Nested: `Sequence.select(Sequence.update(s, i, v), j)` emits two +-- obligations (one per partial call), both tagged `outOfBoundsAccess`. +#eval assertOutOfBoundsObligations + (LExpr.mkApp () Core.seqSelectOp [LExpr.mkApp () Core.seqUpdateOp [fxS, fxI, fxV], fxJ]) 2 + +-- Sequence.length is total: no precondition obligations generated. +#eval do + let stmts := collectPrecondAsserts Core.Factory + (LExpr.mkApp () Core.seqLengthOp [fxS]) "test" #[] + assert! stmts.isEmpty + +/-! #### Test 10a: Pretty-printed obligation shape per partial op + +Catches regressions that preserve count and metadata tag but corrupt the +obligation body (e.g. swapping `.Lt` for `.Le` at a call site, changing +the bound variable name, or swapping the lower/upper bound inside +`mkSeqBoundsPrecond`). -/ + +private def printFirstObligation (expr : Core.Expression.Expr) : IO Unit := do + let stmts := collectPrecondAsserts Core.Factory expr "test" #[] + match stmts.head? with + | some (Statement.assert _ e _) => IO.println s!"{Std.format e}" + | _ => IO.println "" + +/-- info: 0 <= i && i < Sequence.length(s) -/ +#guard_msgs in +#eval printFirstObligation (LExpr.mkApp () Core.seqSelectOp [fxS, fxI]) + +/-- info: 0 <= i && i < Sequence.length(s) -/ +#guard_msgs in +#eval printFirstObligation (LExpr.mkApp () Core.seqUpdateOp [fxS, fxI, fxV]) + +/-- info: 0 <= n && n <= Sequence.length(s) -/ +#guard_msgs in +#eval printFirstObligation (LExpr.mkApp () Core.seqTakeOp [fxS, fxN]) + +/-- info: 0 <= n && n <= Sequence.length(s) -/ +#guard_msgs in +#eval printFirstObligation (LExpr.mkApp () Core.seqDropOp [fxS, fxN]) + +end SeqBoundsObligations + end PrecondElimTests From 0851e73786211427ba9cde513efb7cc258f6e552 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Tue, 19 May 2026 12:02:44 -0700 Subject: [PATCH 16/28] Add dialect_option typecheck off to bypass DDM type checker (#1125) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit ## Summary The DDM type checker uses unification to infer implicit type arguments, but this fails in some cases — notably when template-generated accessors with unresolved tvar return types are composed with polymorphic functions. This PR adds a per-dialect option to bypass type checking entirely, filling implicit type parameter slots with anonymous type placeholders instead. ## How to use In a dialect definition, add `dialect_option typecheck off;` to disable type checking for all programs using that dialect: ``` #dialect dialect MyDialect; dialect_option typecheck off; type Foo; fn bar (A : Type, x : A) : A => x; ... #end ``` Programs using the dialect will skip `inferType` and `unifyTypes` for expression arguments. Variable name resolution and global context population still work normally — only type inference is bypassed. ## Test changes `StrataTest/DDM/TypecheckSkip.lean` defines an inline dialect with parameterized types, polymorphic functions, and perField accessor templates. It demonstrates that the accessor-into-polymorphic-fn pattern (from issue #650 / PR #734) produces type errors with typecheck on, and elaborates successfully with typecheck off. ## Details - **AST.lean**: Add `TypeExprF.skip` (anonymous type placeholder `.tvar loc ""`), `Dialect.typecheck : Bool := true`, refactor `Program.globalContext` into explicit `computeGlobalContext` function - **Elab/Core.lean**: Add `ElabContext.typecheck`, skip `inferType`/`unifyTypes` in `elabSyntaxArg`, fill unfilled type param slots in `runSyntaxElaborator` post-pass, skip pre-registration in `elabOperation`, fix `applyNArgs` to handle tvar types - **Elab/DeclM.lean**: Add `DeclContext.typecheck` - **Elab/DialectM.lean**: Add `elabSetOptionCommand` handler dispatching on `"typecheck"` option - **BuiltinDialects/StrataDDL.lean**: Add `setOptionCommand` with syntax `dialect_option ;` - **Elab.lean**: Thread `Dialect.typecheck` into `DeclContext` in `elabProgramRest` - **Ion.lean, Python/Specs/DDM.lean**: Update `Program` construction for `globalContext` refactor By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: Claude Opus 4.6 --- Strata/DDM/AST.lean | 24 +- Strata/DDM/BuiltinDialects/StrataDDL.lean | 9 + Strata/DDM/Elab.lean | 3 +- Strata/DDM/Elab/Core.lean | 38 ++- Strata/DDM/Elab/DeclM.lean | 2 + Strata/DDM/Elab/DialectM.lean | 14 ++ Strata/DDM/Ion.lean | 56 +++-- Strata/DDM/Util/Ion.lean | 1 + Strata/DDM/Util/Ion/SymbolTable.lean | 50 ++-- Strata/DDM/Util/Ion/SystemSymbolIds.lean | 31 +++ Strata/Languages/Python/PySpecPipeline.lean | 11 +- Strata/Languages/Python/Specs.lean | 4 +- Strata/Languages/Python/Specs/DDM.lean | 66 +++--- StrataTest/DDM/TypecheckSkip.lean | 218 ++++++++++++++++++ StrataTest/DL/Imperative/StepStmtTest.lean | 2 +- .../Languages/Python/SpecsTest.lean | 4 +- Tools/Python/strata/base.py | 15 ++ docs/verso/DDMDoc.lean | 31 +++ 18 files changed, 471 insertions(+), 108 deletions(-) create mode 100644 Strata/DDM/Util/Ion/SystemSymbolIds.lean create mode 100644 StrataTest/DDM/TypecheckSkip.lean diff --git a/Strata/DDM/AST.lean b/Strata/DDM/AST.lean index 786ac648cc..8e947f40b8 100644 --- a/Strata/DDM/AST.lean +++ b/Strata/DDM/AST.lean @@ -113,6 +113,9 @@ deriving BEq, Inhabited, Repr namespace TypeExprF +/-- An anonymous type placeholder. -/ +def placeholder {α} (loc : α) : TypeExprF α := .tvar loc "" + def ann {α} : TypeExprF α → α | .ident ann _ _ => ann | .bvar ann _ => ann @@ -1339,6 +1342,8 @@ structure Dialect where -- Names of dialects that are imported into this dialect imports : Array DialectName declarations : Array Decl := #[] + /-- When false, type inference and unification are skipped during elaboration. -/ + typecheck : Bool := true cache : Std.HashMap String Decl := declarations.foldl (init := {}) fun m d => m.insert d.name d @@ -2240,6 +2245,11 @@ def addCommand (dialects : DialectMap) (gctx : GlobalContext) (op : Operation) : end GlobalContext +def computeGlobalContext (dialects : DialectMap) (commands : Array Operation) + : Except String GlobalContext := + commands.foldl (init := (Except.ok {} : Except String GlobalContext)) + fun acc cmd => acc.bind (·.addCommand dialects cmd) + structure Program where mk :: /-- Map from dialect names to the dialect definition. -/ @@ -2249,11 +2259,7 @@ structure Program where /-- Top level commands in file. -/ commands : Array Operation := #[] /-- Final global context for program. -/ - globalContext : GlobalContext := - match commands.foldl (init := (Except.ok {} : Except String GlobalContext)) - fun acc cmd => acc.bind (·.addCommand dialects cmd) with - | .ok gctx => gctx - | .error e => panic! s!"Program.globalContext: {e}" -- nopanic:ok + globalContext : GlobalContext namespace Program @@ -2261,7 +2267,7 @@ instance : BEq Program where beq x y := x.dialect == y.dialect && x.commands == y.commands instance : Inhabited Program where - default := private { dialects := .empty, dialect := default } + default := private { dialects := .empty, dialect := default, globalContext := {} } def addCommand (env : Program) (cmd : Operation) : Program := { env with @@ -2276,7 +2282,11 @@ This creates a program. It is added in addition to `Program.mk` to simplify the `ToExpr Program` instance. -/ def create (dialects : DialectMap) (dialect : DialectName) (commands : Array Operation) : Program := - { dialects, dialect, commands } + let globalContext := + match computeGlobalContext dialects commands with + | .ok gctx => gctx + | .error e => panic! s!"Program.globalContext: {e}" -- nopanic:ok + { dialects, dialect, commands, globalContext } end Program diff --git a/Strata/DDM/BuiltinDialects/StrataDDL.lean b/Strata/DDM/BuiltinDialects/StrataDDL.lean index fd48156467..cacc09eef2 100644 --- a/Strata/DDM/BuiltinDialects/StrataDDL.lean +++ b/Strata/DDM/BuiltinDialects/StrataDDL.lean @@ -66,6 +66,15 @@ def StrataDDL : Dialect := BuiltinM.create! "StrataDDL" #[initDialect] do category := Command, syntaxDef := .ofList [.str "import", .ident 0 0, .str ";"] } + declareOp { + name := "setOptionCommand", + argDecls := .ofArray #[ + { ident := "name", kind := Ident }, + { ident := "value", kind := Ident } + ], + category := Command, + syntaxDef := .ofList [.str "dialect_option", .ident 0 0, .ident 1 0, .str ";"] + } declareOp { name := "categoryCommand", argDecls := .ofArray #[ diff --git a/Strata/DDM/Elab.lean b/Strata/DDM/Elab.lean index 0ab6bfe420..5c18dd3e3b 100644 --- a/Strata/DDM/Elab.lean +++ b/Strata/DDM/Elab.lean @@ -181,7 +181,8 @@ def elabProgramRest let s := DeclState.initDeclState let s := { s with pos := startPos } let s := s.openLoadedDialect! loader d - let ctx : DeclContext := { inputContext, stopPos, loader := loader, missingImport := false } + let ctx : DeclContext := { inputContext, stopPos, loader := loader, missingImport := false, + typecheck := d.typecheck } let (cmds, s) := runCommand leanEnv #[] stopPos ctx s if s.errors.isEmpty then let openDialects := loader.dialects.importedDialects dialect known diff --git a/Strata/DDM/Elab/Core.lean b/Strata/DDM/Elab/Core.lean index 1d7d39aa0d..ac7821282d 100644 --- a/Strata/DDM/Elab/Core.lean +++ b/Strata/DDM/Elab/Core.lean @@ -111,6 +111,14 @@ def applyNArgs (tctx : TypingContext) (e : TypeExpr) (n : Nat) := aux #[] e if argsLt : args.size < n then match tctx.hnf e with | .arrow _ a r => aux (args.push a) r + -- A tvar already represents an unresolved type — filling remaining + -- slots with placeholders is consistent with existing tvar semantics. + -- This runs regardless of the `typecheck` flag; downstream unifyTypes + -- still catches genuine mismatches when typecheck is on. + | .tvar ann _ => + let placeholder := .placeholder ann + let tvars := Array.replicate (n - args.size) placeholder + .ok (⟨args ++ tvars, by simp [tvars]; omega⟩, placeholder) | e => .error (args, e) else if argsGt : args.size > n then @@ -142,6 +150,8 @@ structure ElabContext where globalContext : GlobalContext /-- Flag to indicate we are missing an import (silences some warnings)-/ missingImport : Bool + /-- When false, type inference and unification are skipped during elaboration. -/ + typecheck : Bool := true structure ElabState where -- Errors found in elaboration. @@ -1119,7 +1129,14 @@ partial def elabOperation (tctx : TypingContext) (stx : Syntax) : ElabM Tree := if not success then return default let getKind i := .ofArgDeclKind argDecls[i].kind + let typecheck := (← read).typecheck let ((args, newCtx), success) ← runChecked <| + -- When typecheck is off, skip pre-registration passes. Global context + -- is already populated by `computeGlobalContext` at program creation. + if !typecheck then do + let args ← runSyntaxElaborator (argc := argDecls.size) getKind se tctx stxArgs + return (args, resultContext se tctx args) + else match se.preRegisterTypesScope with | some scopeArgLevel => elaborateWithPreRegistrationCore argDecls se tctx loc stxArgs scopeArgLevel @@ -1155,10 +1172,13 @@ partial def elabSyntaxArg (argIdx : Fin argc) (trees : Vector (Option Tree) argc) : ElabM (Vector (Option Tree) argc) := do + let typecheck := (← read).typecheck match getKind argIdx with | .preType expectedType => let (tree, success) ← runChecked <| elabExpr tctx astx if success then + if !typecheck then + return trees.set argIdx (some tree) let expr := tree.info.asExpr!.expr let inferredType ← inferType tctx expr let dialects := (← read).dialects @@ -1178,6 +1198,8 @@ partial def elabSyntaxArg | .typeExpr expectedType => let (tree, success) ← runChecked <| elabExpr tctx astx if success then + if !typecheck then + return trees.set argIdx (some tree) let expr := tree.info.asExpr!.expr let inferredType ← inferType tctx expr let trees ← unifyTypes isTypeP argIdx @@ -1246,6 +1268,19 @@ partial def runSyntaxElaborator trees ← elabSyntaxArg getKind isTypeP t.resultContext astx ⟨argLevel, argLevelP⟩ trees else trees ← elabSyntaxArg getKind isTypeP tctx0 astx ⟨argLevel, argLevelP⟩ trees + -- Fill unfilled type parameter slots with skip types when type checking is skipped. + if !(← read).typecheck then + for i in Fin.range argc do + if trees[i].isNone ∧ isTypeP i then + let loc := SourceRange.none + -- Synthesize placeholder type expr. + let info : TypeInfo := { + loc, + inputCtx := tctx0, + typeExpr := .placeholder loc, + isInferred := true + } + trees := trees.set i (some (.node (.ofTypeInfo info) #[])) return trees.map (·.getD default) /-- @@ -1778,7 +1813,8 @@ def runElab {α} (action : ElabM α) : DeclM α := do metadataDeclMap := s.metadataDeclMap, globalContext := s.globalContext, inputContext := (←read).inputContext, - missingImport := (← read).missingImport + missingImport := (← read).missingImport, + typecheck := (← read).typecheck } let errors := (←get).errors -- Clear errors from decl diff --git a/Strata/DDM/Elab/DeclM.lean b/Strata/DDM/Elab/DeclM.lean index cdd7e646e7..b4096aceaf 100644 --- a/Strata/DDM/Elab/DeclM.lean +++ b/Strata/DDM/Elab/DeclM.lean @@ -170,6 +170,8 @@ structure DeclContext where loader : LoadedDialects /-- Flag indicating imports are missing (silences some errors). -/ missingImport : Bool + /-- When false, type inference and unification are skipped during elaboration. -/ + typecheck : Bool := true namespace DeclContext diff --git a/Strata/DDM/Elab/DialectM.lean b/Strata/DDM/Elab/DialectM.lean index 54bd169f37..ed3286c482 100644 --- a/Strata/DDM/Elab/DialectM.lean +++ b/Strata/DDM/Elab/DialectM.lean @@ -909,6 +909,19 @@ def elabMdCommand : DialectElab := fun tree => do metadataDeclMap := s.metadataDeclMap.add dialect decl } +def elabSetOptionCommand : DialectElab := fun tree => do + let .isTrue _ := checkTreeSize tree 2 + | logError tree.info.loc "setOptionCommand: unexpected tree size"; return + let nameInfo := tree[0].info.asIdent! + let valueInfo := tree[1].info.asIdent! + match nameInfo.val with + | "typecheck" => + match valueInfo.val with + | "on" => modifyDialect fun d => { d with typecheck := true } + | "off" => modifyDialect fun d => { d with typecheck := false } + | _ => logError valueInfo.loc s!"Expected 'on' or 'off' for option 'typecheck'." + | _ => logError nameInfo.loc s!"Unknown option '{nameInfo.val}'." + def dialectElabs : Std.HashMap QualifiedIdent DialectElab := Std.HashMap.ofList <| [ (q`StrataDDL.importCommand, elabDialectImportCommand), @@ -917,6 +930,7 @@ def dialectElabs : Std.HashMap QualifiedIdent DialectElab := (q`StrataDDL.typeCommand, elabTypeCommand), (q`StrataDDL.fnCommand, elabFnCommand), (q`StrataDDL.mdCommand, elabMdCommand), + (q`StrataDDL.setOptionCommand, elabSetOptionCommand), ] partial def runDialectCommand (leanEnv : Lean.Environment) : DialectM Bool := do diff --git a/Strata/DDM/Ion.lean b/Strata/DDM/Ion.lean index a6aaf93451..baa268e797 100644 --- a/Strata/DDM/Ion.lean +++ b/Strata/DDM/Ion.lean @@ -1485,6 +1485,10 @@ private instance : CachedToIon Dialect where for i in d.imports do a := a.push <| .struct #[(ionSymbol! "type", ionSymbol! "import"), (ionSymbol! "name", .string i)] + if !d.typecheck then + a := a.push <| .struct #[(ionSymbol! "type", ionSymbol! "option"), + (ionSymbol! "name", .string "typecheck"), + (ionSymbol! "value", .string "off")] for decl in d.declarations do a := a.push <| (← ionRef! decl) return .list a @@ -1492,9 +1496,17 @@ private instance : CachedToIon Dialect where def fromIonFragment (dialect : DialectName) (f : Ion.Fragment) : Except String Dialect := do let ctx : FromIonContext := ⟨f.symbols⟩ let tbl := f.symbols - let typeId := tbl.symbolId! "type" - let nameId := tbl.symbolId! "name" - let (imports, decls) ← f.values.foldlM (init := (#[], #[])) (start := f.offset) fun (imports, decls) v => do + let typeId := tbl.symbolId "type" + let nameId := tbl.symbolId "name" + let valueId := tbl.symbolId "value" + if f.values.size > 0 then + if typeId = .zero then + throw s!"Missing type symbol" + if nameId = .zero then + throw s!"Missing name symbol" + let (imports, decls, typecheck) ← f.values.foldlM + (init := (#[], #[], true)) (start := f.offset) + fun (imports, decls, typecheck) v => do let fields ← FromIonM.asStruct0 v ⟨f.symbols⟩ let some (_, val) := fields.find? (·.fst == typeId) | throw s!"Could not find type in {repr fields}" @@ -1503,14 +1515,29 @@ def fromIonFragment (dialect : DialectName) (f : Ion.Fragment) : Except String D let some (_, val) := fields.find? (·.fst == nameId) | throw "Could not find import" let i ← FromIonM.asString "Import name" val ctx - pure (imports.push i, decls) + pure (imports.push i, decls, typecheck) + | "option" => + if valueId = .zero then + throw "Could not find option value" + let some (_, nameVal) := fields.find? (·.fst == nameId) + | throw "Could not find option name" + let optName ← FromIonM.asString "Option name" nameVal ctx + let some (_, valueVal) := fields.find? (·.fst == valueId) + | throw "Could not find option value" + let optValue ← FromIonM.asString "Option value" valueVal ctx + match optName, optValue with + | "typecheck", "off" => pure (imports, decls, false) + | "typecheck", "on" => pure (imports, decls, true) + | "typecheck", v => throw s!"Expected 'on' or 'off' for option 'typecheck', got '{v}'" + | name, _ => throw s!"Unknown option '{name}'" | name => let decl ← Decl.fromIonFields name fields ctx - pure (imports, decls.push decl) + pure (imports, decls.push decl, typecheck) return { name := dialect imports := imports - declarations := decls + declarations := decls + typecheck := typecheck } private instance : FromIon Dialect where @@ -1553,12 +1580,9 @@ def fromIonFragmentCommands (f : Ion.Fragment) : Except String (Array Operation) def fromIonFragment (f : Ion.Fragment) (dialects : DialectMap) - (dialect : DialectName) : Except String Program := - return { - dialects := dialects - dialect := dialect - commands := ← fromIonFragmentCommands f - } + (dialect : DialectName) : Except String Program := do + let commands ← fromIonFragmentCommands f + return .create dialects dialect commands /-- Decodes bytes in the Ion format into a single Strata program. @@ -1601,8 +1625,12 @@ def filesFromIon (dialects : DialectMap) (bytes : ByteArray) : Except String (Li let ⟨filesList, _⟩ ← FromIonM.asList ctx[1]! ionCtx let tbl := symbols - let filePathId := tbl.symbolId! "filePath" - let programId := tbl.symbolId! "program" + let filePathId := tbl.symbolId "filePath" + let programId := tbl.symbolId "program" + if filePathId = .zero then + throw "Missing filePath" + if programId = .zero then + throw "Missing program" filesList.toList.mapM fun fileEntry => do let fields ← FromIonM.asStruct0 fileEntry ionCtx diff --git a/Strata/DDM/Util/Ion.lean b/Strata/DDM/Util/Ion.lean index 0d2517ff8f..6b11c00900 100644 --- a/Strata/DDM/Util/Ion.lean +++ b/Strata/DDM/Util/Ion.lean @@ -9,6 +9,7 @@ public import Strata.DDM.Util.Ion.AST public import Strata.DDM.Util.Ion.Deserialize public import Strata.DDM.Util.Ion.Serialize public import Strata.DDM.Util.Ion.SymbolTable +public import Strata.DDM.Util.Ion.SystemSymbolIds import all Strata.DDM.Util.ByteArray import all Strata.DDM.Util.Fin diff --git a/Strata/DDM/Util/Ion/SymbolTable.lean b/Strata/DDM/Util/Ion/SymbolTable.lean index aa7a65bbba..07ff69fb94 100644 --- a/Strata/DDM/Util/Ion/SymbolTable.lean +++ b/Strata/DDM/Util/Ion/SymbolTable.lean @@ -5,30 +5,30 @@ -/ module -import Lean.Elab.Command -- shake: keep public import Strata.DDM.Util.Ion.AST -import all Strata.DDM.Util.Lean public section namespace Ion structure SymbolTable where - array : Array String - map : Std.HashMap String SymbolId + private mk :: + private array : Array String + private map : Std.HashMap String SymbolId locals : Array String deriving Inhabited namespace SymbolTable -instance : GetElem? SymbolTable SymbolId String (fun tbl idx => idx.value < tbl.array.size) where - getElem tbl idx p := tbl.array[idx.value] - getElem! tbl idx := assert! idx.value < tbl.array.size; tbl.array[idx.value]! - getElem? tbl idx := tbl.array[idx.value]? +def size (tbl : SymbolTable) : Nat := tbl.array.size -def symbolId! (sym : String) (tbl : SymbolTable) : SymbolId := - match tbl.map[sym]? with - | some i => i - | none => panic! s!"Unbound symbol {sym}" +instance : GetElem? SymbolTable SymbolId String (fun tbl idx => idx.value < tbl.size) where + getElem tbl idx p := private tbl.array[idx.value] + getElem! tbl idx := private tbl.array[idx.value]! + getElem? tbl idx := private tbl.array[idx.value]? + +/-- Lookup symbol and return `SymbolId.zero` if not defined. -/ +def symbolId (sym : String) (tbl : SymbolTable) : SymbolId := + tbl.map.getD sym .zero /-- Intern a string into a symbol. @@ -62,33 +62,9 @@ def system : SymbolTable where def ofLocals (locals : Array String) : SymbolTable := locals.foldl (init := .system) (fun tbl sym => tbl.intern sym |>.snd) -public instance : Lean.Quote SymbolTable where +instance : Lean.Quote SymbolTable where quote st := Lean.Syntax.mkCApp ``SymbolTable.ofLocals #[Lean.quote st.locals] end SymbolTable -namespace SymbolId - -def systemSymbolId! (sym : String) : SymbolId := SymbolTable.system |>.symbolId! sym - --- Use metaprogramming to declare `{sym}SymbolId : SymbolId` for each system symbol. -section -open Lean (TSyntax) -open Lean.Elab.Command (elabCommand) - --- Declare all system symbol ids as constants -run_cmd do - for sym in SymbolTable.ionSharedSymbolTableEntries do - -- To simplify name, strip out non-alphanumeric characters. - let simplifiedName : String := .ofList <| sym.toList.filter (·.isAlphanum) - let leanName := Lean.mkLocalDeclId simplifiedName - let cmd : TSyntax `command ← `(command| - public def $(leanName) : SymbolId := systemSymbolId! $(Lean.Syntax.mkStrLit sym) - ) - elabCommand cmd - -end - -end SymbolId - end Ion diff --git a/Strata/DDM/Util/Ion/SystemSymbolIds.lean b/Strata/DDM/Util/Ion/SystemSymbolIds.lean new file mode 100644 index 0000000000..dfb0dad26d --- /dev/null +++ b/Strata/DDM/Util/Ion/SystemSymbolIds.lean @@ -0,0 +1,31 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +import Lean.Elab.Command -- shake: keep +public import Strata.DDM.Util.Ion.AST +meta import Strata.DDM.Util.Ion.SymbolTable + +-- Use metaprogramming to declare `{sym}SymbolId : SymbolId` for each system symbol. +section +open Lean (TSyntax) +open Lean.Elab.Command (elabCommand) +open Lean.Parser.Category (command) + +-- Declare all system symbol ids as constants +run_cmd do + for sym in Ion.SymbolTable.ionSharedSymbolTableEntries do + -- To simplify name, strip out non-alphanumeric characters. + let simplifiedName : String := .ofList <| sym.toList.filter (·.isAlphanum) + let leanName := Lean.mkIdentFrom (canonical := true) default <| ``Ion.SymbolId |>.str simplifiedName + let idx := Ion.SymbolTable.system.symbolId sym + if idx = .zero then + throwError s!"Unbound symbol {sym}" + elabCommand $ ← `(command| + public def $(leanName) : Ion.SymbolId := ⟨$(Lean.Syntax.mkNatLit idx.value)⟩ + ) + +end diff --git a/Strata/Languages/Python/PySpecPipeline.lean b/Strata/Languages/Python/PySpecPipeline.lean index 21129ebe39..dfae2b2a60 100644 --- a/Strata/Languages/Python/PySpecPipeline.lean +++ b/Strata/Languages/Python/PySpecPipeline.lean @@ -169,17 +169,13 @@ public def buildPySpecLaurel (pyspecEntries : Array (String × String)) | .Constrained ct => ct.name.text | .Datatype dt => dt.name.text | .Alias ta => ta.name.text - match seenTypes.get? name with - | some prevFile => + if let some prevFile := seenTypes[name]? then throw s!"PySpec type name collision: '{name}' defined in both {prevFile} and {srcFile}" - | none => pure () seenTypes := seenTypes.insert name srcFile let mut seenProcs : Std.HashMap String String := {} for (proc, srcFile) in combinedProcedures do - match seenProcs.get? proc.name.text with - | some prevFile => + if let some prevFile := seenProcs[proc.name.text]? then throw s!"PySpec procedure name collision: '{proc.name.text}' defined in both {prevFile} and {srcFile}" - | none => pure () seenProcs := seenProcs.insert proc.name.text srcFile let combinedLaurel : Laurel.Program := { @@ -206,8 +202,7 @@ public def readDispatchOverloads match ← Python.Specs.readDDM ionFile |>.toBaseIO with | .ok t => pure t | .error msg => throw s!"Could not read dispatch file {ionFile}: {msg}" - let (overloads, errors) := - Python.Specs.ToLaurel.extractOverloads dispatchPath sigs + let (overloads, errors) := Python.Specs.ToLaurel.extractOverloads dispatchPath sigs allWarnings := allWarnings ++ errors tbl := mergeOverloads tbl overloads return (tbl, allWarnings) diff --git a/Strata/Languages/Python/Specs.lean b/Strata/Languages/Python/Specs.lean index 00ec5f786d..9de125fbef 100644 --- a/Strata/Languages/Python/Specs.lean +++ b/Strata/Languages/Python/Specs.lean @@ -8,7 +8,7 @@ module import Strata.DDM.Format import all Strata.DDM.Util.Fin import Strata.Languages.Python.ReadPython -import Strata.Languages.Python.Specs.DDM +import Strata.Languages.Python.Specs.DDM public import Strata.Languages.Python.Specs.Decls import Strata.Languages.Python.Specs.Error import Strata.Util.DecideProp @@ -1664,8 +1664,6 @@ partial def translateModuleAux (body : Array (Strata.Python.stmt Strata.SourceRa end - - /-- Translates Python AST statements to PySpec signatures with dependency resolution. -/ def translateModule (dialectFile searchPath strataDir pythonFile : System.FilePath) diff --git a/Strata/Languages/Python/Specs/DDM.lean b/Strata/Languages/Python/Specs/DDM.lean index 73c1ff245b..86c7526c2c 100644 --- a/Strata/Languages/Python/Specs/DDM.lean +++ b/Strata/Languages/Python/Specs/DDM.lean @@ -7,20 +7,15 @@ module public import Strata.DDM.Integration.Lean public import Strata.Languages.Python.Specs.Decls - -import Strata.DDM.AST -import Strata.DDM.Util.ByteArray -import Strata.DDM.Format import Strata.DDM.BuiltinDialects.Init public import Strata.DDM.Integration.Lean.OfAstM +import Strata.DDM.Format import Strata.DDM.Ion -public section - namespace Strata.Python /-- Converts a Python identifier to an annotated string for DDM serialization. -/ -private def PythonIdent.toDDM (d : PythonIdent) : Ann String SourceRange := +def PythonIdent.toDDM (d : PythonIdent) : Ann String SourceRange := ⟨.none, toString d⟩ namespace Specs @@ -259,10 +254,10 @@ private def SpecAtomType.toDDM (d : SpecAtomType) .typeTypedDict loc ⟨.none, a⟩ -private def SpecDefault.toDDM : Specs.SpecDefault → DDM.SpecDefault SourceRange +def SpecDefault.toDDM : Specs.SpecDefault → DDM.SpecDefault SourceRange | .none => .noneDefault .none -private def Arg.toDDM (d : Arg) : DDM.ArgDecl SourceRange := +def Arg.toDDM (d : Arg) : DDM.ArgDecl SourceRange := .mkArgDecl .none ⟨.none, d.name⟩ d.type.toDDM ⟨.none, d.default.map (·.toDDM)⟩ protected def SpecExpr.toDDM (e : SpecExpr) : DDM.SpecExprDecl SourceRange := @@ -299,18 +294,25 @@ def specExprFormatContext : FormatContext := def specExprFormatState : FormatState where openDialects := DDM.PythonSpecs_map.toList.foldl (init := {}) fun s d => s.insert d.name -instance : ToString SpecExpr where - toString e := (mformat (SpecExpr.toDDM e).toAst specExprFormatContext specExprFormatState).format.pretty +namespace SpecExpr + +public def toString (e : SpecExpr) : String := + (mformat (SpecExpr.toDDM e).toAst specExprFormatContext specExprFormatState).format.pretty -private def MessagePart.toDDM (p : MessagePart) : DDM.MessagePart SourceRange := +public instance : ToString SpecExpr where + toString := SpecExpr.toString + +end SpecExpr + +def MessagePart.toDDM (p : MessagePart) : DDM.MessagePart SourceRange := match p with | .str s => .strMessagePart .none ⟨.none, s⟩ | .expr e => .exprMessagePart .none e.toDDM -private def Assertion.toDDM (a : Assertion) : DDM.Assertion SourceRange := +def Assertion.toDDM (a : Assertion) : DDM.Assertion SourceRange := .mkAssertion .none a.formula.toDDM ⟨.none, a.message.map (·.toDDM)⟩ -private def FunctionDecl.toDDM (d : FunctionDecl) : DDM.FunDecl SourceRange := +def FunctionDecl.toDDM (d : FunctionDecl) : DDM.FunDecl SourceRange := .mkFunDecl d.loc (name := .mk d.nameLoc d.name) @@ -327,10 +329,10 @@ private def FunctionDecl.toDDM (d : FunctionDecl) : DDM.FunDecl SourceRange := d.postconditions.map fun e => .mkPostconditionEntry .none e.toDDM⟩) -private def ClassVariable.toDDM (cv : ClassVariable) : DDM.ClassVarDecl SourceRange := +def ClassVariable.toDDM (cv : ClassVariable) : DDM.ClassVarDecl SourceRange := .mkClassVarDecl .none ⟨.none, cv.name⟩ ⟨.none, cv.value⟩ -private partial def ClassDef.toDDMDecl (d : ClassDef) : DDM.ClassDecl SourceRange := +partial def ClassDef.toDDMDecl (d : ClassDef) : DDM.ClassDecl SourceRange := .mkClassDecl d.loc (.mk .none d.name) ⟨.none, d.bases.map (·.toDDM)⟩ ⟨.none, d.fields.map fun f => @@ -341,7 +343,7 @@ private partial def ClassDef.toDDMDecl (d : ClassDef) : DDM.ClassDecl SourceRang ⟨.none, d.methods.map (·.toDDM)⟩ ⟨.none, d.exhaustive⟩ -private def Signature.toDDM (sig : Signature) : DDM.Signature SourceRange := +def Signature.toDDM (sig : Signature) : DDM.Signature SourceRange := match sig with | .externTypeDecl name source => .externTypeDecl .none ⟨.none, name⟩ source.toDDM @@ -352,7 +354,7 @@ private def Signature.toDDM (sig : Signature) : DDM.Signature SourceRange := | .typeDef d => .typeDef d.loc (.mk d.nameLoc d.name) d.definition.toDDM -private def DDM.SpecType.fromDDM (d : DDM.SpecType SourceRange) : Specs.SpecType := +def DDM.SpecType.fromDDM (d : DDM.SpecType SourceRange) : Specs.SpecType := match d with | .typeClassNoArgs loc ⟨_, cl⟩ => .ident loc { pythonModule := "", name := cl } #[] @@ -394,10 +396,10 @@ decreasing_by · decreasing_tactic · decreasing_tactic -private def DDM.SpecDefault.fromDDM : DDM.SpecDefault SourceRange → Specs.SpecDefault +def DDM.SpecDefault.fromDDM : DDM.SpecDefault SourceRange → Specs.SpecDefault | .noneDefault _ => .none -private def DDM.ArgDecl.fromDDM (d : DDM.ArgDecl SourceRange) : Specs.Arg := +def DDM.ArgDecl.fromDDM (d : DDM.ArgDecl SourceRange) : Specs.Arg := let .mkArgDecl _ ⟨_, name⟩ type ⟨_, default⟩ := d { name := name @@ -405,7 +407,7 @@ private def DDM.ArgDecl.fromDDM (d : DDM.ArgDecl SourceRange) : Specs.Arg := default := default.map (·.fromDDM) } -private def DDM.SpecExprDecl.fromDDM (d : DDM.SpecExprDecl SourceRange) : Specs.SpecExpr := +def DDM.SpecExprDecl.fromDDM (d : DDM.SpecExprDecl SourceRange) : Specs.SpecExpr := match d with | .placeholderExpr loc => .placeholder loc | .varExpr loc ⟨_, name⟩ => .var name loc @@ -429,16 +431,16 @@ private def DDM.SpecExprDecl.fromDDM (d : DDM.SpecExprDecl SourceRange) : Specs. | .forallDictExpr loc dict ⟨_, keyVar⟩ ⟨_, valVar⟩ body => .forallDict dict.fromDDM keyVar valVar body.fromDDM loc -private def DDM.MessagePart.fromDDM (d : DDM.MessagePart SourceRange) : Specs.MessagePart := +def DDM.MessagePart.fromDDM (d : DDM.MessagePart SourceRange) : Specs.MessagePart := match d with | .strMessagePart _ ⟨_, s⟩ => .str s | .exprMessagePart _ e => .expr e.fromDDM -private def DDM.Assertion.fromDDM (d : DDM.Assertion SourceRange) : Specs.Assertion := +def DDM.Assertion.fromDDM (d : DDM.Assertion SourceRange) : Specs.Assertion := let .mkAssertion _ formula ⟨_, message⟩ := d { message := message.map (·.fromDDM), formula := formula.fromDDM } -private def DDM.FunDecl.fromDDM (d : DDM.FunDecl SourceRange) : Specs.FunctionDecl := +def DDM.FunDecl.fromDDM (d : DDM.FunDecl SourceRange) : Specs.FunctionDecl := let .mkFunDecl loc ⟨nameLoc, name⟩ ⟨_, args⟩ ⟨_, kwonly⟩ ⟨_, kwargs⟩ returnType ⟨_, isOverload⟩ ⟨_, preconditions⟩ ⟨_, postconditions⟩ := d @@ -462,7 +464,7 @@ private def DDM.FunDecl.fromDDM (d : DDM.FunDecl SourceRange) : Specs.FunctionDe | .mkPostconditionEntry _ e => e.fromDDM } -private def DDM.ClassDecl.fromDDM (d : DDM.ClassDecl SourceRange) : Specs.ClassDef := +def DDM.ClassDecl.fromDDM (d : DDM.ClassDecl SourceRange) : Specs.ClassDef := let .mkClassDecl ann ⟨_, name⟩ ⟨_, bases⟩ ⟨_, fields⟩ ⟨_, classVars⟩ ⟨_, subclasses⟩ ⟨_, methods⟩ ⟨_, exhaustive⟩ := d { @@ -481,7 +483,7 @@ private def DDM.ClassDecl.fromDDM (d : DDM.ClassDecl SourceRange) : Specs.ClassD exhaustive := exhaustive } -private def DDM.Command.fromDDM (cmd : DDM.Command SourceRange) : Specs.Signature := +def DDM.Command.fromDDM (cmd : DDM.Command SourceRange) : Specs.Signature := match cmd with | .externTypeDecl _ ⟨_, name⟩ ⟨_, ddmDefinition⟩ => if let some definition := PythonIdent.ofString ddmDefinition then @@ -501,7 +503,7 @@ private def DDM.Command.fromDDM (cmd : DDM.Command SourceRange) : Specs.Signatur .typeDef d /-- Reads Python spec signatures from a DDM Ion file. -/ -def readDDM (path : System.FilePath) : EIO String (Array Signature) := do +public def readDDM (path : System.FilePath) : EIO String (Array Signature) := do let contents ← match ← IO.FS.readBinFile path |>.toBaseIO with | .ok r => pure r @@ -518,16 +520,12 @@ def readDDM (path : System.FilePath) : EIO String (Array Signature) := do | .error msg => throw msg /-- Converts Python spec signatures to a DDM program for serialization. -/ -def toDDMProgram (sigs : Array Signature) : Strata.Program := { - dialects := DDM.PythonSpecs_map - dialect := DDM.PythonSpecs.name - commands := sigs.map fun s => s.toDDM.toAst - } +def toDDMProgram (sigs : Array Signature) : Strata.Program := + .create DDM.PythonSpecs_map DDM.PythonSpecs.name (sigs.map fun s => s.toDDM.toAst) /-- Writes Python spec signatures to a DDM Ion file. -/ -def writeDDM (path : System.FilePath) (sigs : Array Signature) : IO Unit := do +public def writeDDM (path : System.FilePath) (sigs : Array Signature) : IO Unit := do let pgm := toDDMProgram sigs IO.FS.writeBinFile path <| pgm.toIon end Strata.Python.Specs -end diff --git a/StrataTest/DDM/TypecheckSkip.lean b/StrataTest/DDM/TypecheckSkip.lean new file mode 100644 index 0000000000..eeb09f9730 --- /dev/null +++ b/StrataTest/DDM/TypecheckSkip.lean @@ -0,0 +1,218 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +import Strata.DDM.Integration.Lean + +/-! +# Tests for `dialect_option typecheck off;` + +When a dialect sets `dialect_option typecheck off;`, elaboration skips +`inferType` and `unifyTypes` for expression arguments. Implicit type +parameter slots are filled with anonymous type placeholders (`.tvar _ ""`). + +This allows programs to elaborate even when the type checker cannot infer +all type arguments — e.g., when a template-generated accessor with tvar +return type is composed with a polymorphic function that needs concrete +type arguments for unification. +-/ + +--------------------------------------------------------------------- +-- Dialect with typecheck ON (default). +-- Includes parameterized types (Lst), polymorphic functions with +-- implicit Type params (lst_select), and perField accessor templates +-- on parameterized datatypes (Maybe). +--------------------------------------------------------------------- + +#dialect +dialect TestTCOn; + +type Boole; +fn equal (tp : Type, a : tp, b : tp) : Boole => @[prec(15)] a " == " b; + +type Inte; +fn natToInt (n : Num) : Inte => n; + +type Lst (elem : Type); +fn lst_select (A : Type, s : Lst A, i : Inte) : A => + "Lst.sel" "(" s ", " i ")"; + +category Binding; +@[declare(name, tp)] +op mkBinding (name : Ident, tp : TypeP) : Binding => + @[prec(40)] name " : " tp; + +category Bindings; +@[scope(bindings)] +op mkBindings (bindings : CommaSepBy Binding) : Bindings => + " (" bindings ")"; + +category Constructor; +category ConstructorList; + +@[constructor(name, fields)] +op constructor_mk (name : Ident, fields : Option (CommaSepBy Binding)) : + Constructor => @[prec(50)] name "(" fields ")"; + +@[constructorListAtom(c)] +op constructorListAtom (c : Constructor) : ConstructorList => "\n " c; + +@[constructorListPush(cl, c)] +op constructorListPush (cl : ConstructorList, c : Constructor) + : ConstructorList => cl ",\n " c; + +category TypeVar; +@[declareTVar(name)] +op type_var (name : Ident) : TypeVar => name; + +category TypeArgs; +@[scope(args)] +op type_args (args : CommaSepBy TypeVar) : TypeArgs => "<" args ">"; + +category DatatypeDecl; +metadata declareDatatype (name : Ident, typeParams : Ident, + constructors : Ident, accessorTemplate : FunctionTemplate); + +@[declareDatatype(name, typeParams, constructors, + perField([.datatype, .literal "..", .field], + [.datatype], .fieldType))] +op datatype_decl (name : Ident, + typeParams : Option Bindings, + @[scopeTVar(typeParams)] constructors : ConstructorList) + : DatatypeDecl => + "datatype " name typeParams " {" constructors "\n}"; + +@[scope(datatypes), preRegisterTypes(datatypes)] +op command_datatypes (datatypes : NewlineSepBy DatatypeDecl) : Command => + datatypes ";\n"; + +@[declare(name, r)] +op command_constdecl (name : Ident, r : Type) : Command => + "const " name ":" r ";\n"; + +category Label; +op label (l : Ident) : Label => "[" l "]: "; + +category Statement; +category Block; + +op assert_stmt (label : Option Label, c : Boole) : Statement => + "assert " label c ";\n"; + +@[scope(c)] +op block (c : SemicolonSepBy Statement) : Block => + "{\n " indent(2, c) "}"; + +op command_procedure (name : Ident, + b : Bindings, + @[scope(b)] body : Block) : + Command => + "procedure " name b " returns ()\n" body ";\n"; +#end + +--------------------------------------------------------------------- +-- Same dialect with typecheck OFF. +-- Imports all declarations from TestTCOn but disables type checking. +-- The typecheck flag is a property of the program's primary dialect; +-- imported dialects' flags are not consulted during elaboration. +--------------------------------------------------------------------- + +#dialect +dialect TestTCOff; +import TestTCOn; +dialect_option typecheck off; +#end + +--------------------------------------------------------------------- +-- Test 1: Accessor result feeds into polymorphic fn. +-- +-- `Maybe..val(m)` returns `tvar "a"` (unresolved) because the +-- accessor template stores its type with tvars. When this flows into +-- `lst_select`, the type checker cannot infer the implicit `A : Type` +-- parameter via unification, producing an error. +-- +-- With typecheck off, no unification is attempted — the implicit type +-- param is filled with a skip placeholder and elaboration succeeds. +--------------------------------------------------------------------- + +/-- +error: Could not infer type parameter 2 for TestTCOn.lst_select +--- +error: Expression has type Inte when .|| expected. +-/ +#guard_msgs in +def typecheckOnFails := +#strata +program TestTCOn; + +datatype Maybe (a : Type) { Nothing(), Just(val: a) }; + +const m: Maybe (Lst Inte); + +procedure Test () returns () +{ + assert [t1]: Lst.sel(Maybe..val(m), 0) == 0; +}; +#end + +-- Same program with typecheck off — elaboration succeeds because +-- inferType/unifyTypes are skipped entirely for expression arguments. +def typecheckOffSucceeds := +#strata +program TestTCOff; + +datatype Maybe (a : Type) { Nothing(), Just(val: a) }; + +const m: Maybe (Lst Inte); + +procedure Test () returns () +{ + assert [t1]: Lst.sel(Maybe..val(m), 0) == 0; +}; +#end + +--------------------------------------------------------------------- +-- Test 2: Unresolved identifiers still fail with typecheck off. +-- +-- `typecheck off` only skips type inference/unification — name +-- resolution still operates normally. +--------------------------------------------------------------------- + +/-- +error: Unknown expr identifier undefined_name +-/ +#guard_msgs in +def typecheckOffStillCatchesUndefined := +#strata +program TestTCOff; + +procedure Test () returns () +{ + assert [t1]: undefined_name == 0; +}; +#end + +--------------------------------------------------------------------- +-- Test 3: Invalid dialect_option values produce clean errors. +--------------------------------------------------------------------- + +/-- +error: Expected 'on' or 'off' for option 'typecheck'. +-/ +#guard_msgs in +#dialect +dialect BadOptionValue; +dialect_option typecheck maybe; +#end + +/-- +error: Unknown option 'nonsense'. +-/ +#guard_msgs in +#dialect +dialect BadOptionName; +dialect_option nonsense on; +#end diff --git a/StrataTest/DL/Imperative/StepStmtTest.lean b/StrataTest/DL/Imperative/StepStmtTest.lean index ec26045867..15734ec0cc 100644 --- a/StrataTest/DL/Imperative/StepStmtTest.lean +++ b/StrataTest/DL/Imperative/StepStmtTest.lean @@ -508,7 +508,7 @@ theorem loopScopeTest : -- Need to reconcile the env shape. conv => rhs; rw [show Env.mk storeWithX miniEval false = { Env.mk (projectStore storeWithX storeWithXY) miniEval false with - hasFailure := false || false } from by simp [hproj, Bool.or_false]] + hasFailure := false || false } from by simp [hproj]] exact .step _ _ _ StepStmt.step_stmts_nil (.refl _) --------------------------------------------------------------------- diff --git a/StrataTestExtra/Languages/Python/SpecsTest.lean b/StrataTestExtra/Languages/Python/SpecsTest.lean index ff67b38e92..ef08c905ef 100644 --- a/StrataTestExtra/Languages/Python/SpecsTest.lean +++ b/StrataTestExtra/Languages/Python/SpecsTest.lean @@ -5,7 +5,7 @@ -/ module meta import Strata.Languages.Python.Specs -meta import Strata.Languages.Python.Specs.DDM +meta import all Strata.Languages.Python.Specs.DDM import Strata.DDM.Ion import Strata.Languages.Python.PythonDialect meta import StrataTest.Util.Python @@ -294,7 +294,7 @@ meta def warningTestCase : IO Unit := withPython fun pythonCmd => do meta def testNegRoundTrip (v : Nat) : Bool := - DDM.Int.ofDDM (.negInt SourceRange.none ⟨.none, v⟩) = .negOfNat v + DDM.Int.ofDDM (.negInt SourceRange.none ⟨.none, v⟩) = Int.negOfNat v #guard testNegRoundTrip 0 #guard testNegRoundTrip 1 diff --git a/Tools/Python/strata/base.py b/Tools/Python/strata/base.py index 54a22f729b..deb773984b 100644 --- a/Tools/Python/strata/base.py +++ b/Tools/Python/strata/base.py @@ -1048,6 +1048,7 @@ def __init__(self, name: str): self.name = name self.imports = [] self.decls = [] + self.typecheck = True def add_import(self, name: str): self.imports.append(name) @@ -1111,6 +1112,12 @@ def to_ion(self): d.add_item("type", _importSym) d.add_item("name", i) r.append(d) + if not self.typecheck: + d = ion.IonPyDict() + d.add_item("type", ion_symbol("option")) + d.add_item("name", "typecheck") + d.add_item("value", "off") + r.append(d) for d in self.decls: r.append(d.to_ion()) return r @@ -1158,6 +1165,14 @@ def from_ion(fp) -> 'Dialect': assert field == "name", f"Unexpected field {field}" read_struct_end(reader) dialect.add_import(value) + case "option": + (field, opt_name) = read_field_string(reader) + assert field == "name", f"Unexpected field {field}" + (field, opt_value) = read_field_string(reader) + assert field == "value", f"Unexpected field {field}" + read_struct_end(reader) + if opt_name == "typecheck": + dialect.typecheck = (opt_value == "on") case "syncat": read_syncatdecl(reader, dialect) case "op": diff --git a/docs/verso/DDMDoc.lean b/docs/verso/DDMDoc.lean index 14c6fe8a6b..55ba6da48d 100644 --- a/docs/verso/DDMDoc.lean +++ b/docs/verso/DDMDoc.lean @@ -191,6 +191,37 @@ declared. This includes transitive imports of the dialect being imported. Imports the dialect _ident_. ::: +## Dialect Options + +Dialect options configure elaboration behavior for programs using the dialect. + +:::paragraph +`dialect_option` _name_ _value_`;` + +Sets the dialect option _name_ to _value_. +::: + +The following options are supported: + +- `typecheck` (`on` | `off`, default `on`): When set to `off`, the elaborator + skips type inference and unification for expression arguments. Implicit type + parameter slots are filled with anonymous type placeholders. Variable name + resolution and global context population still operate normally. + + The flag is a property of the program's primary dialect; imported dialects' + flags are not consulted during elaboration. + + This is intended for cases where the type checker cannot infer implicit type + arguments — notably when template-generated accessors with unresolved type + variable return types are composed with polymorphic functions that require + concrete type arguments for unification. + + With `typecheck off`, type errors in a program are not detected at + elaboration time. They will surface at later pipeline stages (VC generation, + symbolic evaluation, SMT encoding) with less-helpful diagnostics. Only use + this option when the elaboration error is a known type-checker limitation + rather than a real type mismatch. + ## Syntactic Categories Syntactic categories are introduced by the `category` declaration: From 1af9382565600f27a2d45af49282147f1321f6a2 Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Tue, 19 May 2026 13:56:14 -0700 Subject: [PATCH 17/28] Structured pipeline diagnostics with PipelineM, phase timing, and --metrics JSONL (#1093) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit ## Motivation The pipeline previously had no unified infrastructure for diagnostics or timing. Warnings were handled ad-hoc (some printed to stderr, some silently dropped), phase timing was manual and inconsistent, and the only structured output (`--warning-summary`) wrote a single JSON blob at the end — useless if the process was killed by a timeout. There was also no distinction between fatal and non-fatal errors, so callers couldn't tell whether a result was trustworthy. This PR introduces `PipelineContext`/`PipelineM` as a shared backbone that gives every pipeline phase consistent behavior: categorized diagnostics, nested phase timing, fatal-error abort, and streaming metrics output that survives timeouts. ## Summary - Introduce `PipelineContext` and `PipelineM` for structured diagnostic accumulation and phase timing across the entire pipeline - Replace ad-hoc `profileStep`/`startPhase` with `withPhase` combinator that handles nesting, timing, and profile output via `try`/`finally` - Add `withRepeatedPhase` for iteration-level timing (preprocess, smtEncode, solver) that accumulates count+duration and reports as `[profile]` lines - Replace `--warning-summary` (single JSON blob) with `--metrics ` (streaming JSONL, flushed per-record for timeout resilience) - Add `--verbose` program dumps: prints intermediate Laurel and Core programs with `---- BEGIN/END ----` delimiters for programmatic parsing - Refactor module resolution: fatal errors on invalid/missing modules, unified `resolveModules` for dispatch, auto-resolved, and explicit modules - Fix `pyResolveOverloads` to print errors from pipeline context on failure - Split `Messages.lean` into data types (`Messages.lean`) and runtime infrastructure (`Context.lean`) - Move Python-specific `MessageKind` constants to `Languages/Python/Specs/MessageKind.lean` ## `PipelineContext` and `PipelineM` `PipelineContext` is a structure carrying immutable config (`outputMode`, `profilePipeline`) plus mutable state as individual `IO.Ref` fields: - `messagesRef` — accumulated `PipelineMessage` diagnostics - `toolErrorsRef` / `userCodeErrorsRef` — bucketed by impact for fast access - `currentPhaseRef` — current position in the phase hierarchy (managed via `push`/`pop`) - `repeatedDepthRef` — nesting depth of `withRepeatedPhase` scopes (when > 0, `withPhase` aggregates silently) - `phaseStateRef` — per-phase scoped state bundling repeated-phase aggregation and message counts (saved/restored atomically on phase entry/exit) - `metricsHandle` — optional file handle for streaming JSONL metrics Because all state is in `IO.Ref`s, any monad with `BaseIO` access can use pipeline capabilities by passing a `PipelineContext` value directly — `withPhase` is polymorphic over the monad (`[MonadLiftT BaseIO m]`). `PipelineM` is defined as: ```lean abbrev PipelineM := ReaderT PipelineContext (EIO Unit) ``` The `EIO Unit` base ensures that fatal errors (configuration errors, internal errors, user code issues) are impossible to silently ignore — they throw `()`, aborting the pipeline. Non-fatal diagnostics (warnings, known limitations) are added to `messagesRef` and execution continues. Callers that want to attempt recovery (e.g., to gather more diagnostics) can catch the exception, but should rethrow to avoid proceeding with invalid state. The top-level runner catches the exception and still returns all accumulated messages — so the caller always gets complete diagnostics regardless of how the pipeline terminated. ## Phase tracking state machine The phase system operates in two modes controlled by `repeatedDepthRef`: - **Mode N** (normal, depth = 0): `withPhase` prints `[start]`/`[end]` in profile mode and emits JSONL timing metrics. - **Mode R** (repeated, depth > 0): `withPhase` silently aggregates timing into `phaseStateRef.repeatedPhases` — no print, no individual metrics. `withRepeatedPhase` increments `repeatedDepthRef` on entry and decrements on exit. `withPhase` never changes the depth — it inherits the mode and behaves accordingly. Key invariants: - `currentPhaseRef` always reflects the innermost active scope's full path - `phaseStateRef` is scoped: saved on entry, restored on exit (no leakage) - In mode R, all timing flows through `phaseStateRef.repeatedPhases` only ## `--metrics ` (replaces `--warning-summary`) Writes streaming JSONL (one JSON object per line, flushed immediately after each record). If the process is killed mid-pipeline, all records should remain. Record types: - `timing` — phase start/end in ms, with optional count for aggregated phases - `diagnostic` — pipeline messages with phase, file, category, impact, location - `outcome` — result/exit_code/total_ms, written last (absence = killed) Example output: ```jsonl {"type":"timing","phase":"pythonAndSpecToLaurel","start_ms":0,"end_ms":97} {"type":"diagnostic","phase":"pythonAndSpecToLaurel.resolveAndBuildPrelude","file":"specs/builtins.ion","category":"unsupportedUnion","impact":"knownLimitation","message":"unsupported overload form for 'dict.update'"} {"type":"timing","phase":"verification.vcDischarge.solver","start_ms":0,"end_ms":1102,"count":12} {"type":"outcome","result":"verified","exit_code":0,"total_ms":1830} ``` ## `--verbose` program dumps When `outputMode == .verbose`, the pipeline prints intermediate programs to stdout with delimiters for programmatic parsing: ``` ---- BEGIN Laurel Program ---- ---- END Laurel Program ---- ---- BEGIN Core Program ---- ---- END Core Program ---- ``` ## Module resolution refactoring - `resolveModuleEntry` now takes a parsed `ModuleName` (not a string) - Single `resolveModules` handles dispatch, auto-resolved, and explicit modules - `invalidModuleName` changed from `internalWarning` to `configurationError` (fatal) - Merged `missingDispatchModule` + `missingExplicitPySpec` into `missingPySpecModule` - Eliminated duplicate message scenario where both invalid-name and missing-module errors fired for the same input ## `pyResolveOverloads` error handling When `readDispatchOverloads` encounters a fatal error (e.g., nonexistent file), the command now reads `pctx.messagesRef` and prints all accumulated messages to stderr before exiting with a non-zero code — instead of silently yielding empty results. ## Profile output format `--profile` emits structured `[start]`/`[end]`/`[profile]` lines to stdout: ``` [start] pythonAndSpecToLaurel (time: 0ms) [start] readPythonIon (time: 0ms) [end] readPythonIon (time: 2ms) [start] resolveAndBuildPrelude (time: 2ms) [end] resolveAndBuildPrelude (time: 97ms) [warnings] resolveAndBuildPrelude: 2 unsupportedUnion [end] pythonAndSpecToLaurel (time: 97ms) [start] verification (time: 105ms) [start] vcDischarge (time: 320ms) [profile] preprocess (×12, total: 45ms, avg: 3ms) [profile] solver (×12, total: 1102ms, avg: 91ms) [end] vcDischarge (time: 1185ms) [end] verification (time: 1185ms) ``` ## Design: impact drives behavior Each `MessageKind` has a `MessageImpact` that determines pipeline behavior: | Impact | Fatal? | Meaning | |--------|--------|---------| | `configurationError` | yes | Invalid arguments or unreadable on-disk pyspecs | | `internalError` | yes | Unexpected failure preventing output | | `userCodeIssue` | yes | Issue in the user's source code | | `internalWarning` | no | Unexpected condition that didn't prevent output | | `knownLimitation` | no | Documented gap in modeling | Note: `emitMessageAndAbort` is the function that aborts — callers choose whether to abort. A caller may use `emitMessage` (continues) and check `isFatal` at phase boundaries for custom abort strategies. ## Not addressed: `[statistics]` output The `[statistics]` lines (transform counters like `Evaluator.simulatedStmts`, `FilterProcedures.erasedProcedures`) are orthogonal to phase timing. They currently bypass `PipelineContext` — printed via bare `IO.println` in `Core.verify` and `StrataMainLib.lean` — so they don't respect phase nesting or indentation. Integrating statistics into the phase system is future work. ## Key files changed - `Strata/Pipeline/Messages.lean` — pure data types: `Phase`, `MessageImpact`, `MessageKind`, `PipelineMessage` - `Strata/Pipeline/Context.lean` — runtime: `PipelineContext`, `PipelineM`, `withPhase`, `withRepeatedPhase`, `emitMetric`, `OutputMode` - `Strata/Languages/Python/Specs/MessageKind.lean` — Python-specific `MessageKind` constants - `Strata/Pipeline/PyAnalyzeLaurel.lean` — top-level pipeline orchestration, `--verbose` program dumps, `metricsHandle` threading - `Strata/Languages/Core/Verifier.lean` — replaced manual timing with `withRepeatedPhase` - `Strata/Languages/Laurel/LaurelCompilationPipeline.lean` — replaced `profileStep` with `withPhase` - `Strata/Languages/Python/PySpecPipeline.lean` — fatal abort via throw, module resolution refactor, diagnostic metric emission - `StrataMainLib.lean` — `--metrics` flag, outcome record emission, error printing in `pyResolveOverloads` - `StrataTest/Pipeline/PhaseTimingTest.lean` — phase timing integration tests --------- Co-authored-by: Claude Opus 4.6 Co-authored-by: keyboardDrummer-bot Co-authored-by: June Lee --- .github/scripts/testStrataCommand.sh | 9 + Strata.lean | 3 + Strata/DL/Imperative/SMTUtils.lean | 11 +- Strata/Languages/Core/Verifier.lean | 217 +++++----- .../Laurel/LaurelCompilationPipeline.lean | 15 +- .../Laurel/LaurelToCoreTranslator.lean | 2 +- Strata/Languages/Python/OverloadTable.lean | 14 +- Strata/Languages/Python/PySpecPipeline.lean | 293 +++++++------- Strata/Languages/Python/PythonToLaurel.lean | 8 +- Strata/Languages/Python/Specs.lean | 27 +- Strata/Languages/Python/Specs/Error.lean | 75 ---- .../Languages/Python/Specs/MessageKind.lean | 73 ++++ Strata/Languages/Python/Specs/ToLaurel.lean | 49 ++- Strata/Pipeline/Context.lean | 369 ++++++++++++++++++ Strata/Pipeline/Diagnostic.lean | 42 ++ Strata/Pipeline/Messages.lean | 133 +++++++ Strata/Pipeline/PyAnalyzeLaurel.lean | 140 +++++++ Strata/SimpleAPI.lean | 14 +- Strata/Util/FileRange.lean | 2 +- Strata/Util/Profile.lean | 18 - StrataMainLib.lean | 289 +++++++------- StrataTest/DL/Imperative/Verify.lean | 4 +- .../Languages/Core/Tests/ExprEvalTest.lean | 3 +- .../Languages/Core/Tests/SMTEncoderTests.lean | 16 +- .../Languages/Python/PySpecArgTypeTest.lean | 8 +- StrataTest/Languages/Python/TestExamples.lean | 12 +- StrataTest/Languages/Python/ToLaurelTest.lean | 254 +++++++++++- StrataTest/Languages/Python/run_py_analyze.sh | 37 ++ StrataTest/Pipeline/PhaseTimingTest.lean | 131 +++++++ .../Languages/Python/AnalyzeLaurelTest.lean | 67 +++- .../Python/Specs/IdentifyOverloadsTest.lean | 9 +- 31 files changed, 1748 insertions(+), 596 deletions(-) delete mode 100644 Strata/Languages/Python/Specs/Error.lean create mode 100644 Strata/Languages/Python/Specs/MessageKind.lean create mode 100644 Strata/Pipeline/Context.lean create mode 100644 Strata/Pipeline/Diagnostic.lean create mode 100644 Strata/Pipeline/Messages.lean create mode 100644 Strata/Pipeline/PyAnalyzeLaurel.lean delete mode 100644 Strata/Util/Profile.lean create mode 100644 StrataTest/Pipeline/PhaseTimingTest.lean diff --git a/.github/scripts/testStrataCommand.sh b/.github/scripts/testStrataCommand.sh index ced57ce5f6..f584d591b3 100755 --- a/.github/scripts/testStrataCommand.sh +++ b/.github/scripts/testStrataCommand.sh @@ -81,6 +81,15 @@ $strata print --include Examples/dialects Examples/dialects/Arith.dialect.st > " # Print Ion file and compare with previous run $strata print --include Examples/dialects "$temp_dir/Arith.dialect.st.ion" | cmp - "$temp_dir/Arith.dialect.st" +# --- pyResolveOverloads error handling --- +set +e + +expect_error "pyResolveOverloads missing dispatch file" \ + "nonexistent_dispatch.ion" \ + $strata pyResolveOverloads Examples/SimpleProc.core.st nonexistent_dispatch.ion + +set -e + if [ $failed -ne 0 ]; then echo "Some tests failed." exit 1 diff --git a/Strata.lean b/Strata.lean index ee70beef36..4f094503e4 100644 --- a/Strata.lean +++ b/Strata.lean @@ -68,4 +68,7 @@ import Strata.MetaVerifier /- Simple API -/ import Strata.SimpleAPI +/- Pipeline -/ +import Strata.Pipeline.PyAnalyzeLaurel + -- noimport: Strata.Util.Random -- deletion candidate: nothing imports this module diff --git a/Strata/DL/Imperative/SMTUtils.lean b/Strata/DL/Imperative/SMTUtils.lean index a5ec0c1a59..541ec17d98 100644 --- a/Strata/DL/Imperative/SMTUtils.lean +++ b/Strata/DL/Imperative/SMTUtils.lean @@ -10,6 +10,7 @@ import Strata.DL.SMT.DDMTransform.Parse import Strata.DL.SMT.DDMTransform.Translate import Strata.DDM.Elab import Strata.DDM.Format +public import Strata.Pipeline.Context public import Strata.DL.Imperative.PureExpr public import Strata.DL.Imperative.EvalContext @@ -373,20 +374,22 @@ def dischargeObligation {P : PureExpr} [ToFormat P.Ident] [BEq P.Ident] (smtsolver filename : String) (solver_options : Array String) (printFilename : Bool) (satisfiabilityCheck validityCheck : Bool) - (skipSolver : Bool := false) : + (skipSolver : Bool := false) + (pctx : Strata.Pipeline.PipelineContext) : IO (Except SolverError (Result P.Ident × Result P.Ident × Strata.SMT.EncoderState)) := do let handle ← IO.FS.Handle.mk filename IO.FS.Mode.write let solver ← Strata.SMT.Solver.fileWriter handle - -- encodeSMT (which calls encodeCore) emits check-sat commands internally - let ((_ids, estate), _solverState) ← encodeSMT.run solver + let ((_ids, estate), _solverState) ← pctx.withPhase "encodeSMT" do + encodeSMT.run solver if printFilename then IO.println s!"Wrote problem to {filename}." if skipSolver then return .ok (.unknown, .unknown, estate) - let solver_output ← runSolver smtsolver (#[filename] ++ solver_options) + let solver_output ← pctx.withPhase "runSolver" do + runSolver smtsolver (#[filename] ++ solver_options) match ← solverResult typedVarToSMTFn vars solver_output estate smtsolver satisfiabilityCheck validityCheck with | .error e => return .error e | .ok (satResult, validityResult) => return .ok (satResult, validityResult, estate) diff --git a/Strata/Languages/Core/Verifier.lean b/Strata/Languages/Core/Verifier.lean index 8763abab03..53a8259b8a 100644 --- a/Strata/Languages/Core/Verifier.lean +++ b/Strata/Languages/Core/Verifier.lean @@ -23,7 +23,9 @@ import Strata.Transform.LoopElim import Strata.Transform.ANFEncoder import Strata.Languages.Core.ObligationExtraction public import Strata.Transform.IrrelevantAxioms -import Strata.Util.Profile +import Strata.Pipeline.Context + +open Strata.Pipeline (PipelineContext) --------------------------------------------------------------------- @@ -347,88 +349,96 @@ def encodeCore (ctx : Core.SMT.Context) (prelude : SolverM Unit) (satisfiabilityCheck validityCheck : Bool) (label : String) (varDefinitions : List Core.VarDefinition := []) - (varDeclarations : List Core.VarDeclaration := []) : + (varDeclarations : List Core.VarDeclaration := []) + (pctx : PipelineContext) : SolverM (List String × EncoderState) := do + let phase {α} (name : String) (action : SolverM α) : SolverM α := + pctx.withRepeatedPhase name action Solver.setLogic "ALL" - prelude + phase "prelude" do + prelude + let _ ← ctx.sorts.mapM (fun s => Solver.declareSort s.name s.arity) ctx.emitDatatypes useArrayTheory let varDefNames := varDefinitions.map (·.name) let varDeclNames := varDeclarations.map (·.name) let managedNames := varDefNames ++ varDeclNames - -- Filter out managed variables from UF declarations (they will be emitted separately) - let ufsToDecl := if managedNames.isEmpty then ctx.ufs - else ctx.ufs.filter fun uf => !managedNames.contains uf.id - let (_ufs, estate) ← ufsToDecl.mapM (fun uf => encodeUF uf) |>.run EncoderState.init - -- Pre-populate encoder state with managed variable names so encodeTerm - -- recognizes them without emitting declare-fun - let estate := if managedNames.isEmpty then estate - else - let managedUfs := ctx.ufs.filter fun uf => managedNames.contains uf.id - managedUfs.foldl (init := estate) fun estate uf => - { estate with ufs := estate.ufs.insert uf uf.id } - let (_ifs, estate) ← ctx.ifs.mapM (fun fn => encodeFunction fn.uf fn.body) |>.run estate - let (_axms, estate) ← ctx.axms.mapM (fun ax => encodeTerm ax) |>.run estate + + let estate ← phase "encodeUFs" do + let ufsToDecl := if managedNames.isEmpty then ctx.ufs + else ctx.ufs.filter fun uf => !managedNames.contains uf.id + let (_ufs, estate) ← ufsToDecl.mapM (fun uf => encodeUF uf) |>.run EncoderState.init + pure estate + + let estate ← phase "encodeFunctions" do + let estate := if managedNames.isEmpty then estate + else + let managedUfs := ctx.ufs.filter fun uf => managedNames.contains uf.id + managedUfs.foldl (init := estate) fun estate uf => + { estate with ufs := estate.ufs.insert uf uf.id } + let (_ifs, estate) ← ctx.ifs.mapM (fun fn => encodeFunction fn.uf fn.body) |>.run estate + pure estate + + let (_axms, estate) ← phase "encodeAxioms" do + ctx.axms.mapM (fun ax => encodeTerm ax) |>.run estate + for id in _axms do Solver.assert id -- Emit variable declarations as declare-fun for decl in varDeclarations do Solver.declareFun decl.name [] decl.ty + -- Emit variable definitions as define-fun (macro expansions, not constraints) - let estate ← varDefinitions.foldlM (init := estate) fun estate def_ => do - let (bodyEnc, estate) ← (encodeTerm def_.body) |>.run estate - Solver.defineFunTerm def_.name [] def_.ty bodyEnc - pure estate - -- Assert assumption terms - let (assumptionIds, estate) ← assumptionTerms.mapM (encodeTerm) |>.run estate + let estate ← phase "defineFunTerms" do + varDefinitions.foldlM (init := estate) fun estate def_ => do + let (bodyEnc, estate) ← (encodeTerm def_.body) |>.run estate + Solver.defineFunTerm def_.name [] def_.ty bodyEnc + pure estate + + let (assumptionIds, estate) ← phase "encodeAssumptions" do + assumptionTerms.mapM (encodeTerm) |>.run estate + for id in assumptionIds do Solver.assert id - -- Encode the obligation term Q (not negated) - let (obligationId, estate) ← (encodeTerm obligationTerm) |>.run estate - let ids := estate.ufs.toList.filterMap fun (uf, id) => - if uf.args.isEmpty && !managedNames.contains uf.id then some id else none + let (obligationId, estate) ← phase "encodeObligation" do + (encodeTerm obligationTerm) |>.run estate - -- Choose encoding strategy: use check-sat-assuming only when doing both checks - let bothChecks := satisfiabilityCheck && validityCheck - - if bothChecks then - -- Satisfiability check: P ∧ Q satisfiable? - Solver.comment "Satisfiability" - Imperative.SMT.addLocationInfo (P := Core.Expression) (md := md) - (message := ("sat-message", "Property can be satisfied")) - let obligationStr ← Solver.termToSMTString obligationId - let _ ← Solver.checkSatAssuming [obligationStr] ids - - -- Validity check: P ∧ ¬Q satisfiable? - Solver.comment "Validity" - Imperative.SMT.addLocationInfo (P := Core.Expression) (md := md) - (message := ("unsat-message", "Property is always true")) - let negObligationStr := s!"(not {obligationStr})" - let _ ← Solver.checkSatAssuming [negObligationStr] ids - else - if satisfiabilityCheck then - -- P ∧ Q satisfiable? + let ids ← phase "epilog" do + let ids := estate.ufs.toList.filterMap fun (uf, id) => + if uf.args.isEmpty && !managedNames.contains uf.id then some id else none + + let bothChecks := satisfiabilityCheck && validityCheck + + if bothChecks then Solver.comment "Satisfiability" Imperative.SMT.addLocationInfo (P := Core.Expression) (md := md) (message := ("sat-message", "Property can be satisfied")) - Solver.assert obligationId - let _ ← Solver.checkSat ids - else if validityCheck then - -- P ∧ ¬Q satisfiable? + let obligationStr ← Solver.termToSMTString obligationId + let _ ← Solver.checkSatAssuming [obligationStr] ids + Solver.comment "Validity" Imperative.SMT.addLocationInfo (P := Core.Expression) (md := md) (message := ("unsat-message", "Property is always true")) - Solver.assert (← encodeTerm (Factory.not obligationTerm) |>.run estate).1 - let _ ← Solver.checkSat ids - - -- Emit the property summary (or label) as the final message in the SMT-LIB output. - -- Use `setInfoString` so the value is quoted and escaped per SMT-LIB 2.6+ - -- (doubled `""` for embedded quotes). C-style `\"` escaping would be rejected - -- by SMT-LIB consumers: backslash is a literal character in string contexts, - -- and the following `"` would close the string. - let rawMsg := md.getPropertySummary.getD label - Solver.setInfoString "final-message" rawMsg + let negObligationStr := s!"(not {obligationStr})" + let _ ← Solver.checkSatAssuming [negObligationStr] ids + else + if satisfiabilityCheck then + Solver.comment "Satisfiability" + Imperative.SMT.addLocationInfo (P := Core.Expression) (md := md) + (message := ("sat-message", "Property can be satisfied")) + Solver.assert obligationId + let _ ← Solver.checkSat ids + else if validityCheck then + Solver.comment "Validity" + Imperative.SMT.addLocationInfo (P := Core.Expression) (md := md) + (message := ("unsat-message", "Property is always true")) + Solver.assert (← encodeTerm (Factory.not obligationTerm) |>.run estate).1 + let _ ← Solver.checkSat ids + + let rawMsg := md.getPropertySummary.getD label + Solver.setInfoString "final-message" rawMsg + pure ids return (ids, estate) @@ -499,6 +509,7 @@ def dischargeObligation (label : String) (varDefinitions : List VarDefinition := []) (varDeclarations : List VarDeclaration := []) + (pctx : PipelineContext) : IO (Except Imperative.SMT.SolverError (SMT.Result × SMT.Result × EncoderState)) := do -- CVC5 requires --incremental for multiple (check-sat) commands let baseFlags := getSolverFlags options @@ -512,7 +523,8 @@ def dischargeObligation (P := Core.Expression) (Strata.SMT.Encoder.encodeCore ctx (getSolverPrelude options.solver) assumptionTerms obligationTerm md options.useArrayTheory satisfiabilityCheck validityCheck - (label := label) (varDefinitions := varDefinitions) (varDeclarations := varDeclarations)) + (label := label) (varDefinitions := varDefinitions) (varDeclarations := varDeclarations) + (pctx := pctx)) (typedVarToSMTFn ctx) vars options.solver @@ -520,6 +532,7 @@ def dischargeObligation solverFlags (options.verbose > .normal) satisfiabilityCheck validityCheck (skipSolver := options.skipSolver) + (pctx := pctx) /-- Discharge a proof obligation using the incremental solver backend. Spawns a live solver process, sends commands via stdin/stdout, and @@ -1294,7 +1307,8 @@ abbrev CoreSMTSolver := can replace the default (batch/incremental SMT-LIB) backend. -/ abbrev MkDischargeFn := VerifyOptions → IO.Ref Nat → System.FilePath → - List Expression.TypedIdent → Imperative.MetaData Expression → String → DischargeFn + List Expression.TypedIdent → Imperative.MetaData Expression → String → + PipelineContext → DischargeFn /-- Construct a `DischargeFn` from verification options. Selects the incremental (abstract solver) backend or the batch (SMT-LIB file) backend based on @@ -1303,7 +1317,8 @@ def mkDischargeFn : MkDischargeFn := fun (options : VerifyOptions) (counter : IO (tempDir : System.FilePath) (vars : List Expression.TypedIdent) (md : Imperative.MetaData Expression) - (label : String) => + (label : String) + (pctx : PipelineContext) => fun assumptionTerms obligationTerm ctx satisfiabilityCheck validityCheck varDefinitions varDeclarations => do if options.incremental && !options.alwaysGenerateSMT then @@ -1317,6 +1332,7 @@ def mkDischargeFn : MkDischargeFn := fun (options : VerifyOptions) (counter : IO SMT.dischargeObligation options vars md filename.toString assumptionTerms obligationTerm ctx satisfiabilityCheck validityCheck (label := label) (varDefinitions := varDefinitions) (varDeclarations := varDeclarations) + (pctx := pctx) /-- Invoke a backend engine and get the analysis result for a @@ -1379,7 +1395,7 @@ def getObligationResult (assumptionTerms : List Term) (obligationTerm : Term) lexprModel := model } return result - +private def verifySingleEnv (oblProgram : Program) (moreFns : @Lambda.Factory CoreLParams := Lambda.Factory.default) (options : VerifyOptions) @@ -1393,23 +1409,19 @@ def verifySingleEnv (oblProgram : Program) (axiomProgram : Option Program := .none) (externalPhases : List AbstractedPhase := []) (corePhases : List AbstractedPhase := coreAbstractedPhases) - (mkDischarge : MkDischargeFn := mkDischargeFn) : + (mkDischarge : MkDischargeFn := mkDischargeFn) + (pctx : PipelineContext) : EIO DiagnosticModel (VCResults × Statistics) := do -- Build SMT encoding context from the obligations program itself let E ← EIO.ofExcept (Core.buildEnv options oblProgram moreFns (registerCustomFunctions := true) |>.map (·.1)) let p := E.program - let profile := options.profile - -- Extract obligations from the obligations program via ObligationExtraction + -- Extract obligations from the obligations program via ObligationExtraction let obligations ← match Core.ObligationExtraction.extractObligations oblProgram with | .ok obs => pure obs | .error e => .error (DiagnosticModel.fromFormat f!"ObligationExtraction error: {e}") let mut stats : Statistics := ({} : Statistics) |>.increment s!"{Evaluator.Stats.verify_numObligations}" obligations.size let mut results := (#[] : VCResults) - let mut preprocessNs : Nat := 0 - let mut smtEncodeNs : Nat := 0 - let mut solverNs : Nat := 0 - let mut peResolvedCount : Nat := 0 for obligation in obligations do -- Determine which checks to perform based on metadata or check mode/amount let (satisfiabilityCheck, validityCheck) := @@ -1423,10 +1435,8 @@ def verifySingleEnv (oblProgram : Program) | .deductive, _ => if obligation.property.passWhenUnreachable then (false, true) else (true, false) | .bugFinding, _ => (true, false) - let t0 ← IO.monoNanosNow - let (obligation, peSatResult?, peValResult?) ← preprocessObligation obligation p options satisfiabilityCheck validityCheck axiomCache axiomNames axiomProgram - let t1 ← IO.monoNanosNow - preprocessNs := preprocessNs + (t1 - t0) + let (obligation, peSatResult?, peValResult?) ← pctx.withRepeatedPhase "preprocess" do + preprocessObligation obligation p options satisfiabilityCheck validityCheck axiomCache axiomNames axiomProgram -- If evaluator resolved both checks, we're done, unless we always want to generate SMT queries if not options.alwaysGenerateSMT then if let (some peSat, some peVal) := (peSatResult?, peValResult?) then @@ -1442,7 +1452,6 @@ def verifySingleEnv (oblProgram : Program) let result : VCResult := { obligation, outcome := .ok outcome, verbose := options.verbose, checkLevel := options.checkLevel, checkMode := options.checkMode, lexprModel := [] } results := results.push result - peResolvedCount := peResolvedCount + 1 if result.isFailure || result.isImplementationError || result.isTimeout then if options.verbose >= .debug then let prog := f!"\n\n[DEBUG] Evaluated program:\n{Core.formatProgram p}" @@ -1452,10 +1461,9 @@ def verifySingleEnv (oblProgram : Program) -- Need the solver for at least one check let needSatCheck := satisfiabilityCheck && peSatResult?.isNone let needValCheck := validityCheck && peValResult?.isNone - let t2 ← IO.monoNanosNow - let maybeTerms := ProofObligation.toSMTTerms E obligation { SMT.Context.default with uniqueBoundNames := options.uniqueBoundNames } options.useArrayTheory - let t3 ← IO.monoNanosNow - smtEncodeNs := smtEncodeNs + (t3 - t2) + let maybeTerms ← pctx.withRepeatedPhase "smtEncode" do + let smtCtx := { SMT.Context.default with uniqueBoundNames := options.uniqueBoundNames } + pure (ProofObligation.toSMTTerms E obligation smtCtx options.useArrayTheory) match maybeTerms with | .error err => let result := { obligation, @@ -1482,13 +1490,11 @@ def verifySingleEnv (oblProgram : Program) | .some ty => return (v,LTy.forAll [] ty) | .none => throw (DiagnosticModel.fromMessage s!"{v} untyped")) let discharge := mkDischarge options counter tempDir - typedVarsInObligation obligation.metadata obligation.label - let t4 ← IO.monoNanosNow - let result ← getObligationResult assumptionTerms obligationTerm ctx obligation p options + typedVarsInObligation obligation.metadata obligation.label pctx + let result ← pctx.withRepeatedPhase "solver" do + getObligationResult assumptionTerms obligationTerm ctx obligation p options discharge needSatCheck needValCheck (externalPhases ++ corePhases) (varDefinitions := varDefs) (varDeclarations := varDecls) - let t5 ← IO.monoNanosNow - solverNs := solverNs + (t5 - t4) -- Merge evaluator results with solver results let result := match result.outcome with | .ok solverOutcome => @@ -1504,11 +1510,6 @@ def verifySingleEnv (oblProgram : Program) let prog := f!"\n\n[DEBUG] Evaluated program:\n{Core.formatProgram p}" dbg_trace f!"\n\nResult: {result}\n{prog}" if options.stopOnFirstError then break - if profile then - let _ ← (IO.println s!"[profile] Preprocess obligations: {nsToMs preprocessNs}ms" |>.toBaseIO) - let _ ← (IO.println s!"[profile] SMT encoding: {nsToMs smtEncodeNs}ms" |>.toBaseIO) - let _ ← (IO.println s!"[profile] Solver/file writing: {nsToMs solverNs}ms" |>.toBaseIO) - let _ ← (IO.println s!"[profile] Obligations: {obligations.size} total, {peResolvedCount} resolved by evaluator" |>.toBaseIO) return (results, stats) /-- Construct the default `CoreSMTSolver` that discharges obligations @@ -1523,11 +1524,13 @@ def mkDefaultCoreSMTSolver (axiomProgram : Option Program := .none) (externalPhases : List AbstractedPhase := []) (corePhases : List AbstractedPhase := coreAbstractedPhases) - (mkDischarge : MkDischargeFn := mkDischargeFn) : + (mkDischarge : MkDischargeFn := mkDischargeFn) + (pctx : PipelineContext) : CoreSMTSolver := fun moreFns oblProgram => verifySingleEnv oblProgram moreFns options counter tempDir axiomCache - axiomNames axiomProgram externalPhases corePhases (mkDischarge := mkDischarge) + axiomNames axiomProgram externalPhases corePhases + (mkDischarge := mkDischarge) pctx /-- Run the Strata Core verification pipeline on a program: transform, type-check, partially evaluate, and discharge proof obligations via SMT. @@ -1546,12 +1549,19 @@ def verify (program : Program) (keepAllFilesPrefix : Option String := none) (solver : Option CoreSMTSolver := none) (mkDischarge : MkDischargeFn := mkDischargeFn) + (pipelineCtx : Option PipelineContext := none) : EIO DiagnosticModel VCResults := do let profile := options.profile + let pctx ← match pipelineCtx with + | some ctx => pure ctx + | none => + let mode := if profile then Strata.Pipeline.OutputMode.profile else .quiet + (PipelineContext.create (outputMode := mode) : BaseIO _) + let factory ← EIO.ofExcept (Core.Factory.addFactory moreFns) let pipelinePhases := prefixPhases ++ corePipelinePhases (procs := proceduresToVerify) (options := options) (moreFns := moreFns) let phases := pipelinePhases.map (·.phase) - let (oblProgram, pipelineStats) ← profileStep profile " Program transformations" do + let (oblProgram, pipelineStats) ← pctx.withPhase "programTransformations" do if let some pfx := keepAllFilesPrefix then if let some parent := (System.FilePath.mk pfx).parent then IO.toEIO (fun e => DiagnosticModel.fromFormat f!"{e}") @@ -1559,10 +1569,13 @@ def verify (program : Program) let mut current := program let mut state : Transform.CoreTransformState := { Transform.CoreTransformState.emp with factory := some factory } let mut step := 0 + have : Inhabited (Except Transform.Err Program × Transform.CoreTransformState) := + ⟨(.error default, Transform.CoreTransformState.emp)⟩ for pp in pipelinePhases do - let (result, newState) := Transform.runWith current (fun prog => do - let (_, next) ← pp.transform prog - return next) state + let (result, newState) ← pctx.withRepeatedPhasePure pp.phase.name fun () => + Transform.runWith current (fun prog => do + let (_, next) ← pp.transform prog + return next) state match result with | .ok next => current := next @@ -1576,26 +1589,20 @@ def verify (program : Program) throw e .ok (current, state.statistics) let allStats := pipelineStats - -- Extract axiom names from the original program. The oblProgram (output of - -- toCoreProofObligationProgram) inlines axioms as assume statements but does - -- not preserve axiom declarations, so we use the pre-transform program for - -- axiom identity. let axiomNames := program.decls.filterMap fun decl => match decl with | .ax a _ => some a.name | _ => none - -- Build the axiom relevance cache from the original program (which has - -- axiom declarations). The cache is reused across all obligations. - let axiomCache? ← profileStep profile " Build axiom relevance cache" do + let axiomCache? ← pctx.withPhase "buildAxiomCache" do pure (if options.removeIrrelevantAxioms == .Off then .none else .some (IrrelevantAxioms.Cache.build program)) let counter ← IO.toEIO (fun e => DiagnosticModel.fromFormat f!"{e}") (IO.mkRef 0) - let VCss ← profileStep profile " VC discharge" do + let VCss ← pctx.withPhase "vcDischarge" do if options.checkOnly then pure [] else let coreSMTSolver := solver.getD (mkDefaultCoreSMTSolver options counter tempDir axiomCache? axiomNames (axiomProgram := program) externalPhases phases - (mkDischarge := mkDischarge)) + (mkDischarge := mkDischarge) pctx) pure [← coreSMTSolver moreFns oblProgram] let allStats := VCss.foldl (fun acc (_, s) => acc.merge s) allStats if profile then diff --git a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean index c6984120fe..e809401ccc 100644 --- a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean +++ b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean @@ -12,7 +12,6 @@ import Strata.Languages.Laurel.EliminateValueReturns import Strata.Languages.Laurel.ConstrainedTypeElim import Strata.Languages.Laurel.TypeAliasElim import Strata.Languages.Core.Verifier -import Strata.Util.Profile import Strata.Util.Statistics /-! @@ -144,7 +143,8 @@ When `keepAllFilesPrefix` is provided (via the `PipelineM` context), the program state after each named Laurel pass is written to `{prefix}.{n}.{passName}.laurel.st`. -/ -private def runLaurelPasses (options : LaurelTranslateOptions) (program : Program) +private def runLaurelPasses (options : LaurelTranslateOptions) + (pctx : Strata.Pipeline.PipelineContext) (program : Program) : PipelineM (Program × SemanticModel × List DiagnosticModel × Statistics) := do let program := { program with staticProcedures := coreDefinitionsForLaurel.staticProcedures ++ program.staticProcedures, @@ -172,8 +172,7 @@ private def runLaurelPasses (options : LaurelTranslateOptions) (program : Progra let mut allStats : Statistics := {} for pass in laurelPipeline do - let (program', diags, stats) ← profileStep options.profile s!" {pass.name}" do - pure (pass.run program model) + let (program', diags, stats) ← pctx.withPhase pass.name do pure (pass.run program model) program := program' allDiags := allDiags ++ diags allStats := allStats.merge stats @@ -193,9 +192,13 @@ When `keepAllFilesPrefix` is provided, the program state after each named Laurel-to-Laurel pass is written to `{prefix}.{n}.{passName}.laurel.st`. -/ def translateWithLaurel (options : LaurelTranslateOptions) (program : Program) - : IO TranslateResultWithLaurel := + (pipelineCtx : Option Strata.Pipeline.PipelineContext := none) + : IO TranslateResultWithLaurel := do + let pctx ← match pipelineCtx with + | some ctx => pure ctx + | none => Strata.Pipeline.PipelineContext.create (outputMode := .quiet) runPipelineM options.keepAllFilesPrefix do - let (program, model, passDiags, stats) ← runLaurelPasses options program + let (program, model, passDiags, stats) ← runLaurelPasses options pctx program let ordered := orderProgram program -- This early return is a simple way to protect against duplicative errors. Without this return, diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index beb50ad9b0..04c307520f 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -25,6 +25,7 @@ public import Strata.Languages.Laurel.CoreDefinitionsForLaurel public import Strata.Languages.Laurel.CoreGroupingAndOrdering import Strata.DDM.Util.DecimalRat import Strata.DL.Imperative.Stmt +import Strata.Pipeline.Messages import Strata.DL.Imperative.MetaData import Strata.DL.Lambda.LExpr import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator @@ -624,7 +625,6 @@ structure LaurelTranslateOptions where inlineFunctionsWhenPossible : Bool := false overflowChecks : Core.OverflowChecks := {} keepAllFilesPrefix : Option String := none - profile : Bool := false instance : Inhabited LaurelTranslateOptions where default := {} diff --git a/Strata/Languages/Python/OverloadTable.lean b/Strata/Languages/Python/OverloadTable.lean index 4375358854..e853cfcc7d 100644 --- a/Strata/Languages/Python/OverloadTable.lean +++ b/Strata/Languages/Python/OverloadTable.lean @@ -44,10 +44,9 @@ N.B. Current limitations: dispatch is always on the first positional argument or the matching keyword argument, and only string literal values are extracted. -/ structure FunctionOverloads where /-- Expected keyword argument name for dispatch (from the PySpec). -/ - paramName : Option String := none + paramName : String /-- Literal value → return type. -/ entries : Std.HashMap String PythonIdent := {} -deriving Inhabited /-- Find the dispatch argument value from positional or keyword arguments. Prefers the first positional arg; falls back to the keyword arg whose @@ -56,10 +55,15 @@ def FunctionOverloads.findDispatchArg (fo : FunctionOverloads) (positionalArgs : Array α) (kwargPairs : List (Option String × α)) : Option α := - if h : positionalArgs.size > 0 then some positionalArgs[0] - else fo.paramName.bind fun expected => + if h : positionalArgs.size > 0 then + some positionalArgs[0] + else + let expected := fo.paramName kwargPairs.findSome? fun (name?, value) => - if name? == some expected then some value else none + if name? == some expected then + some value + else + none /-- Dispatch table: function name → its overloads. -/ @[expose] abbrev OverloadTable := Std.HashMap String FunctionOverloads diff --git a/Strata/Languages/Python/PySpecPipeline.lean b/Strata/Languages/Python/PySpecPipeline.lean index dfae2b2a60..f0bc843efb 100644 --- a/Strata/Languages/Python/PySpecPipeline.lean +++ b/Strata/Languages/Python/PySpecPipeline.lean @@ -5,20 +5,21 @@ -/ module +import all Strata.DDM.Util.String import Strata.Languages.Laurel.FilterPrelude import Strata.Languages.Laurel.LaurelCompilationPipeline -public import Strata.Util.Statistics public import Strata.Languages.Python.PythonToLaurel import Strata.Languages.Python.ReadPython import Strata.Languages.Python.PythonLaurelCorePrelude import Strata.Languages.Python.PythonRuntimeLaurelPart import Strata.Languages.Python.Specs import Strata.Languages.Python.Specs.DDM -public import Strata.Languages.Python.Specs.Error import Strata.Languages.Python.Specs.IdentifyOverloads +import Strata.Languages.Python.Specs.MessageKind import Strata.Languages.Python.Specs.ToLaurel +public import Strata.Pipeline.Context import Strata.Util.DecideProp -import Strata.Util.Profile +public import Strata.Util.Statistics /-! ## PySpec Pipeline @@ -29,6 +30,7 @@ and translates through to Core for verification. namespace Strata +open Pipeline (emitMessage emitMessageAndAbort) open Python (OverloadTable) /-! ### Types -/ @@ -42,8 +44,7 @@ public structure PySpecLaurelResult where typeAliases : Std.HashMap String String := {} /-- Classes whose spec is considered exhaustive (lists all methods). -/ exhaustiveClasses : Std.HashSet String := {} - /-- Warnings collected during PySpec translation. -/ - pyspecWarnings : Array Python.Specs.SpecError := #[] + deriving Inhabited /-! ### Private Helpers -/ @@ -117,12 +118,11 @@ private def extractFunctionSignatures (sigs : Array Python.Specs.Signature) private def mergeOverloads (old new : OverloadTable) : OverloadTable := new.fold (init := old) fun o name n => - o.alter name fun s => - let existing := s.getD {} - some { paramName := existing.paramName <|> n.paramName - entries := existing.entries.union n.entries } - - + o.alter name fun + | some existing => + some { paramName := existing.paramName + entries := existing.entries.union n.entries } + | none => some n /-- Read PySpec Ion files and collect their Laurel declarations and overload tables into a single combined result. Each Ion file is parsed and translated @@ -133,97 +133,132 @@ private def mergeOverloads (old new : OverloadTable) : OverloadTable := Each entry is a `(modulePrefix, ionPath)` pair. The `modulePrefix` is used to namespace all generated Laurel names (e.g., `"servicelib_Storage"` for module `servicelib.Storage`). -/ -public def buildPySpecLaurel (pyspecEntries : Array (String × String)) - (overloads : OverloadTable) : EIO String PySpecLaurelResult := do +private def buildPySpecLaurelM (pyspecEntries : Array (String × String)) + (overloads : OverloadTable) : Pipeline.PipelineM PySpecLaurelResult := do let mut combinedProcedures : Array (Laurel.Procedure × String) := #[] let mut combinedTypes : Array (Laurel.TypeDefinition × String) := #[] let mut allOverloads := overloads let mut funcSigs : Array Python.PythonFunctionDecl := #[] let mut allTypeAliases : Std.HashMap String String := {} let mut allExhaustiveClasses : Std.HashSet String := {} - let mut allWarnings : Array Python.Specs.SpecError := #[] for (modulePrefix, ionPath) in pyspecEntries do let ionFile : System.FilePath := ionPath let sigs ← match ← Python.Specs.readDDM ionFile |>.toBaseIO with | .ok t => pure t - | .error msg => throw s!"Could not read {ionFile}: {msg}" + | .error msg => + emitMessageAndAbort .pySpecReadError msg (file := ionFile) let { program, errors, overloads, typeAliases, exhaustiveClasses } := Python.Specs.ToLaurel.signaturesToLaurel ionPath sigs modulePrefix - allWarnings := allWarnings ++ errors + for msg in errors do + Pipeline.addMessage msg + if msg.kind.impact.isFatal then throw () allOverloads := mergeOverloads allOverloads overloads allTypeAliases := typeAliases.fold (init := allTypeAliases) fun m k v => m.insert k v allExhaustiveClasses := exhaustiveClasses.fold (init := allExhaustiveClasses) fun s name => s.insert name match extractFunctionSignatures sigs modulePrefix with | .ok fs => funcSigs := funcSigs ++ fs - | .error msg => throw msg + | .error msg => + emitMessageAndAbort .functionSignatureError msg (file := ionFile) for td in program.types do combinedTypes := combinedTypes.push (td, ionPath) for proc in program.staticProcedures do combinedProcedures := combinedProcedures.push (proc, ionPath) - -- Reject name collisions across PySpec files + -- Reject name collisions across PySpec files (first-wins) let mut seenTypes : Std.HashMap String String := {} + let mut dedupedTypes : Array (Laurel.TypeDefinition × String) := #[] for (td, srcFile) in combinedTypes do - let name := match td with - | .Composite ct => ct.name.text - | .Constrained ct => ct.name.text - | .Datatype dt => dt.name.text - | .Alias ta => ta.name.text - if let some prevFile := seenTypes[name]? then - throw s!"PySpec type name collision: '{name}' defined in both {prevFile} and {srcFile}" - seenTypes := seenTypes.insert name srcFile + let ident := match td with + | .Composite ct => ct.name + | .Constrained ct => ct.name + | .Datatype dt => dt.name + | .Alias ta => ta.name + match seenTypes.get? ident.text with + | some prevFile => + emitMessageAndAbort .typeNameCollision s!"'{ident.text}' already defined in {prevFile}" + (file := srcFile) (loc := ident.source.map (·.range) |>.getD default) + | none => + seenTypes := seenTypes.insert ident.text srcFile + dedupedTypes := dedupedTypes.push (td, srcFile) let mut seenProcs : Std.HashMap String String := {} + let mut dedupedProcs : Array (Laurel.Procedure × String) := #[] for (proc, srcFile) in combinedProcedures do - if let some prevFile := seenProcs[proc.name.text]? then - throw s!"PySpec procedure name collision: '{proc.name.text}' defined in both {prevFile} and {srcFile}" - seenProcs := seenProcs.insert proc.name.text srcFile + match seenProcs[proc.name.text]? with + | some prevFile => + emitMessageAndAbort .procedureNameCollision s!"'{proc.name.text}' already defined in {prevFile}" + (file := srcFile) (loc := proc.name.source.map (·.range) |>.getD default) + | none => + seenProcs := seenProcs.insert proc.name.text srcFile + dedupedProcs := dedupedProcs.push (proc, srcFile) let combinedLaurel : Laurel.Program := { - staticProcedures := Strata.Python.pythonRuntimeLaurelPart.staticProcedures ++ combinedProcedures.toList.map Prod.fst + staticProcedures := Strata.Python.pythonRuntimeLaurelPart.staticProcedures ++ dedupedProcs.toList.map Prod.fst staticFields := [] - types := Strata.Python.pythonRuntimeLaurelPart.types ++ combinedTypes.toList.map Prod.fst + types := Strata.Python.pythonRuntimeLaurelPart.types ++ dedupedTypes.toList.map Prod.fst constants := [] } return { laurelProgram := combinedLaurel, overloads := allOverloads functionSignatures := funcSigs.toList, typeAliases := allTypeAliases - exhaustiveClasses := allExhaustiveClasses - pyspecWarnings := allWarnings } + exhaustiveClasses := allExhaustiveClasses } + +/-- Read PySpec Ion files and collect their Laurel declarations and overload + tables into a single combined result. -/ +public def buildPySpecLaurel + (ctx : Pipeline.PipelineContext) + (pyspecEntries : Array (String × String)) + (overloads : OverloadTable) : EIO Unit PySpecLaurelResult := + buildPySpecLaurelM pyspecEntries overloads |>.run ctx /-- Read dispatch Ion files and merge their overload tables. -/ -public def readDispatchOverloads - (dispatchPaths : Array String) - : EIO String (OverloadTable × Array Python.Specs.SpecError) := do +private def readDispatchOverloadsM + (dispatchPaths : Array String) : Pipeline.PipelineM OverloadTable := do let mut tbl : OverloadTable := {} - let mut allWarnings : Array Python.Specs.SpecError := #[] for dispatchPath in dispatchPaths do let ionFile : System.FilePath := dispatchPath let sigs ← match ← Python.Specs.readDDM ionFile |>.toBaseIO with | .ok t => pure t - | .error msg => throw s!"Could not read dispatch file {ionFile}: {msg}" + | .error msg => + emitMessageAndAbort .pySpecReadError msg (file := ionFile) let (overloads, errors) := Python.Specs.ToLaurel.extractOverloads dispatchPath sigs - allWarnings := allWarnings ++ errors + for msg in errors do + Pipeline.addMessage msg + if msg.kind.impact.isFatal then throw () tbl := mergeOverloads tbl overloads - return (tbl, allWarnings) - -/-- Resolve a module name to a `(modulePrefix, ionPath)` pair for - `buildPySpecLaurel`. Returns `none` if the pyspec file is not found. -/ -private def resolveModuleEntry (modName : String) (specDir : System.FilePath) - (quiet : Bool := false) - : EIO String (Option (String × String)) := do - match Python.Specs.ModuleName.ofString modName with - | .error _ => - if !quiet then - let _ ← IO.eprintln - s!"warning: invalid module name '{modName}', skipping" |>.toBaseIO - return none - | .ok mod => - match ← mod.specIonPath specDir with - | some specPath => - let pfx := "_".intercalate mod.components.toList - return some (pfx, specPath.toString) - | none => return none + return tbl + +/-- Read dispatch Ion files and merge their overload tables. -/ +public def readDispatchOverloads + (ctx : Pipeline.PipelineContext) + (dispatchPaths : Array String) : EIO Unit OverloadTable := + readDispatchOverloadsM dispatchPaths |>.run ctx + +/-- Resolve a parsed module name to its spec prefix and .ion path. + Returns `none` if the file is not found on disk. -/ +private def resolveModuleEntry (mod : Python.Specs.ModuleName) (specDir : System.FilePath) + : Pipeline.PipelineM (Option (String × String)) := do + match ← mod.specIonPath specDir with + | some specPath => + let pfx := "_".intercalate mod.components.toList + return some (pfx, specPath.toString) + | none => return none + +/-- Resolve module names that must exist. Fatal on invalid name or missing file. -/ +private def resolveModules (modules : Array String) (specDir : System.FilePath) + : Pipeline.PipelineM (Array (String × String)) := do + let mut entries : Array (String × String) := #[] + for modName in modules do + match Python.Specs.ModuleName.ofString modName with + | .error _ => + emitMessageAndAbort .invalidModuleName s!"invalid module name '{modName}'" (file := specDir) + | .ok mod => + let some entry ← resolveModuleEntry mod specDir + | emitMessageAndAbort .missingPySpecModule + s!"PySpec module '{modName}' not found in {specDir}" (file := specDir) + entries := entries.push entry + return entries + /-- Build dispatch overload table, auto-resolve pyspec files from the program AST, and return combined Laurel declarations @@ -238,40 +273,24 @@ public def resolveAndBuildLaurelPrelude (pyspecModules : Array String) (stmts : Array (Python.stmt SourceRange)) (specDir : System.FilePath := ".") - (quiet : Bool := false) - : EIO String PySpecLaurelResult := do - -- Resolve dispatch module names to Ion paths - let mut dispatchPaths : Array String := #[] - for modName in dispatchModules do - match ← resolveModuleEntry modName specDir (quiet := quiet) with - | some (_, path) => dispatchPaths := dispatchPaths.push path - | none => throw s!"Dispatch module '{modName}' not found in {specDir}" - let (dispatchOverloads, dispatchWarnings) ← readDispatchOverloads dispatchPaths + : Pipeline.PipelineM PySpecLaurelResult := do + -- Dispatch modules (fatal on invalid name or missing file) + let dispatchEntries ← resolveModules dispatchModules specDir + let dispatchPaths := dispatchEntries.map (·.2) + let dispatchOverloads ← readDispatchOverloadsM dispatchPaths let resolveState := Python.Specs.IdentifyOverloads.resolveOverloads dispatchOverloads stmts - if !quiet then - for w in resolveState.warnings do - let _ ← IO.eprintln s!"warning: {w}" |>.toBaseIO - -- Auto-resolve pyspec modules from overload table - let mut autoSpecEntries : Array (String × String) := #[] - if dispatchModules.size > 0 then - let resolvedMods := resolveState.modules.toArray.qsort (· < ·) - for modName in resolvedMods do - match ← resolveModuleEntry modName specDir (quiet := quiet) with - | some entry => autoSpecEntries := autoSpecEntries.push entry - | none => - if !quiet then - let _ ← IO.eprintln - s!"warning: auto-resolved pyspec not found for module '{modName}'" |>.toBaseIO - -- Resolve explicit pyspec module names - let mut explicitEntries : Array (String × String) := #[] - for modName in pyspecModules do - match ← resolveModuleEntry modName specDir (quiet := quiet) with - | some entry => explicitEntries := explicitEntries.push entry - | none => throw s!"PySpec module '{modName}' not found in {specDir}" - let allSpecEntries := autoSpecEntries ++ explicitEntries - let result ← buildPySpecLaurel allSpecEntries dispatchOverloads - return { result with pyspecWarnings := dispatchWarnings ++ result.pyspecWarnings } + for w in resolveState.warnings do + emitMessage .overloadResolveWarning w (file := specDir) + -- Auto-resolved from dispatch overload table + let autoSpecEntries ← + if dispatchModules.size > 0 then + let resolvedMods := resolveState.modules.toArray.qsort (· < ·) + resolveModules resolvedMods specDir + else pure #[] + -- Explicit pyspec modules (fatal on invalid name or missing file) + let explicitEntries ← resolveModules pyspecModules specDir + buildPySpecLaurelM (autoSpecEntries ++ explicitEntries) dispatchOverloads /-! ### Pipeline Steps -/ @@ -371,35 +390,20 @@ public def splitProcNames (prog : Core.Program) Laurel pass is written to `{prefix}.{n}.{passName}.laurel.st`. -/ public def translateCombinedLaurelWithLowered (combined : Laurel.Program) (keepAllFilesPrefix : Option String := none) - (profile : Bool := false) + (pipelineCtx : Option Pipeline.PipelineContext := none) : IO (Option Core.Program × List DiagnosticModel × Laurel.Program × Statistics) := do let (coreOption, errors, lowered, stats) ← - Laurel.translateWithLaurel { inlineFunctionsWhenPossible := true, keepAllFilesPrefix, profile } combined + Laurel.translateWithLaurel { inlineFunctionsWhenPossible := true, keepAllFilesPrefix } + combined (pipelineCtx := pipelineCtx) return (coreOption.map appendCorePartOfRuntime, errors, lowered, stats) /-- Translate a combined Laurel program to Core and prepend the full runtime prelude. -/ public def translateCombinedLaurel (combined : Laurel.Program) - (profile : Bool := false) : IO (Option Core.Program × List DiagnosticModel) := do - let (coreOption, errors, _, _) ← translateCombinedLaurelWithLowered combined (profile := profile) + let (coreOption, errors, _, _) ← translateCombinedLaurelWithLowered combined return (coreOption, errors) -/-- Errors from the pyAnalyzeLaurel pipeline. -/ -public inductive PipelineError where - /-- The Python source contains invalid code (bad method name, wrong arguments, etc.). -/ - | userCode (range : SourceRange := .none) (msg : String) - /-- The pipeline encountered a Python construct it intentionally does not yet support. -/ - | knownLimitation (msg : String) - /-- An unexpected failure — likely a bug in the tool itself. -/ - | internal (msg : String) - -public instance : ToString PipelineError where - toString - | .userCode _ msg => s!"User code error: {msg}" - | .knownLimitation msg => s!"Known limitation: {msg}" - | .internal msg => msg - /-- Run the pyAnalyzeLaurel pipeline: read a Python Ion program, resolve overloads from dispatch files, load PySpec declarations, translate Python to Laurel, and combine with PySpec Laurel. @@ -411,73 +415,46 @@ public instance : ToString PipelineError where Laurel metadata (useful when the Ion file was generated from a `.py` source and you want line numbers to refer to the original). - When `warningSummaryFile` is provided, writes a JSON summary of - PySpec translation warnings to that path. The summary is written - after pyspec resolution, before Python-to-Laurel translation, so - it is produced even when later pipeline stages fail. -/ + Runs in `PipelineM`. Fatal errors abort via `emitMessageAndAbort`. -/ public def pythonAndSpecToLaurel (pythonIonPath : String) (dispatchModules : Array String := #[]) (pyspecModules : Array String := #[]) (sourcePath : Option String := none) (specDir : System.FilePath := ".") - (profile : Bool := false) - (quiet : Bool := false) - (warningSummaryFile : Option String := none) - : EIO PipelineError Laurel.Program := do - let stmts ← profileStep profile "Read Python Ion" do + : Pipeline.PipelineM Laurel.Program := do + let stmts ← Pipeline.withPhase "readPythonIon" do match ← Python.readPythonStrata pythonIonPath |>.toBaseIO with | .ok r => pure r - | .error msg => throw (.internal msg) + | .error msg => + emitMessageAndAbort (file := pythonIonPath) .pySpecParsingError msg - let result ← profileStep profile "Resolve and build Laurel prelude" do - match ← resolveAndBuildLaurelPrelude dispatchModules pyspecModules stmts specDir (quiet := quiet) |>.toBaseIO with - | .ok r => pure r - | .error msg => throw (.internal msg) - - -- Print and write PySpec warnings before later stages can fail - let pyspecWarnings := result.pyspecWarnings - if pyspecWarnings.size > 0 && !quiet then - let _ ← IO.eprintln - s!"{pyspecWarnings.size} PySpec translation warning(s):" |>.toBaseIO - for err in pyspecWarnings do - let _ ← IO.eprintln s!" {err.file}: {err.kind.phase}.{err.kind.category}: {err.message}" |>.toBaseIO - if let some warnFile := warningSummaryFile then - let counts : Std.HashMap _ Nat := pyspecWarnings.foldl (init := {}) - fun acc err => acc.alter err.kind fun mv => some (mv.getD 0 + 1) - let entries := counts.toArray.qsort fun ⟨a, _⟩ ⟨b, _⟩ => a < b - let jsonEntries : Array Lean.Json := entries.map fun (kind, count) => - Lean.Json.mkObj [ - ("phase", .str kind.phase), - ("category", .str kind.category), - ("count", .num count) - ] - let json := Lean.Json.mkObj [ - ("pyspecWarningSummary", .arr jsonEntries), - ("totalWarnings", .num pyspecWarnings.size) - ] - match ← IO.FS.writeFile warnFile (json.compress ++ "\n") |>.toBaseIO with - | .ok () => pure () - | .error e => - let _ ← IO.eprintln s!"warning: failed to write warning summary to {warnFile}: {e}" |>.toBaseIO + let result ← Pipeline.withPhase "resolveAndBuildPrelude" do + resolveAndBuildLaurelPrelude dispatchModules pyspecModules stmts specDir let preludeInfo := buildPreludeInfo result - let metadataPath := sourcePath.getD pythonIonPath - let (laurelProgram, _ctx) ← profileStep profile "Translate Python to Laurel" do + + let (laurelProgram, _ctx) ← match Python.pythonToLaurel preludeInfo stmts metadataPath result.overloads with - | .error (.userPythonError range msg) => throw (.userCode range msg) + | .error (.userPythonError range msg) => + emitMessageAndAbort (file := sourcePath.getD pythonIonPath) (loc := range) + .laurelLoweringUserError msg | .error (.unsupportedConstruct msg ast) => - throw (.knownLimitation s!"Unsupported construct: {msg}\nAST: {ast}") - | .error e => throw (.internal s!"Python to Laurel translation failed: {e}") + emitMessageAndAbort (file := sourcePath.getD pythonIonPath) + .laurelLoweringNotImpl s!"Unsupported construct: {msg}\nAST: {ast}" + | .error e => + emitMessageAndAbort (file := sourcePath.getD pythonIonPath) + .laurelLoweringError s!"Python to Laurel translation failed: {e}" | .ok result => pure result - let filteredPrelude ← profileStep profile "Filter prelude" do + let filteredPrelude ← match Laurel.filterPrelude result.laurelProgram laurelProgram with | .ok prog => pure prog - | .error msg => throw (.internal msg) + | .error msg => + emitMessageAndAbort (file := sourcePath.getD pythonIonPath) .laurelLoweringError msg - profileStep profile "Combine PySpec and user Laurel" do - return combinePySpecLaurel filteredPrelude laurelProgram + let combined := combinePySpecLaurel filteredPrelude laurelProgram + return combined end Strata diff --git a/Strata/Languages/Python/PythonToLaurel.lean b/Strata/Languages/Python/PythonToLaurel.lean index 0310fb473f..82cc202643 100644 --- a/Strata/Languages/Python/PythonToLaurel.lean +++ b/Strata/Languages/Python/PythonToLaurel.lean @@ -473,12 +473,12 @@ def resolveDispatch (ctx : TranslationContext) | some fnOverloads => let kwPairs := kwords.map Python.keyword.nameAndValue let some firstArg := fnOverloads.findDispatchArg args kwPairs - | let msg := match fnOverloads.paramName, kwPairs.filterMap (·.1) with - | some expected, provided@(_ :: _) => + | let msg := match kwPairs.filterMap (·.1) with + | provided@(_ :: _) => s!"Dispatched function '{funcName}' called with wrong \ - keyword argument, expected '{expected}' but got \ + keyword argument, expected '{fnOverloads.paramName}' but got \ '{String.intercalate "', '" provided}'" - | _, _ => + | _ => s!"Dispatched function '{funcName}' called with no \ arguments (expected a string literal first argument)" throw (.typeError msg) diff --git a/Strata/Languages/Python/Specs.lean b/Strata/Languages/Python/Specs.lean index 9de125fbef..643ea11eb8 100644 --- a/Strata/Languages/Python/Specs.lean +++ b/Strata/Languages/Python/Specs.lean @@ -10,9 +10,12 @@ import all Strata.DDM.Util.Fin import Strata.Languages.Python.ReadPython import Strata.Languages.Python.Specs.DDM public import Strata.Languages.Python.Specs.Decls -import Strata.Languages.Python.Specs.Error +import Strata.Languages.Python.Specs.MessageKind +import Strata.Pipeline.Messages import Strata.Util.DecideProp +open Strata.Pipeline + namespace Strata.Python.Specs /-- Type class for monads that support PySpec error and warning reporting. -/ @@ -321,8 +324,8 @@ def preludeAtoms : List (String × PythonIdent) := [ structure PySpecState where typeSigs : TypeSignature := preludeSig - errors : Array SpecError - warnings : Array SpecError + errors : Array PipelineMessage + warnings : Array PipelineMessage /-- This maps global identifiers to their value. -/ @@ -354,8 +357,10 @@ def shouldSkip (name : String) : PySpecM Bool := do let nameIdent := { pythonModule := toString ctx.currentModule, name } return nameIdent ∈ ctx.skipNames +private def pySpecParsingPhase : Phase := Phase.base "pySpecParsing" + def specErrorAt (file : System.FilePath) (loc : SourceRange) (message : String) : PySpecM Unit := do - let e : SpecError := { file, loc, kind := .pySpecParsingError, message } + let e : PipelineMessage := { file, loc, phase := pySpecParsingPhase, kind := .pySpecParsingError, message } modify fun s => { s with errors := s.errors.push e } instance : PySpecMClass PySpecM where @@ -363,7 +368,7 @@ instance : PySpecMClass PySpecM where specErrorAt (←read).pythonFile loc message specWarning loc message := do let file := (←read).pythonFile - let w : SpecError := { file, loc, kind := .pySpecParsingWarning, message } + let w : PipelineMessage := { file, loc, phase := pySpecParsingPhase, kind := .pySpecParsingWarning, message } modify fun s => { s with warnings := s.warnings.push w } runChecked act := do let cnt := (←get).errors.size @@ -735,8 +740,8 @@ structure SpecAssertionContext where structure SpecAssertionState where assertions : Array Assertion := #[] postconditions : Array SpecExpr := #[] - errors : Array SpecError := #[] - warnings : Array SpecError := #[] + errors : Array PipelineMessage := #[] + warnings : Array PipelineMessage := #[] /-- Monad for extracting pre and post conditions from methods. -/ abbrev SpecAssertionM := ReaderT SpecAssertionContext (StateM SpecAssertionState) @@ -744,11 +749,11 @@ abbrev SpecAssertionM := ReaderT SpecAssertionContext (StateM SpecAssertionState instance : PySpecMClass SpecAssertionM where specError loc message := do let file := (←read) |>.filePath - let e : SpecError := { file, loc, kind := .pySpecParsingError, message } + let e : PipelineMessage := { file, loc, phase := pySpecParsingPhase, kind := .pySpecParsingError, message } modify fun s => { s with errors := s.errors.push e } specWarning loc message := do let file := (←read) |>.filePath - let w : SpecError := { file, loc, kind := .pySpecParsingWarning, message } + let w : PipelineMessage := { file, loc, phase := pySpecParsingPhase, kind := .pySpecParsingWarning, message } modify fun s => { s with warnings := s.warnings.push w } runChecked act := do let cnt := (←get).errors.size @@ -1674,7 +1679,7 @@ def translateModule (events : Std.HashSet EventType := {}) (skipNames : Std.HashSet PythonIdent := {}) (currentModulePrefix : Array String := #[]) : - BaseIO (FileMaps × Array Signature × Array SpecError × Array SpecError) := do + BaseIO (FileMaps × Array Signature × Array PipelineMessage × Array PipelineMessage) := do let fmm : FileMaps := {} let fmm := fmm.insert pythonFile fileMap let fileMapsRef : IO.Ref FileMaps ← IO.mkRef fmm @@ -1742,7 +1747,7 @@ public def translateFile (.ofString contents) body currentModule - let ppErr (e : SpecError) : EIO String String := + let ppErr (e : PipelineMessage) : EIO String String := match fmm[e.file]? with | none => throw s!"No location information for {e.file}" diff --git a/Strata/Languages/Python/Specs/Error.lean b/Strata/Languages/Python/Specs/Error.lean deleted file mode 100644 index 4894a24b0a..0000000000 --- a/Strata/Languages/Python/Specs/Error.lean +++ /dev/null @@ -1,75 +0,0 @@ -/- - Copyright Strata Contributors - - SPDX-License-Identifier: Apache-2.0 OR MIT --/ -module - -public import Strata.DDM.Util.SourceRange - -public section -namespace Strata.Python.Specs - -/-- A warning category for PySpec translation. - Uses an open vocabulary (string fields) so new categories can be added - without modifying an inductive type. -/ -structure WarningKind where - phase : String - category : String - deriving BEq, DecidableEq, Hashable, Ord, Repr - -instance : LT WarningKind where - lt a b := a.phase < b.phase ∨ (a.phase == b.phase ∧ a.category < b.category) - -instance (a b : WarningKind) : Decidable (a < b) := - inferInstanceAs (Decidable (a.phase < b.phase ∨ (a.phase == b.phase ∧ a.category < b.category))) - -namespace WarningKind - --- Type translation warnings -def unsupportedUnion : WarningKind := { phase := "pySpecToLaurel", category := "unsupportedUnion" } - --- Unsupported Optional patterns -def unsupportedOptionalFloat : WarningKind := { phase := "pySpecToLaurel", category := "unsupportedOptionalFloat" } -def unsupportedOptionalList : WarningKind := { phase := "pySpecToLaurel", category := "unsupportedOptionalList" } -def unsupportedOptionalDict : WarningKind := { phase := "pySpecToLaurel", category := "unsupportedOptionalDict" } -def unsupportedOptionalAny : WarningKind := { phase := "pySpecToLaurel", category := "unsupportedOptionalAny" } -def unsupportedOptionalBytes : WarningKind := { phase := "pySpecToLaurel", category := "unsupportedOptionalBytes" } - --- Internal type errors -def typeError : WarningKind := { phase := "pySpecToLaurel", category := "typeError" } - --- Precondition warnings -def placeholderExpr : WarningKind := { phase := "pySpecToLaurel", category := "placeholderExpr" } -def floatLiteral : WarningKind := { phase := "pySpecToLaurel", category := "floatLiteral" } -def isinstanceUnsupported : WarningKind := { phase := "pySpecToLaurel", category := "isinstanceUnsupported" } -def forallListUnsupported : WarningKind := { phase := "pySpecToLaurel", category := "forallListUnsupported" } -def forallDictUnsupported : WarningKind := { phase := "pySpecToLaurel", category := "forallDictUnsupported" } - --- Declaration warnings -def missingMethodSelf : WarningKind := { phase := "pySpecToLaurel", category := "missingMethodSelf" } -def kwargsExpansionError : WarningKind := { phase := "pySpecToLaurel", category := "kwargsExpansionError" } -def postconditionUnsupported : WarningKind := { phase := "pySpecToLaurel", category := "postconditionUnsupported" } - --- Overload dispatch warnings -def overloadNoArgs : WarningKind := { phase := "pySpecToLaurel", category := "overloadNoArgs" } -def overloadArgArity : WarningKind := { phase := "pySpecToLaurel", category := "overloadArgArity" } -def overloadArgNotStringLiteral : WarningKind := { phase := "pySpecToLaurel", category := "overloadArgNotStringLiteral" } -def overloadReturnArity : WarningKind := { phase := "pySpecToLaurel", category := "overloadReturnArity" } -def overloadReturnNotClass : WarningKind := { phase := "pySpecToLaurel", category := "overloadReturnNotClass" } - --- PySpec parsing phase (generic — callers don't yet distinguish categories) -def pySpecParsingError : WarningKind := { phase := "pySpecParsing", category := "error" } -def pySpecParsingWarning : WarningKind := { phase := "pySpecParsing", category := "warning" } - -end WarningKind - -/-- An error encountered while processing a PySpec file. -/ -structure SpecError where - file : System.FilePath - loc : SourceRange - kind : WarningKind - message : String - -end Strata.Python.Specs -end diff --git a/Strata/Languages/Python/Specs/MessageKind.lean b/Strata/Languages/Python/Specs/MessageKind.lean new file mode 100644 index 0000000000..18ac867ddc --- /dev/null +++ b/Strata/Languages/Python/Specs/MessageKind.lean @@ -0,0 +1,73 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module +public import Strata.Pipeline.Messages + +public section +namespace Strata.Pipeline.MessageKind + +-- PySpec parsing phase +def pySpecReadError : MessageKind := + { category := "readError", impact := .configurationError } +def pySpecParsingError : MessageKind := + { category := "error", impact := .internalError } +def pySpecParsingWarning : MessageKind := + { category := "warning", impact := .knownLimitation } + +-- Overload dispatch errors (in PySpec-to-Laurel phase) +def overloadNoArgs : MessageKind := + { category := "overloadNoArgs", impact := .internalError } +def overloadReturnNotClass : MessageKind := + { category := "overloadReturnNotClass", impact := .internalError } +def overloadParamNameDisagreement : MessageKind := + { category := "overloadParamNameDisagreement", impact := .internalError } +def overloadArgNotStringLiteral : MessageKind := + { category := "overloadArgNotStringLiteral", impact := .internalError } + +-- Overload resolution phase +def overloadResolveWarning : MessageKind := + { category := "resolveWarning", impact := .internalWarning } + +-- PySpec.ToLaurel internal warnings/errors +def missingMethodSelf : MessageKind := + { category := "missingMethodSelf", impact := .internalWarning } +def typeError : MessageKind := + { category := "typeError", impact := .internalWarning } +def kwargsExpansionError : MessageKind := + { category := "kwargsExpansionError", impact := .internalWarning } + +-- Type translation warnings +def unsupportedUnion : MessageKind := + { category := "unsupportedUnion", impact := .knownLimitation } + +-- Precondition warnings +def placeholderExpr : MessageKind := + { category := "placeholderExpr", impact := .knownLimitation } +def floatLiteral : MessageKind := + { category := "floatLiteral", impact := .knownLimitation } +def isinstanceUnsupported : MessageKind := + { category := "isinstanceUnsupported", impact := .knownLimitation } +def forallListUnsupported : MessageKind := + { category := "forallListUnsupported", impact := .knownLimitation } +def forallDictUnsupported : MessageKind := + { category := "forallDictUnsupported", impact := .knownLimitation } + +-- PySpec-to-Laurel assembly phase +def functionSignatureError : MessageKind := + { category := "functionSignatureError", impact := .internalError } +def typeNameCollision : MessageKind := + { category := "typeNameCollision", impact := .internalError } +def procedureNameCollision : MessageKind := + { category := "procedureNameCollision", impact := .internalError } + +-- Module resolution phase +def invalidModuleName : MessageKind := + { category := "invalidModuleName", impact := .configurationError } +def missingPySpecModule : MessageKind := + { category := "missingPySpecModule", impact := .configurationError } + +end Strata.Pipeline.MessageKind +end diff --git a/Strata/Languages/Python/Specs/ToLaurel.lean b/Strata/Languages/Python/Specs/ToLaurel.lean index da75cc4076..0f7e0c8433 100644 --- a/Strata/Languages/Python/Specs/ToLaurel.lean +++ b/Strata/Languages/Python/Specs/ToLaurel.lean @@ -10,9 +10,10 @@ import Strata.DDM.Format import Strata.Languages.Python.OverloadTable import Strata.Languages.Python.PythonLaurelTypedExpr public import Strata.Languages.Python.Specs.Decls -public import Strata.Languages.Python.Specs.Error +public import Strata.Pipeline.Messages import Strata.Languages.Python.Specs.DDM import Strata.Util.DecideProp +import Strata.Languages.Python.Specs.MessageKind /-! # PySpec to Laurel Translation @@ -62,7 +63,7 @@ namespace Strata.Python.Specs.ToLaurel open Strata.Laurel open Strata.Python.Laurel -open Strata.Python.Specs (SpecError) +open Strata.Pipeline (PipelineMessage MessageKind Phase) /-! ## ToLaurelM Monad -/ @@ -75,7 +76,7 @@ structure ToLaurelContext where /-- State for PySpec to Laurel translation. -/ structure ToLaurelState where - errors : Array SpecError := #[] + errors : Array PipelineMessage := #[] procedures : Array Procedure := #[] types : Array TypeDefinition := #[] overloads : OverloadTable := {} @@ -87,9 +88,11 @@ structure ToLaurelState where /-- Monad for PySpec to Laurel translation. -/ abbrev ToLaurelM := ReaderT ToLaurelContext (StateM ToLaurelState) -/-- Report an error during translation. -/ -def reportError (kind : WarningKind) (loc : SourceRange) (message : String) : ToLaurelM Unit := do - let e : SpecError := ⟨(←read).filepath, loc, kind, message⟩ +/-- Report an error during translation. Phase is set to pySpecToLaurel since + this monad always runs during that phase. -/ +def reportError (kind : MessageKind) (loc : SourceRange) (message : String) : ToLaurelM Unit := do + let phase := Phase.base "pySpecToLaurel" + let e : PipelineMessage := ⟨(←read).filepath, loc, phase, kind, message⟩ modify fun s => { s with errors := s.errors.push e } def runChecked (act : ToLaurelM α) : ToLaurelM (α × Bool) := do @@ -108,18 +111,24 @@ def pushType (td : TypeDefinition) : ToLaurelM Unit := /-- Add an overload dispatch entry for a function. -/ def pushOverloadEntry (funcName : String) (paramName : String) - (literalValue : String) (returnType : PythonIdent) : ToLaurelM Unit := - modify fun s => - let existing := s.overloads.getD funcName {} - let updated : FunctionOverloads := { existing with - paramName := existing.paramName <|> some paramName - entries := existing.entries.insert literalValue returnType } - if existing.paramName.any (· != paramName) then - dbg_trace s!"Warning: overload entries for '{funcName}' disagree on \ - dispatch parameter name: existing '{existing.paramName.get!}', new '{paramName}'" - { s with overloads := s.overloads.insert funcName updated } - else - { s with overloads := s.overloads.insert funcName updated } + (literalValue : String) (returnType : PythonIdent) : ToLaurelM Unit := do + match (←get).overloads[funcName]? with + | none => + modify fun s => + let entry : FunctionOverloads := { + paramName := paramName + entries := {(literalValue, returnType)} + } + { s with overloads := s.overloads.insert funcName entry } + | some existing => + if existing.paramName != paramName then + reportError .overloadParamNameDisagreement default + s!"Overload entries for '{funcName}' disagree on dispatch parameter \ + name: existing '{existing.paramName}', new '{paramName}'" + modify fun s => + { s with overloads := s.overloads.modify funcName fun existing => + { existing with entries := existing.entries.insert literalValue returnType } + } /-- Prepend the module prefix to a name. Returns the name unchanged if the prefix is empty. -/ @@ -623,7 +632,7 @@ def signatureToLaurel (sig : Signature) : ToLaurelM Unit := /-- Result of translating PySpec signatures to Laurel. -/ public structure TranslationResult where program : Laurel.Program - errors : Array SpecError + errors : Array PipelineMessage overloads : OverloadTable /-- Maps unprefixed class names to prefixed names for type resolution. -/ typeAliases : Std.HashMap String String := {} @@ -653,7 +662,7 @@ public def signaturesToLaurel (filepath : System.FilePath) (sigs : Array Signatu Processes `@overload` function declarations, ignoring classDef, typeDef, externTypeDecl, and non-overload functions. -/ public def extractOverloads (filepath : System.FilePath) (sigs : Array Signature) - : OverloadTable × Array SpecError := + : OverloadTable × Array PipelineMessage := let ctx : ToLaurelContext := { filepath, modulePrefix := "" } let action := sigs.forM fun sig => match sig with diff --git a/Strata/Pipeline/Context.lean b/Strata/Pipeline/Context.lean new file mode 100644 index 0000000000..408d38819d --- /dev/null +++ b/Strata/Pipeline/Context.lean @@ -0,0 +1,369 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module +public import Strata.Pipeline.Messages +import Lean.Data.Json.Printer +import all Strata.DDM.Util.String + +namespace Strata.Pipeline + +/-- Print to stdout and flush. -/ +def printlnFlush (msg : String) : BaseIO Unit := do + let _ ← (do IO.println msg; (← IO.getStdout).flush : IO Unit).toBaseIO + +/-- Output verbosity mode for the pipeline. -/ +public inductive OutputMode where + | quiet + | default + | profile + | verbose + deriving BEq, DecidableEq, Repr + +/-- Aggregated data for a single repeated phase (recursive for arbitrary nesting). -/ +structure RepeatedPhaseData where + count : Nat + totalNs : Nat + /-- Aggregated timings for nested subphases, in first-seen order. -/ + children : Array (String × RepeatedPhaseData) := #[] + deriving Inhabited + +namespace RepeatedPhaseData + +/-- Merge `incoming` children into `existing`, summing counts/totals for + matching names and recursively merging their children. -/ +partial def mergeChildren (existing incoming : Array (String × RepeatedPhaseData)) + : Array (String × RepeatedPhaseData) := + incoming.foldl (init := existing) fun acc (name, data) => + match acc.findIdx? (·.1 == name) with + | some idx => + let (_, prev) := acc[idx]! + acc.modify idx fun _ => (name, { + count := prev.count + data.count, + totalNs := prev.totalNs + data.totalNs, + children := mergeChildren prev.children data.children }) + | none => acc.push (name, data) + +end RepeatedPhaseData + +/-- Upsert a repeated phase entry: find by name in the array, merge elapsed + and children, or append a new entry. -/ +def addRepeatedEntry (arr : Array (String × RepeatedPhaseData)) + (name : String) (elapsed : Nat) (children : Array (String × RepeatedPhaseData)) + : Array (String × RepeatedPhaseData) := + match arr.findIdx? (·.1 == name) with + | some idx => + let (_, prev) := arr[idx]! + arr.modify idx fun _ => (name, { + count := prev.count + 1, + totalNs := prev.totalNs + elapsed, + children := RepeatedPhaseData.mergeChildren prev.children children }) + | none => arr.push (name, { count := 1, totalNs := elapsed, children }) + +/-- Per-phase scoped state: saved on phase entry, restored on exit. + Bundled into a single ref to ensure atomic save/restore. -/ +structure PhaseState where + repeatedPhases : Array (String × RepeatedPhaseData) := #[] + messageCounts : Std.HashMap String Nat := {} + deriving Inhabited + +/-- Pipeline context carrying immutable config and mutable state as individual IORefs. + This design allows any monad with BaseIO access to use pipeline capabilities + by passing a PipelineContext value directly. + + **Phase tracking state machine:** + + The phase system operates in two modes controlled by `repeatedDepthRef`: + - Mode N (normal, depth = 0): `withPhase` records individual timing entries + and prints `[start]`/`[end]` in profile mode. + - Mode R (repeated, depth > 0): `withPhase` silently aggregates timing into + `phaseStateRef.repeatedPhases` — no print, no individual `timingRef` entry. + + `withRepeatedPhase` increments `repeatedDepthRef` on entry and decrements on + exit. `withPhase` never changes the depth. + + **Invariants:** + - `currentPhaseRef` always reflects the innermost active scope's full path. + - `phaseStateRef` is scoped: saved on entry, restored on exit of both + `withPhase` and `withRepeatedPhase` — no cross-scope leakage. + - In mode R, all timing flows through `phaseStateRef.repeatedPhases` only; + `timingRef` is not touched until the enclosing mode-N `withPhase` flushes. + + **Thread safety:** PipelineContext is NOT thread-safe. The phase-tracking + refs assume single-threaded sequential access. Concurrent `withPhase` or + `withRepeatedPhase` calls on the same context will corrupt state. -/ +public structure PipelineContext where + private mk :: + outputMode : OutputMode + private pipelineStartTime : Nat + private profilePipeline : Bool := true + private messagesRef : IO.Ref (Array PipelineMessage) + private toolErrorsRef : IO.Ref (Array PipelineMessage) + private userCodeErrorsRef : IO.Ref (Array PipelineMessage) + /-- Full path of the innermost active phase. Managed via `push`/`pop` + by `withPhase` and `withRepeatedPhase` — `emitMessage` stamps this + on each diagnostic. -/ + private currentPhaseRef : IO.Ref Phase + /-- Nesting depth of `withRepeatedPhase` scopes. When > 0, `withPhase` + aggregates silently instead of recording individual timing entries. -/ + private repeatedDepthRef : IO.Ref Nat + /-- Per-phase scoped state (repeated subphases + message counts). + Saved and cleared on phase entry, restored on exit — each phase + sees only its own data. -/ + private phaseStateRef : IO.Ref PhaseState + /-- Caller-owned handle for JSONL metrics. The pipeline appends and flushes + per record but does not open or close the handle. -/ + private metricsHandle : Option IO.FS.Handle := none + +namespace PipelineContext + +/-- Create a fresh PipelineContext with new state refs. -/ +public def create + (outputMode : OutputMode := .default) + (profilePipeline : Bool := true) + (metricsHandle : Option IO.FS.Handle := none) : BaseIO PipelineContext := do + let startTime ← IO.monoNanosNow + let messagesRef ← IO.mkRef (α := Array PipelineMessage) #[] + let toolErrorsRef ← IO.mkRef (α := Array PipelineMessage) #[] + let userCodeErrorsRef ← IO.mkRef (α := Array PipelineMessage) #[] + let currentPhaseRef ← IO.mkRef (α := Phase) default + let repeatedDepthRef ← IO.mkRef 0 + let phaseStateRef ← IO.mkRef (α := PhaseState) {} + return { outputMode, pipelineStartTime := startTime, profilePipeline, + messagesRef, toolErrorsRef, userCodeErrorsRef, + currentPhaseRef, repeatedDepthRef, phaseStateRef, metricsHandle } + +/-- All accumulated pipeline messages. -/ +public def getMessages (ctx : PipelineContext) : BaseIO (Array PipelineMessage) := + ctx.messagesRef.get + +/-- Messages with `.internalError` or `.configurationError` impact. + These represent tool bugs or invalid invocations that we must fix. -/ +public def getToolErrors (ctx : PipelineContext) : BaseIO (Array PipelineMessage) := + ctx.toolErrorsRef.get + +/-- Messages with `.userCodeIssue` impact. + These represent definite errors in the user's Python source code. -/ +public def getUserCodeErrors (ctx : PipelineContext) : BaseIO (Array PipelineMessage) := + ctx.userCodeErrorsRef.get + +/-- Write a JSONL metric record to the metrics file (if open) and flush. -/ +public def emitMetric (ctx : PipelineContext) (json : Lean.Json) : BaseIO Unit := do + if let some h := ctx.metricsHandle then + let _ ← (do h.putStrLn json.compress; h.flush : IO Unit).toBaseIO + +/-- Get elapsed nanoseconds since pipeline start. -/ +public def elapsedNs (ctx : PipelineContext) : BaseIO Nat := do + let now ← IO.monoNanosNow + return now - ctx.pipelineStartTime + +/-- Common entry logic for `withPhase`: push the subphase name onto + `currentPhaseRef`, save and clear scoped phase state. -/ +def enterPhase (ctx : PipelineContext) (name : String) + : BaseIO PhaseState := do + ctx.currentPhaseRef.modify (·.subphase name) + ctx.phaseStateRef.modifyGet fun ps => (ps, {}) + +/-- Recursively print `[profile]` lines and emit JSONL metrics for aggregated + repeated phases. `parentPhase` is the phase under which these entries + are nested. -/ +partial def flushRepeatedEntries (ctx : PipelineContext) + (parentPhase : Phase) (entries : Array (String × RepeatedPhaseData)) + : BaseIO Unit := do + if entries.isEmpty then return + let childIndent := String.replicate (parentPhase.depth * 2) ' ' + for (name, data) in entries do + let subphase := parentPhase.subphase name + if ctx.outputMode == .profile || ctx.outputMode == .verbose then + let avg := if data.count > 0 then nsToMs (data.totalNs / data.count) else 0 + let timeSuffix := + if ctx.profilePipeline then + s!" (×{data.count}, total: {nsToMs data.totalNs}ms, avg: {avg}ms)" + else + "" + printlnFlush s!"{childIndent}[profile] {name}{timeSuffix}" + ctx.emitMetric (Lean.Json.mkObj [ + ("type", .str "timing"), ("phase", .str subphase.display), + ("start_ms", .num 0), ("end_ms", .num (nsToMs data.totalNs)), + ("count", .num data.count)]) + flushRepeatedEntries ctx subphase data.children + +/-- Mode-N entry: print [start] and return the start time. -/ +def enterPhaseNormal (ctx : PipelineContext) : BaseIO Nat := do + let phase ← ctx.currentPhaseRef.get + let startNs ← ctx.elapsedNs + if ctx.outputMode == .profile || ctx.outputMode == .verbose then + let indent := String.replicate ((phase.depth - 1) * 2) ' ' + let timeSuffix := if ctx.profilePipeline then s!" (time: {nsToMs startNs}ms)" else "" + printlnFlush s!"{indent}[start] {phase.leaf}{timeSuffix}" + return startNs + +/-- End the current phase in mode N: flush aggregated repeated subphases, + emit timing metric, print [end]/[warnings], then pop phase and restore state. -/ +def exitPhaseNormal (ctx : PipelineContext) + (saved : PhaseState) (startNs : Nat) : BaseIO Unit := do + let currentPhase ← ctx.currentPhaseRef.modifyGet fun p => (p, p.pop) + let ps ← ctx.phaseStateRef.modifyGet fun ps => (ps, saved) + flushRepeatedEntries ctx currentPhase ps.repeatedPhases + let now ← ctx.elapsedNs + ctx.emitMetric (Lean.Json.mkObj [ + ("type", .str "timing"), + ("phase", .str currentPhase.display), + ("start_ms", .num (nsToMs startNs)), + ("end_ms", .num (nsToMs now))]) + if ctx.outputMode == .profile || ctx.outputMode == .verbose then + let indent := String.replicate ((currentPhase.depth - 1) * 2) ' ' + let timeSuffix := if ctx.profilePipeline then s!" (time: {nsToMs now}ms)" else "" + printlnFlush s!"{indent}[end] {currentPhase.leaf}{timeSuffix}" + unless ps.messageCounts.isEmpty do + let parts := ps.messageCounts.toArray.map fun (cat, n) => s!"{n} {cat}" + let summary := String.intercalate ", " parts.toList + printlnFlush s!"{indent}[warnings] {currentPhase.leaf}: {summary}" + +/-- Mode-R exit for `withPhase`: accumulate elapsed time and nested children + into the saved repeated-phases array, then pop phase and restore state. -/ +def exitPhaseRepeated (ctx : PipelineContext) + (saved : PhaseState) (startNs : Nat) : BaseIO Unit := do + let now ← IO.monoNanosNow + let elapsed := now - startNs + let currentPhase ← ctx.currentPhaseRef.modifyGet fun p => (p, p.pop) + ctx.phaseStateRef.modify fun ps => + let children := ps.repeatedPhases + { saved with + repeatedPhases := + addRepeatedEntry saved.repeatedPhases currentPhase.leaf elapsed children } + +/-- Run an action as a named subphase of the current phase. + Nesting is determined by call structure — at the root the phase is + top-level, inside another `withPhase` it becomes a child. + + Outside a repeated phase: pushes a timing entry to `timingRef`, + prints `[start]`/`[end]` in profile/verbose mode, and flushes any + aggregated repeated subphases on exit. + + Inside a repeated phase (i.e. the action may run many times): + silently accumulates elapsed time into the enclosing + `repeatedPhasesRef`. No print, no individual timing entry. -/ +@[noinline] +public def withPhase {m α} [Monad m] [MonadLiftT BaseIO m] [MonadFinally m] + (ctx : PipelineContext) (name : String) (action : m α) : m α := do + let inRepeatedCnt ← ctx.repeatedDepthRef.get (m := BaseIO) + if inRepeatedCnt > 0 then + let saved ← ctx.enterPhase name + let startNs ← IO.monoNanosNow + try + action + finally + ctx.exitPhaseRepeated saved startNs + else + let saved ← ctx.enterPhase name + let startNs ← ctx.enterPhaseNormal + try + action + finally + ctx.exitPhaseNormal saved startNs + +/-- Run an action as a repeated subphase. Instead of recording individual + timing entries, accumulates count and total duration into the parent's + repeated-phases array. When the parent phase ends, the aggregated results + are flushed as single timing entries. Silent per-iteration. + + Sets `currentPhaseRef` so nested `emitMessage` calls get the correct + phase tag. Increments `repeatedDepthRef` so nested `withPhase` calls + aggregate silently. Saves/restores `phaseStateRef` for child + isolation. -/ +@[noinline] +public def withRepeatedPhase {m α} [Monad m] [MonadLiftT BaseIO m] [MonadFinally m] + (ctx : PipelineContext) (name : String) (action : m α) : m α := do + let saved ← ctx.enterPhase name + ctx.repeatedDepthRef.modify (m := BaseIO) (· + 1) + let startNs ← IO.monoNanosNow + try + action + finally + ctx.repeatedDepthRef.modify (m := BaseIO) (· - 1) + ctx.exitPhaseRepeated saved startNs + +/-- Time a pure expression as a repeated subphase. The `@[noinline]` + attribute prevents the compiler from hoisting `expr` outside the + timing window. Use this instead of `withRepeatedPhase` when the work + being timed is a pure (non-monadic) expression. -/ +@[noinline] +public def withRepeatedPhasePure {α} (ctx : PipelineContext) (name : String) + (expr : Unit → α) : BaseIO α := do + ctx.withRepeatedPhase (m := ReaderT Unit BaseIO) name (pure ∘ expr) () + +end PipelineContext + +/-- The pipeline monad: a reader over PipelineContext with EIO Unit. + Computations accumulate diagnostic messages in PipelineContext.messagesRef. + `emitMessageAndAbort` throws `()` to abort, but multiple messages (including + multiple error-impact messages) may accumulate before or across aborts. + The caller of `PipelineM.run` is responsible for inspecting the accumulated + messages and the outcome to determine the appropriate exit code. -/ +public abbrev PipelineM := ReaderT PipelineContext (EIO Unit) + +/-- Get the current phase from the pipeline context. -/ +public def getPhase : PipelineM Phase := do + let ctx ← read + ctx.currentPhaseRef.get + +/-- PipelineM wrapper for withPhase. -/ +@[noinline] +public def withPhase {α} (name : String) (action : PipelineM α) : PipelineM α := do + let ctx ← read + ctx.withPhase name (action.run ctx) + +/-- Append a pre-built PipelineMessage, emit metrics, and print in verbose mode. + Also buckets the message into specialized refs by impact. Does not throw. -/ +public def addMessage (msg : Pipeline.PipelineMessage) : Pipeline.PipelineM Unit := do + let ctx ← read + ctx.messagesRef.modify (·.push msg) + ctx.phaseStateRef.modify fun ps => + { ps with messageCounts := ps.messageCounts.alter msg.kind.category fun mv => some (mv.getD 0 + 1) } + match msg.kind.impact with + | .internalError | .configurationError => ctx.toolErrorsRef.modify (·.push msg) + | .userCodeIssue => ctx.userCodeErrorsRef.modify (·.push msg) + | _ => pure () + let mut fields : List (String × Lean.Json) := [ + ("type", .str "diagnostic"), ("phase", .str msg.phase.display), + ("file", .str msg.file.toString), ("category", .str msg.kind.category), + ("impact", .str (toString msg.kind.impact)), ("message", .str msg.message)] + unless msg.loc == default do + fields := fields ++ [("start", .num msg.loc.start.byteIdx), ("stop", .num msg.loc.stop.byteIdx)] + ctx.emitMetric (Lean.Json.mkObj fields) + if ctx.outputMode == .verbose then + let tag := toString msg.kind.impact + let indent := String.replicate ((msg.phase.depth - 1) * 2) ' ' + let _ ← (do IO.eprintln s!"{indent}[{tag}] {msg.file}: {msg.message}"; (← IO.getStderr).flush : IO Unit).toBaseIO + +/-- Emit a diagnostic message and continue. Tags with current phase. + The impact classification is for downstream consumers — callers may + accumulate multiple fatal-impact messages before aborting. -/ +public def emitMessage (kind : Pipeline.MessageKind) (message : String) + (file : System.FilePath := default) (loc : SourceRange := default) : Pipeline.PipelineM Unit := do + let phase ← getPhase + addMessage { file, loc, phase, kind, message } + +/-- Emit a diagnostic message and abort the pipeline. + Polymorphic return type allows use in expression position. -/ +public def emitMessageAndAbort (kind : Pipeline.MessageKind) (message : String) + (file : System.FilePath) (loc : SourceRange := default) : Pipeline.PipelineM α := do + emitMessage kind message file loc + throw () + +/-- All messages with a given impact. -/ +public def getMessagesByImpact (impact : MessageImpact) : PipelineM (Array PipelineMessage) := do + let ctx ← read + let msgs ← ctx.messagesRef.get + return msgs.filter (·.kind.impact == impact) + +/-- Whether any accumulated message has the given impact. -/ +public def hasImpact (impact : MessageImpact) : PipelineM Bool := do + let ctx ← read + let msgs ← ctx.messagesRef.get + return msgs.any (·.kind.impact == impact) + +end Strata.Pipeline diff --git a/Strata/Pipeline/Diagnostic.lean b/Strata/Pipeline/Diagnostic.lean new file mode 100644 index 0000000000..91d65ac1a1 --- /dev/null +++ b/Strata/Pipeline/Diagnostic.lean @@ -0,0 +1,42 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.Pipeline.Messages +public import Strata.Util.FileRange + +namespace Strata.Pipeline + +open Strata (DiagnosticType DiagnosticModel FileRange Uri) + +/-- Map a `DiagnosticType` to a `MessageKind`. + Each diagnostic severity maps to a category and impact. -/ +public def MessageKind.fromDiagnosticType : DiagnosticType → MessageKind + | .Warning => + { category := "warning", impact := .internalWarning } + | .UserError => + { category := "userError", impact := .userCodeIssue } + | .NotYetImplemented => + { category := "notYetImplemented", impact := .knownLimitation } + | .StrataBug => + { category := "error", impact := .internalError } + +/-- Convert a `DiagnosticModel` to a `PipelineMessage` using the given phase. -/ +public def PipelineMessage.fromDiagnostic (phase : Phase) (d : DiagnosticModel) : PipelineMessage := + let file : System.FilePath := match d.fileRange.file with + | .file path => path + { file + loc := d.fileRange.range + phase + kind := MessageKind.fromDiagnosticType d.type + message := d.message } + +/-- Convert a list of `DiagnosticModel` values to pipeline messages. -/ +public def PipelineMessage.fromDiagnostics (phase : Phase) (ds : List DiagnosticModel) + : Array PipelineMessage := + ds.toArray.map (PipelineMessage.fromDiagnostic phase) + +end Strata.Pipeline diff --git a/Strata/Pipeline/Messages.lean b/Strata/Pipeline/Messages.lean new file mode 100644 index 0000000000..4d31096cd8 --- /dev/null +++ b/Strata/Pipeline/Messages.lean @@ -0,0 +1,133 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.DDM.Util.SourceRange +import all Strata.DDM.Util.String + +public section +namespace Strata.Pipeline + +/-- Nanoseconds to milliseconds with rounding. -/ +def nsToMs (ns : Nat) : Nat := (ns + 500000) / 1000000 + +/-- A phase represents a position in the phase hierarchy. + Top-level phases have a single entry; subphases have multiple. + Ordering is determined by position in the timing array, not by name. -/ +structure Phase where + path : Array String := #[] + deriving BEq, DecidableEq, Hashable, Repr, Inhabited + +namespace Phase + +def base (name : String) : Phase := + { path := #[name] } + +def pop (p : Phase) : Phase := { path := p.path.pop } + +def subphase (parent : Phase) (name : String) : Phase := + { path := parent.path.push name } + +def depth (p : Phase) : Nat := p.path.size + +def leaf (p : Phase) : String := + match p.path.back? with + | some name => name + | none => "" + +def display (p : Phase) : String := + String.intercalate "." p.path.toList + +instance : ToString Phase where + toString p := p.display + +end Phase + + +/-- How severe / actionable is this message? -/ +inductive MessageImpact where + /-- An unexpected failure that prevented some output from being generated + (e.g., a malformed overload entry that was skipped). -/ + | internalError + /-- An unexpected condition that did not prevent output, but may indicate + a tool bug worth investigating. -/ + | internalWarning + /-- A known, documented limitation that may cause specs to be incomplete + or imprecise. -/ + | knownLimitation + /-- An issue detected in the user source code. -/ + | userCodeIssue + /-- The tool was invoked with invalid arguments or the on-disk pyspecs + are invalid (e.g., missing module, unreadable file). -/ + | configurationError + deriving BEq, DecidableEq, Hashable, Ord, Repr + +/-- +Whether this impact level typically warrants aborting the pipeline. + +N.B. Pipeline steps may want a custom abort strategy rather than +relying on this predicate. +-/ +def MessageImpact.isFatal : MessageImpact → Bool + | .internalError => true + | .configurationError => true + | .internalWarning => false + | .knownLimitation => false + | .userCodeIssue => true + +instance : ToString MessageImpact where + toString + | .internalError => "internalError" + | .internalWarning => "internalWarning" + | .knownLimitation => "knownLimitation" + | .userCodeIssue => "userCodeIssue" + | .configurationError => "configurationError" + +/-- A categorized message kind with category and impact. + The phase is derived from pipeline context at emit time. -/ +structure MessageKind where + category : String + impact : MessageImpact + deriving BEq, DecidableEq, Hashable, Ord, Repr + +instance : ToString MessageKind where + toString mk := mk.category + +namespace MessageKind + +-- Laurel lowering phase +def laurelLoweringError : MessageKind := + { category := "error", impact := .internalError } +def laurelLoweringNotImpl : MessageKind := + { category := "notYetImplemented", impact := .knownLimitation } +def laurelLoweringUserError : MessageKind := + { category := "userError", impact := .userCodeIssue } + +-- Laurel-to-Core translation phase +def laurelToCoreError : MessageKind := + { category := "error", impact := .internalError } + +-- Verification phase +def verificationError : MessageKind := + { category := "error", impact := .internalError } +def verificationTimeout : MessageKind := + { category := "solverTimeout", impact := .knownLimitation } + +end MessageKind + +/-- A located, categorized pipeline message. -/ +structure PipelineMessage where + file : System.FilePath + loc : SourceRange + phase : Phase + kind : MessageKind + message : String + +instance : ToString PipelineMessage where + toString m := s!"{m.file}: {m.phase}.{m.kind}: {m.message}" + +end Strata.Pipeline +end diff --git a/Strata/Pipeline/PyAnalyzeLaurel.lean b/Strata/Pipeline/PyAnalyzeLaurel.lean new file mode 100644 index 0000000000..a03fe7d187 --- /dev/null +++ b/Strata/Pipeline/PyAnalyzeLaurel.lean @@ -0,0 +1,140 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.Pipeline.Diagnostic +public import Strata.Util.Statistics +public import Strata.Languages.Core.EntryPoint +public import Strata.Languages.Core.Verifier +import Strata.Languages.Python.PySpecPipeline +import Strata.Languages.Python.PyFactory +import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator +import Strata.SimpleAPI + +namespace Strata.Pipeline + +/-- The outcome of the full pyAnalyzeLaurel pipeline. + Error details are derived from the accumulated messages in PipelineContext. -/ +public inductive PyAnalyzeOutcome where + /-- Pipeline completed verification successfully. -/ + | verified (vcResults : _root_.Core.VCResults) (coreProgram : Core.Program) + /-- Pipeline aborted due to a fatal error. -/ + | failed + +/-- Configuration for the pyAnalyzeLaurel pipeline. -/ +public structure PyAnalyzeConfig where + filePath : String + specDir : System.FilePath + dispatchModules : Array String := #[] + pyspecModules : Array String := #[] + sourcePath : Option String := none + keepAllFilesPrefix : Option String := none + verifyOptions : Core.VerifyOptions + entryPoint : Core.EntryPoint := Core.EntryPoint.roots + isBugFinding : Bool := true + outputMode : OutputMode := .default + skipVerification : Bool := false + profilePipeline : Bool := true + metricsHandle : Option IO.FS.Handle := none + +private def runPipeline (config : PyAnalyzeConfig) + : PipelineM (PyAnalyzeOutcome × Statistics) := do + let combinedLaurel ← withPhase "pythonAndSpecToLaurel" do + Strata.pythonAndSpecToLaurel + (specDir := config.specDir) + config.filePath config.dispatchModules config.pyspecModules config.sourcePath + + if config.outputMode == .verbose then + let _ ← (show IO Unit from do + IO.println "---- BEGIN Laurel Program ----" + IO.println (toString (Std.format combinedLaurel)) + IO.println "---- END Laurel Program ----").toBaseIO + + let uri := config.sourcePath.getD config.filePath + + let (coreProgram, laurelPassStats) ← withPhase "laurelToCore" do + let ctx ← read + let laurelResult ← + Strata.translateCombinedLaurelWithLowered combinedLaurel + (keepAllFilesPrefix := config.keepAllFilesPrefix) + (pipelineCtx := some ctx) |>.toBaseIO + match laurelResult with + | .ok (coreOpt, diags, _, stats) => + let phase ← getPhase + for msg in PipelineMessage.fromDiagnostics phase diags do + addMessage msg + if msg.kind.impact.isFatal then throw () + match coreOpt with + | some core => pure (core, stats) + | none => + emitMessageAndAbort (file := uri) .laurelToCoreError s!"Laurel to Core translation failed: {diags}" + | .error e => + emitMessageAndAbort (file := uri) .laurelToCoreError s!"Laurel translation error: {e}" + + if config.outputMode == .verbose then + let _ ← (show IO Unit from do + IO.println "---- BEGIN Core Program ----" + IO.println (toString coreProgram) + IO.println "---- END Core Program ----").toBaseIO + + if config.skipVerification then + return (PyAnalyzeOutcome.verified #[] coreProgram, laurelPassStats) + + let verifyResult ← withPhase "verification" do + let ctx ← read + let userSourcePath := config.sourcePath.getD config.filePath + let (_, userProcNames) := Strata.splitProcNames coreProgram [userSourcePath] + let (proceduresToVerify, inlinePhases) := + if config.isBugFinding then + let ⟨p, i⟩ := Core.chooseEntryProceduresAndBuildInlinePhases + coreProgram userProcNames config.entryPoint + (p, [i]) + else (userProcNames, []) + Strata.Core.verifyProgram coreProgram config.verifyOptions + (moreFns := Strata.Python.ReFactory) + (proceduresToVerify := some proceduresToVerify) + (externalPhases := [Strata.frontEndPhase]) + (prefixPhases := inlinePhases) + (keepAllFilesPrefix := config.keepAllFilesPrefix) + (pipelineCtx := some ctx) + |>.toBaseIO + + let vcResults ← + match verifyResult with + | .ok r => + pure r.mergeByAssertion + | .error msg => + emitMessageAndAbort (file := uri) .verificationError msg + + for vcResult in vcResults do + match vcResult.outcome with + | .error (.encoding msg) => + emitMessageAndAbort (file := uri) .verificationError msg + | .error (.solverTimeout msg) => + emitMessage .verificationTimeout msg + | .error (.solverCrash msg) => + emitMessageAndAbort (file := uri) .verificationError msg + | .ok _ => pure () + + return (PyAnalyzeOutcome.verified vcResults coreProgram, laurelPassStats) + +/-- Run the full pyAnalyzeLaurel pipeline: Python+PySpec to Laurel, + Laurel to Core, then SMT verification. + + Accumulates pipeline messages from all phases. The caller is responsible + for inspecting the outcome and accumulated messages to determine exit codes. -/ +public def runPyAnalyzePipeline (config : PyAnalyzeConfig) + : IO (PyAnalyzeOutcome × Statistics × PipelineContext) := do + let ctx ← PipelineContext.create + (outputMode := config.outputMode) + (profilePipeline := config.profilePipeline) + (metricsHandle := config.metricsHandle) + let result ← runPipeline config |>.run ctx |>.toBaseIO + match result with + | .ok (outcome, stats) => return (outcome, stats, ctx) + | .error () => return (.failed, {}, ctx) + +end Strata.Pipeline diff --git a/Strata/SimpleAPI.lean b/Strata/SimpleAPI.lean index 569fd8d68d..e7a8ad49c7 100644 --- a/Strata/SimpleAPI.lean +++ b/Strata/SimpleAPI.lean @@ -330,13 +330,15 @@ def Core.verifyProgram (keepAllFilesPrefix : Option String := none) (solver : Option Core.CoreSMTSolver := none) (mkDischarge : Core.MkDischargeFn := Core.mkDischargeFn) + (pipelineCtx : Option Pipeline.PipelineContext := none) : EIO String Core.VCResults := do let runVerification (tempDir : System.FilePath) : IO Core.VCResults := EIO.toIO (IO.Error.userError ∘ toString) (Core.verify program tempDir proceduresToVerify options moreFns externalPhases prefixPhases (keepAllFilesPrefix := keepAllFilesPrefix) (solver := solver) - (mkDischarge := mkDischarge)) + (mkDischarge := mkDischarge) + (pipelineCtx := pipelineCtx)) let ioAction := match options.vcDirectory with | .some vcDir => IO.FS.createDirAll vcDir *> runVerification vcDir | .none => IO.FS.withTempDir runVerification @@ -553,10 +555,16 @@ def pyTranslateLaurel (pyspecModules : Array String := #[]) (specDir : System.FilePath := ".") : EIO String (Core.Program × List DiagnosticModel) := do + let pctx ← Pipeline.PipelineContext.create (outputMode := .quiet) let laurel ← - match ← pythonAndSpecToLaurel pythonIonPath dispatchModules pyspecModules (specDir := specDir) |>.toBaseIO with + match ← (pythonAndSpecToLaurel pythonIonPath dispatchModules pyspecModules (specDir := specDir)).run pctx |>.toBaseIO with | .ok r => pure r - | .error err => throw (toString err) + | .error () => + let msgs ← pctx.getMessages + let detail := match msgs.back? with + | some m => m.message + | none => "Pipeline aborted" + throw detail let (coreOption, laurelTranslateErrors) ← IO.toEIO (fun e => s!"{e}") (translateCombinedLaurel laurel) match coreOption with | none => throw s!"Laurel to Core translation failed: {laurelTranslateErrors}" diff --git a/Strata/Util/FileRange.lean b/Strata/Util/FileRange.lean index dac1c7129d..f112109120 100644 --- a/Strata/Util/FileRange.lean +++ b/Strata/Util/FileRange.lean @@ -88,7 +88,7 @@ instance : Inhabited DiagnosticModel where /-- Create a DiagnosticModel from just a message (using default location). This should not be called, it only exists temporarily to enable incrementally migrating code without error locations -/ -def DiagnosticModel.fromMessage (msg : String) (type : DiagnosticType := DiagnosticType.UserError): DiagnosticModel := +def DiagnosticModel.fromMessage (msg : String) (type : DiagnosticType := DiagnosticType.UserError) : DiagnosticModel := { fileRange := FileRange.unknown, message := msg, type := type } /-- Create a DiagnosticModel from a Format (using default location). diff --git a/Strata/Util/Profile.lean b/Strata/Util/Profile.lean deleted file mode 100644 index 9bf748d1ca..0000000000 --- a/Strata/Util/Profile.lean +++ /dev/null @@ -1,18 +0,0 @@ -/- - Copyright Strata Contributors - - SPDX-License-Identifier: Apache-2.0 OR MIT --/ -module - -@[inline] public def nsToMs (ns : Nat) : Nat := (ns + 500000) / 1000000 - -/-- Run an action, printing its elapsed time in milliseconds to stdout when `profile` is true. -/ -public def profileStep {m α} [Monad m] [MonadLiftT BaseIO m] - (profile : Bool) (name : String) (action : m α) : m α := do - if !profile then return ← action - let start ← IO.monoNanosNow - let result ← action - let elapsed := (← IO.monoNanosNow) - start - let _ ← (IO.println s!"[profile] {name}: {nsToMs elapsed}ms" |>.toBaseIO) - pure result diff --git a/StrataMainLib.lean b/StrataMainLib.lean index c58f839c8f..d45f5de868 100644 --- a/StrataMainLib.lean +++ b/StrataMainLib.lean @@ -16,6 +16,8 @@ import Strata.Languages.Core.StatementEval import Strata.Languages.C_Simp.Verify import Strata.Languages.B3.Verifier.Program import Strata.Languages.Laurel.LaurelCompilationPipeline +import Strata.Pipeline.Diagnostic +import Strata.Pipeline.PyAnalyzeLaurel import Strata.Languages.Boole.Boole import Strata.Languages.Boole.Verify import Strata.Languages.Python.Python @@ -28,7 +30,6 @@ import Strata.Transform.ProcedureInlining import Strata.Util.IO import Strata.SimpleAPI -import Strata.Util.Profile import Strata.Util.Json import Strata.DDM.BuiltinDialects import Strata.DDM.Util.String @@ -294,8 +295,7 @@ def parseLaurelVerifyOptions (pflags : ParsedFlags) let translateOptions : LaurelTranslateOptions := { base.translateOptions with keepAllFilesPrefix - overflowChecks := verifyOptions.overflowChecks - profile := verifyOptions.profile } + overflowChecks := verifyOptions.overflowChecks } return { translateOptions, verifyOptions } /-- Read and parse a Strata program file, loading the Core, C_Simp, and B3CST @@ -565,6 +565,30 @@ private def deriveBaseName (file : String) : String := | none => name +/-- Write SMT-style user-error diagnostics to stdout and `user_errors.txt`, + and return a human-readable location suffix (e.g., " at line 42, col 5"). -/ +private def reportUserCodeError (range : SourceRange) (msg : String) + (mfm : Option (String × Lean.FileMap)) (filePath : String) : IO String := do + let location := if range.isNone then "" else + match mfm with + | some (_, fm) => + let pos := fm.toPosition range.start + s!" at line {pos.line}, col {pos.column}" + | none => "" + let mut lines := #[ + s!"(set-info :file {Strata.escapeSMTStringLit filePath})" + ] + unless range.isNone do + lines := lines.push s!"(set-info :start {range.start})" + lines := lines.push s!"(set-info :stop {range.stop})" + lines := lines.push s!"(set-info :error-message {Strata.escapeSMTStringLit msg})" + for line in lines do + IO.println line + IO.FS.Handle.mk "user_errors.txt" .write >>= fun h => + for line in lines do + h.putStrLn line + return location + def pyAnalyzeLaurelCommand : Command where name := "pyAnalyzeLaurel" args := [ "file" ] @@ -584,8 +608,8 @@ def pyAnalyzeLaurelCommand : Command where { name := "entry-point", help := "Which procedures to verify: main (main fn only), roots (user procs with no user callers, default), or all (all user procs). Only valid in bugFinding mode.", takesArg := .arg "mode" }, - { name := "warning-summary", - help := "Write PySpec warning summary as JSON to .", + { name := "metrics", + help := "Write pipeline metrics (diagnostics, timing, outcome) as JSONL to .", takesArg := .arg "file" }, { name := "skip-verification", help := "Run Python-to-Laurel and Laurel-to-Core translation only (skip SMT verification).", @@ -613,88 +637,12 @@ def pyAnalyzeLaurelCommand : Command where let mfm : Option (String × Lean.FileMap) := match pySourceOpt with | some (pyPath, srcText) => some (pyPath, .ofString srcText) | none => none - let warningSummaryFile := pflags.getString "warning-summary" - let combinedLaurel ← - match ← Strata.pythonAndSpecToLaurel filePath dispatchModules pyspecModules sourcePath - (specDir := specDir) (profile := profile) - (quiet := quiet) - (warningSummaryFile := warningSummaryFile) |>.toBaseIO with - | .ok r => pure r - | .error (.userCode range msg) => - let location := if range.isNone then "" else - match mfm with - | some (_, fm) => - let pos := fm.toPosition range.start - s!" at line {pos.line}, col {pos.column}" - | none => "" - let filePath' := sourcePath.getD filePath - let mut lines := #[ - s!"(set-info :file {Strata.escapeSMTStringLit filePath'})" - ] - unless range.isNone do - lines := lines.push s!"(set-info :start {range.start})" - lines := lines.push s!"(set-info :stop {range.stop})" - lines := lines.push s!"(set-info :error-message {Strata.escapeSMTStringLit msg})" - for line in lines do - IO.println line - IO.FS.writeFile "user_errors.txt" (String.intercalate "\n" lines.toList ++ "\n") - exitPyAnalyzeUserError s!"{msg}{location}" - | .error (.knownLimitation msg) => - exitPyAnalyzeKnownLimitation msg - | .error (.internal msg) => - exitPyAnalyzeInternalError msg - - if verbose then - IO.println "\n==== Laurel Program ====" - IO.println f!"{combinedLaurel}" + let metricsHandle ← match pflags.getString "metrics" with + | some path => some <$> IO.FS.Handle.mk path .write + | none => pure none + -- Parse verify options early (needed for pipeline config). let keepPrefix := keepDir.map (s!"{·}/{baseName}") - - let (coreProgramOption, laurelTranslateErrors, _loweredLaurel, laurelPassStats) ← - profileStep profile "Laurel to Core translation" do - Strata.translateCombinedLaurelWithLowered combinedLaurel - (keepAllFilesPrefix := keepPrefix) (profile := profile) - - if profile && !laurelPassStats.data.isEmpty then - IO.println laurelPassStats.format - - let coreProgram ← - match coreProgramOption with - | none => - exitPyAnalyzeInternalError s!"Laurel to Core translation failed: {laurelTranslateErrors}" - | some core => pure core - - if verbose then - IO.println "\n==== Core Program ====" - IO.print (Core.formatProgram coreProgram) - - -- When --skip-verification is set, report translation diagnostics and exit - -- without running SMT verification (stages 3-4). - if pflags.getBool "skip-verification" then do - if !laurelTranslateErrors.isEmpty then - IO.eprintln "\n==== Errors ====" - for err in laurelTranslateErrors do - IO.eprintln err - if outputSarif then - let files := match mfm with - | some (pyPath, fm) => Map.empty.insert (Strata.Uri.file pyPath) fm - | none => Map.empty - Core.Sarif.writeSarifOutput .deductive files #[] (filePath ++ ".sarif") - let nStrataBug := laurelTranslateErrors.filter (·.type == .StrataBug) |>.length - let nNotYetImpl := laurelTranslateErrors.filter (·.type == .NotYetImplemented) |>.length - let nUserError := laurelTranslateErrors.filter (·.type == .UserError) |>.length - let nWarning := laurelTranslateErrors.filter (·.type == .Warning) |>.length - let counts := s!"{nUserError} user errors, {nWarning} warnings, {nNotYetImpl} not yet implemented, {nStrataBug} internal errors" - if nStrataBug > 0 then - exitPyAnalyzeInternalError s!"Translation produced internal errors. {counts}" - else if nNotYetImpl > 0 then - exitPyAnalyzeKnownLimitation s!"Translation encountered unsupported constructs. {counts}" - else - printPyAnalyzeResult "Analysis success" counts - return - - -- Verify using Core verifier - -- --keep-all-files implies vc-directory if not explicitly set let baseVcDir := keepDir.map (fun dir => (s!"{dir}/{baseName}" : System.FilePath)) let pyAnalyzeBase : VerifyOptions := { VerifyOptions.default with @@ -720,57 +668,101 @@ def pyAnalyzeLaurelCommand : Command where exitPyAnalyzeUserError s!"--entry-point is unsupported in {options.checkMode} mode" else pure .all - -- Pick the procedures to verify and set up inlining phases. - let userSourcePath := sourcePath.getD filePath - let (_, userProcNames) := - Strata.splitProcNames coreProgram [userSourcePath] - let (proceduresToVerify, inlinePhases) := - if isBugFinding then - let ⟨p, i⟩ := Core.chooseEntryProceduresAndBuildInlinePhases coreProgram userProcNames entryPoint - (p, [i]) - else (userProcNames, []) - - let vcResults ← profileStep profile "SMT verification" do - match ← Core.verifyProgram coreProgram options - (moreFns := Strata.Python.ReFactory) - (proceduresToVerify := some proceduresToVerify) - (externalPhases := [Strata.frontEndPhase]) - (prefixPhases := inlinePhases) - (keepAllFilesPrefix := keepPrefix) - |>.toBaseIO with - | .ok r => pure r.mergeByAssertion - | .error msg => exitPyAnalyzeInternalError msg - - -- Print translation errors (always on stderr) - if !laurelTranslateErrors.isEmpty then - IO.eprintln "\n==== Errors ====" - for err in laurelTranslateErrors do - IO.eprintln err - - -- Print per-VC results by default, unless SARIF mode is used - if !outputSarif then - let mut s := "" - for vcResult in vcResults do - let fileMap := mfm.map (·.2) - let location := match Imperative.getFileRange vcResult.obligation.metadata with - | some fr => - if fr.range.isNone then "" - else s!"{fr.format fileMap (includeEnd? := false)}" - | none => "" - let messageSuffix := match vcResult.obligation.metadata.getPropertySummary with - | some msg => s!" - {msg}" - | none => s!" - {vcResult.obligation.label}" - let outcomeStr := vcResult.formatOutcome - let loc := if !location.isEmpty then s!"{location}: " else "unknown location: " - s := s ++ s!"{loc}{outcomeStr}{messageSuffix}\n" - IO.print s - -- Output in SARIF format if requested - if outputSarif then - let files := match mfm with - | some (pyPath, fm) => Map.empty.insert (Strata.Uri.file pyPath) fm - | none => Map.empty - Core.Sarif.writeSarifOutput options.checkMode files vcResults (filePath ++ ".sarif") - printPyAnalyzeSummary vcResults options.checkMode + -- Derive output mode from CLI flags. + let outputMode : Strata.Pipeline.OutputMode := + if verbose then .verbose + else if profile then .profile + else if quiet then .quiet + else .default + let skipVerification := pflags.getBool "skip-verification" + + -- Run the pipeline + let (outcome, laurelPassStats, pctx) ← Strata.Pipeline.runPyAnalyzePipeline { + filePath, specDir + dispatchModules, pyspecModules, sourcePath + keepAllFilesPrefix := keepPrefix + verifyOptions := options + entryPoint, isBugFinding + outputMode, skipVerification + metricsHandle + } + + -- Always print pipeline warnings + let msgs ← pctx.getMessages + if !quiet && msgs.size > 0 then + IO.eprintln s!"{msgs.size} pipeline warning(s)" + if verbose then + for err in msgs do + IO.eprintln s!" {err.file}: {err.phase}.{err.kind}: {err.message}" + + if profile && !laurelPassStats.data.isEmpty then + IO.println laurelPassStats.format + + -- Write outcome record to metrics file. + let emitOutcome (resultStr : String) (exitCode : UInt8) (detail : Option String := none) : IO Unit := do + let totalMs ← pctx.elapsedNs + let mut fields : List (String × Lean.Json) := [ + ("type", .str "outcome"), ("result", .str resultStr), + ("exit_code", .num exitCode.toNat), ("total_ms", .num (Strata.Pipeline.nsToMs totalMs))] + if let some d := detail then + fields := fields ++ [("detail", .str d)] + pctx.emitMetric (Lean.Json.mkObj fields) + + -- Handle pipeline outcome. + -- Exit code is f(outcome, messages) — see priority ordering in unify.md. + let toolErrors ← pctx.getToolErrors + let userErrors ← pctx.getUserCodeErrors + + -- Priority 1: internal/configuration errors always dominate + if let some lastErr := toolErrors.back? then + emitOutcome "internalError" ExitCode.internalError (detail := lastErr.message) + exitPyAnalyzeInternalError lastErr.message + -- Priority 2: user code errors + if let some lastErr := userErrors.back? then + emitOutcome "userError" ExitCode.userError (detail := lastErr.message) + let location ← reportUserCodeError lastErr.loc lastErr.message mfm (sourcePath.getD filePath) + exitPyAnalyzeUserError s!"{lastErr.message}{location}" + match outcome with + | .verified vcResults _coreProgram => + emitOutcome "verified" 0 + -- Print per-VC results by default, unless SARIF mode is used + if !outputSarif then + let mut s := "" + for vcResult in vcResults do + let fileMap := mfm.map (·.2) + let location := match Imperative.getFileRange vcResult.obligation.metadata with + | some fr => + if fr.range.isNone then "" + else s!"{fr.format fileMap (includeEnd? := false)}" + | none => "" + let messageSuffix := match vcResult.obligation.metadata.getPropertySummary with + | some msg => s!" - {msg}" + | none => s!" - {vcResult.obligation.label}" + let outcomeStr := vcResult.formatOutcome + let loc := if !location.isEmpty then s!"{location}: " else "unknown location: " + s := s ++ s!"{loc}{outcomeStr}{messageSuffix}\n" + IO.print s + -- Output in SARIF format if requested + if outputSarif then + let files := match mfm with + | some (pyPath, fm) => Map.empty.insert (Strata.Uri.file pyPath) fm + | none => Map.empty + Core.Sarif.writeSarifOutput options.checkMode files vcResults (filePath ++ ".sarif") + printPyAnalyzeSummary vcResults options.checkMode + | .failed => + -- Priority 4: known limitations + let knownLimitations := msgs.filter (·.kind.impact == .knownLimitation) + match knownLimitations.back? with + | some lastErr => + emitOutcome "knownLimitation" ExitCode.knownLimitation (detail := lastErr.message) + exitPyAnalyzeKnownLimitation lastErr.message + | none => + -- .failed with no classified impact = internal error + let msg : String := match msgs.back? with + | some m => m.message + | none => "Pipeline aborted" + emitOutcome "internalError" ExitCode.internalError (detail := msg) + exitPyAnalyzeInternalError msg def pyAnalyzeToGotoCommand : Command where name := "pyAnalyzeToGoto" @@ -953,10 +945,13 @@ def pyResolveOverloadsCommand : Command where let pythonFile : System.FilePath := v[0] let dispatchPath := v[1] -- Read dispatch overload table - let overloads ← - match ← readDispatchOverloads #[dispatchPath] |>.toBaseIO with - | .ok (r, _) => pure r - | .error msg => exitFailure msg + let pctx ← Strata.Pipeline.PipelineContext.create + let overloads ← match ← (readDispatchOverloads pctx #[dispatchPath]).toBaseIO with + | .ok r => pure r + | .error () => + for m in ← pctx.getMessages do + IO.eprintln s!"{m}" + exitFailure "readDispatchOverloads: fatal error" -- Convert .py to Python AST let stmts ← IO.FS.withTempFile fun _handle dialectFile => do @@ -1375,8 +1370,9 @@ def pyInterpretCommand : Command where | .none => exitFailure s!"Invalid fuel: '{s}'" | none => pure 10000 + let quietCtx ← Strata.Pipeline.PipelineContext.create (outputMode := .quiet) let (core, _diags) ← - match ← Strata.pythonAndSpecToLaurel filePath (specDir := ".") |>.toBaseIO with + match ← (Strata.pythonAndSpecToLaurel filePath (specDir := ".")).run quietCtx |>.toBaseIO with | .ok laurel => if let some dir := keepDir then IO.FS.createDirAll dir @@ -1384,7 +1380,10 @@ def pyInterpretCommand : Command where match ← Strata.translateCombinedLaurel laurel with | (some core, diags) => pure (core, diags) | (none, diags) => exitFailure s!"Laurel to Core translation failed: {diags}" - | .error msg => exitFailure (toString msg) + | .error () => + let msgs ← quietCtx.getMessages + let detail := match msgs.back? with | some m => m.message | none => "Pipeline aborted" + exitFailure detail if let some dir := keepDir then IO.FS.writeFile (dir ++ "/core.st") (toString (Std.format core)) let core ← match Core.typeCheck Core.VerifyOptions.quiet core @@ -1448,7 +1447,7 @@ private def printFlag (indent : Nat) (flag : Flag) : IO Unit := do IO.println s!"{pad}--{flag.name} {flag.help}" /-- Print help for all command groups. -/ -def printGlobalHelp (groups : List CommandGroup := commandGroups) : IO Unit := do +private def printGlobalHelp (groups : List CommandGroup := commandGroups) : IO Unit := do IO.println "Usage: strata [flags]...\n" IO.println "Command-line utilities for working with Strata.\n" for group in groups do @@ -1472,7 +1471,7 @@ def printGlobalHelp (groups : List CommandGroup := commandGroups) : IO Unit := d IO.println "" /-- Print help for a single command. -/ -def printCommandHelp (cmd : Command) : IO Unit := do +private def printCommandHelp (cmd : Command) : IO Unit := do let cmdLine := cmd.args.foldl (init := s!"strata {cmd.name}") fun s a => s!"{s} <{a}>" let flagSummary := cmd.flags.foldl (init := "") fun s f => match f.takesArg with @@ -1487,7 +1486,7 @@ def printCommandHelp (cmd : Command) : IO Unit := do /-- Parse interleaved flags and positional arguments. Returns the collected positional arguments and parsed flags. -/ -def parseArgs (cmdName : String) +private def parseArgs (cmdName : String) (flagMap : Std.HashMap String Flag) (acc : Array String) (pflags : ParsedFlags) (cmdArgs : List String) : IO (Array String × ParsedFlags) := do diff --git a/StrataTest/DL/Imperative/Verify.lean b/StrataTest/DL/Imperative/Verify.lean index ad5a9a6f11..49d54578c7 100644 --- a/StrataTest/DL/Imperative/Verify.lean +++ b/StrataTest/DL/Imperative/Verify.lean @@ -7,6 +7,7 @@ import StrataTest.DL.Imperative.DDMTranslate import StrataTest.DL.Imperative.SMTEncoder import Strata.DL.Imperative.SMTUtils +import Strata.Pipeline.Messages --------------------------------------------------------------------- namespace Arith @@ -27,6 +28,7 @@ def typedVarToSMT (v : String) (ty : Ty) : Except Format (String × Strata.SMT.T def verify (cmds : Commands) (verbose : Bool) : EIO Format (Imperative.VCResults Arith.PureExpr) := do + let pctx ← Strata.Pipeline.PipelineContext.create (outputMode := .quiet) (profilePipeline := false) match typeCheckAndPartialEval cmds with | .error err => .error s!"[Strata.Arith.verify] Error during evaluation!\n\ @@ -56,7 +58,7 @@ def verify (cmds : Commands) (verbose : Bool) : -- (FIXME) ((Arith.Eval.ProofObligation.freeVars obligation).map (fun v => (v, Arith.Ty.Num))) "cvc5" filename.toString - #["--produce-models"] false false true false) + #["--produce-models"] false false true false pctx) match ans with | Except.ok (_, result, estate) => let vcres := { obligation, result, estate } diff --git a/StrataTest/Languages/Core/Tests/ExprEvalTest.lean b/StrataTest/Languages/Core/Tests/ExprEvalTest.lean index 60ef7f173d..7bdd7092c0 100644 --- a/StrataTest/Languages/Core/Tests/ExprEvalTest.lean +++ b/StrataTest/Languages/Core/Tests/ExprEvalTest.lean @@ -59,6 +59,7 @@ Check whether concrete evaluation of e matches the SMT encoding of e. Returns false if e did not reduce to a constant. -/ def checkValid (e:LExpr CoreLParams.mono): IO Bool := do + let pctx ← Strata.Pipeline.PipelineContext.create (outputMode := .quiet) (profilePipeline := false) let tenv := TEnv.default let init_state := LState.init let e_fvs := LExpr.freeVars e @@ -75,7 +76,7 @@ def checkValid (e:LExpr CoreLParams.mono): IO Bool := do let ans ← Core.SMT.dischargeObligation { Core.VerifyOptions.default with verbose := .quiet } e_fvs_typed Imperative.MetaData.empty filename.toString - [] smt_term ctx true false (label := "exprEvalTest") + [] smt_term ctx true false (label := "exprEvalTest") (pctx := pctx) match ans with | .ok (.sat _, _, _) => return true | _ => diff --git a/StrataTest/Languages/Core/Tests/SMTEncoderTests.lean b/StrataTest/Languages/Core/Tests/SMTEncoderTests.lean index 979e09a3d4..5ce57a9ecc 100644 --- a/StrataTest/Languages/Core/Tests/SMTEncoderTests.lean +++ b/StrataTest/Languages/Core/Tests/SMTEncoderTests.lean @@ -298,6 +298,7 @@ end ArrayTheory /-- info: (["c"], true) -/ #guard_msgs in #eval show IO _ from do + let pctx ← Strata.Pipeline.PipelineContext.create (outputMode := .quiet) (profilePipeline := false) -- Non-nullary UF: f(x : Int) : Int — should be excluded from ids let uf_f := UF.mk "f" [TermVar.mk "x" TermType.int] TermType.int -- Nullary UF: c : Int — should be included in ids @@ -310,7 +311,8 @@ end ArrayTheory let ((ids, _estate), _) ← Strata.SMT.SolverM.run solver (Strata.SMT.Encoder.encodeCore ctx (pure ()) [] obligationTerm md - (satisfiabilityCheck := false) (validityCheck := true) (label := "test")) + (satisfiabilityCheck := false) (validityCheck := true) (label := "test") + (pctx := pctx)) -- ids should contain "c" but not "f" let hasF := ids.any (· == "f") return (ids, !hasF) @@ -326,6 +328,7 @@ info: (set-logic ALL) -/ #guard_msgs in #eval show IO _ from do + let pctx ← Strata.Pipeline.PipelineContext.create (outputMode := .quiet) (profilePipeline := false) let ctx : SMT.Context := SMT.Context.default let obligationTerm := Term.prim (.bool true) let md : Imperative.MetaData Core.Expression := #[] @@ -334,7 +337,8 @@ info: (set-logic ALL) let _ ← Strata.SMT.SolverM.run solver (Strata.SMT.Encoder.encodeCore ctx (pure ()) [] obligationTerm md - (satisfiabilityCheck := false) (validityCheck := true) (label := "assert_bounds_check")) + (satisfiabilityCheck := false) (validityCheck := true) (label := "assert_bounds_check") + (pctx := pctx)) let contents ← b.get let smt := if h : contents.data.IsValidUTF8 @@ -353,6 +357,7 @@ info: (set-logic ALL) -/ #guard_msgs in #eval show IO _ from do + let pctx ← Strata.Pipeline.PipelineContext.create (outputMode := .quiet) (profilePipeline := false) let ctx : SMT.Context := SMT.Context.default let obligationTerm := Term.prim (.bool true) let md : Imperative.MetaData Core.Expression := @@ -362,7 +367,8 @@ info: (set-logic ALL) let _ ← Strata.SMT.SolverM.run solver (Strata.SMT.Encoder.encodeCore ctx (pure ()) [] obligationTerm md - (satisfiabilityCheck := false) (validityCheck := true) (label := "assert_bounds_check")) + (satisfiabilityCheck := false) (validityCheck := true) (label := "assert_bounds_check") + (pctx := pctx)) let contents ← b.get let smt := if h : contents.data.IsValidUTF8 @@ -386,6 +392,7 @@ info: (set-logic ALL) and check flags, and return the resulting SMT-LIB text. -/ private def captureEncodeCore (md : Imperative.MetaData Core.Expression) (satCheck validityCheck : Bool) (label : String := "test") : IO String := do + let pctx ← Strata.Pipeline.PipelineContext.create (outputMode := .quiet) (profilePipeline := false) let ctx : SMT.Context := SMT.Context.default let obligationTerm := Term.prim (.bool true) let b ← IO.mkRef { : IO.FS.Stream.Buffer } @@ -393,7 +400,8 @@ private def captureEncodeCore (md : Imperative.MetaData Core.Expression) let _ ← Strata.SMT.SolverM.run solver (Strata.SMT.Encoder.encodeCore ctx (pure ()) [] obligationTerm md - (satisfiabilityCheck := satCheck) (validityCheck := validityCheck) (label := label)) + (satisfiabilityCheck := satCheck) (validityCheck := validityCheck) (label := label) + (pctx := pctx)) let contents ← b.get return if h : contents.data.IsValidUTF8 then String.fromUTF8 contents.data h diff --git a/StrataTest/Languages/Python/PySpecArgTypeTest.lean b/StrataTest/Languages/Python/PySpecArgTypeTest.lean index d921aaab9c..ed3c71cc37 100644 --- a/StrataTest/Languages/Python/PySpecArgTypeTest.lean +++ b/StrataTest/Languages/Python/PySpecArgTypeTest.lean @@ -43,10 +43,12 @@ private def buildSpecs (sigs : Array Signature) : IO Strata.PySpecLaurelResult : IO.FS.withTempDir fun dir => do let ionFile := dir / "test.pyspec.ion" writeDDM ionFile sigs - let result ← buildPySpecLaurel #[("", ionFile.toString)] {} |>.toBaseIO - match result with + let ctx ← Strata.Pipeline.PipelineContext.create + match ← (buildPySpecLaurel ctx #[("", ionFile.toString)] {}).toBaseIO with | .ok r => pure r - | .error msg => throw <| .userError msg + | .error () => + let msgs ← ctx.getMessages + throw <| .userError s!"buildPySpecLaurel failed: {msgs.map toString}" private def getFuncSigs (sigs : Array Signature) : IO (List PythonFunctionDecl) := do return (← buildSpecs sigs).functionSignatures diff --git a/StrataTest/Languages/Python/TestExamples.lean b/StrataTest/Languages/Python/TestExamples.lean index 559534dc43..1a9dfa4197 100644 --- a/StrataTest/Languages/Python/TestExamples.lean +++ b/StrataTest/Languages/Python/TestExamples.lean @@ -38,10 +38,16 @@ def withPythonToLaurel (pythonCmd : System.FilePath) (input : InputContext) let exitCode ← child.wait if exitCode ≠ 0 then throw <| .userError s!"py_to_strata failed (exit code {exitCode}): {stderr}" - match ← pythonAndSpecToLaurel ionFile.toString - (sourcePath := some pyFile.toString) |>.toBaseIO with + let pctx ← Pipeline.PipelineContext.create (outputMode := .quiet) + match ← (pythonAndSpecToLaurel ionFile.toString + (sourcePath := some pyFile.toString)).run pctx |>.toBaseIO with | .ok r => k r pyFile - | .error err => throw <| .userError s!"pythonAndSpecToLaurel failed: {err}" + | .error () => + let msgs ← pctx.getMessages + let detail := match msgs.back? with + | some m => m.message + | none => "Pipeline aborted" + throw <| .userError s!"pythonAndSpecToLaurel failed: {detail}" /-- Run the Python → Ion → Laurel pipeline and return the Laurel program. The caller can inspect the Laurel IR directly or continue to Core/SMT. -/ diff --git a/StrataTest/Languages/Python/ToLaurelTest.lean b/StrataTest/Languages/Python/ToLaurelTest.lean index 534056eafa..05f096f8e9 100644 --- a/StrataTest/Languages/Python/ToLaurelTest.lean +++ b/StrataTest/Languages/Python/ToLaurelTest.lean @@ -26,6 +26,27 @@ private def assertEq [BEq α] [ToString α] (actual expected : α) : IO Unit := private def loc : SourceRange := default +private def identType (nm : PythonIdent) : SpecType := + SpecType.ident default nm + +private def noneType : SpecType := SpecType.noneType default + +private def mkUnion (types : Array SpecType) := SpecType.unionArray loc types + +private def mkArg (name : String) (type : SpecType) (default : Option SpecDefault := none) : Arg := + { name, type, default := default } + +private def mkFuncSig (name : String) (returnType : SpecType) + (args : Array Arg := #[]) (kwonly : Array Arg := #[]) + : Signature := + .functionDecl { + loc := loc, nameLoc := loc, name := name + args := { args := args, kwonly := kwonly } + returnType := returnType + isOverload := false + preconditions := #[], postconditions := #[] + } + /-! ### Output Formatting -/ private def fmtHighType : HighType → String @@ -72,7 +93,7 @@ private def fmtTypeDef : TypeDefinition → String private def runTest (sigs : Array Signature) (modulePrefix : String := "") : IO Unit := do let result := signaturesToLaurel "" sigs modulePrefix for err in result.errors do - IO.println s!"warning: {err.kind.phase}.{err.kind.category}: {err.message}" + IO.println s!"warning: {err.phase}.{err.kind.category}: {err.message}" for td in result.program.types do IO.println (fmtTypeDef td) for proc in result.program.staticProcedures do @@ -90,7 +111,235 @@ private def runTestWarningKinds (sigs : Array Signature) (modulePrefix : String let result := signaturesToLaurel "" sigs modulePrefix assert! result.errors.size > 0 for err in result.errors do - IO.println s!"{err.kind.phase}.{err.kind.category}: {err.message}" + IO.println s!"{err.phase}.{err.kind.category}: {err.message}" + +/-- Helper to make a function signature with preconditions. -/ +private def mkFuncSigWithPrecond (name : String) (returnType : SpecType) + (preconditions : Array Assertion) (args : Array Arg := #[]) : Signature := + .functionDecl { + loc := loc, nameLoc := loc, name := name + args := { args := args, kwonly := #[] } + returnType := returnType + isOverload := false + preconditions := preconditions, postconditions := #[] + } + +/-- Helper to make a function signature with postconditions. -/ +private def mkFuncSigWithPostcond (name : String) (returnType : SpecType) + (postconditions : Array SpecExpr) : Signature := + .functionDecl { + loc := loc, nameLoc := loc, name := name + args := { args := #[], kwonly := #[] } + returnType := returnType + isOverload := false + preconditions := #[], postconditions := postconditions + } + + +/-! ## All function params and returns map to Any -/ + +/-- +info: procedure returns_int(x:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure returns_bool(a:UserDefined(Any), b:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure returns_real(flag:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure with_kwonly(x:UserDefined(Any), verbose:UserDefined(Any)) returns(result:UserDefined(Any)) +-/ +#guard_msgs in +#eval runTest #[ + mkFuncSig "returns_int" (identType .builtinsInt) + (args := #[mkArg "x" (identType .builtinsStr)]), + mkFuncSig "returns_bool" (identType .builtinsBool) + (args := #[mkArg "a" (identType .builtinsInt), + mkArg "b" (identType .builtinsFloat)]), + mkFuncSig "returns_real" (identType .builtinsFloat) + (args := #[mkArg "flag" (identType .builtinsBool)]), + mkFuncSig "with_kwonly" (identType .builtinsStr) + (args := #[mkArg "x" (identType .builtinsInt)]) + (kwonly := #[mkArg "verbose" (identType .builtinsBool) (default := some .none)]) +] + +/-! ## Complex types (Any, List, Dict, bytes) -/ + +/-- +info: procedure takes_any(x:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure takes_list(items:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure returns_dict() returns(result:UserDefined(Any)) +procedure typed_list() returns(result:UserDefined(Any)) +procedure typed_dict() returns(result:UserDefined(Any)) +-/ +#guard_msgs in +#eval runTest #[ + mkFuncSig "takes_any" (identType .builtinsInt) + (args := #[mkArg "x" (identType .typingAny)]), + mkFuncSig "takes_list" (identType .builtinsBool) + (args := #[mkArg "items" (identType .typingList)]), + mkFuncSig "returns_dict" (identType .typingDict), + mkFuncSig "typed_list" + (SpecType.ident loc .typingList #[identType .builtinsStr]), + mkFuncSig "typed_dict" + (SpecType.ident loc .typingDict + #[identType .builtinsStr, identType .builtinsInt]) +] + +/-! ## Literal types, TypedDict, and string-literal unions → Any -/ + +/-- +info: warning: pySpecToLaurel.unsupportedUnion: TypedDict 'TypedDict(f : builtins.str)' approximated as DictStrAny in type 'TypedDict(f : builtins.str)' +procedure int_literal_ret() returns(result:UserDefined(Any)) +procedure str_literal_ret() returns(result:UserDefined(Any)) +procedure typed_dict_ret() returns(result:UserDefined(Any)) +procedure str_enum() returns(result:UserDefined(Any)) +-/ +#guard_msgs in +#eval runTest #[ + mkFuncSig "int_literal_ret" (SpecType.intLiteral loc 42), + mkFuncSig "str_literal_ret" + (SpecType.stringLiteral loc "hello"), + mkFuncSig "typed_dict_ret" + (SpecType.typedDict loc #["f"] + #[identType .builtinsStr] #[true]), + mkFuncSig "str_enum" + (mkUnion #[SpecType.stringLiteral loc "A", SpecType.stringLiteral loc "B", + SpecType.stringLiteral loc "C"]) +] + +/-! ## Optional type patterns (Union[None, T]) → Any -/ + +/-- +info: warning: pySpecToLaurel.unsupportedUnion: TypedDict 'TypedDict(x : builtins.str)' approximated as DictStrAny in type 'Union[_types.NoneType, TypedDict(x : builtins.str)]' +procedure opt_str() returns(result:UserDefined(Any)) +procedure opt_int() returns(result:UserDefined(Any)) +procedure opt_bool(x:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure opt_typed_dict() returns(result:UserDefined(Any)) +procedure opt_str_enum() returns(result:UserDefined(Any)) +procedure opt_int_enum() returns(result:UserDefined(Any)) +-/ +#guard_msgs in +#eval runTest #[ + mkFuncSig "opt_str" + (mkUnion #[noneType, identType .builtinsStr]), + mkFuncSig "opt_int" + (mkUnion #[noneType, identType .builtinsInt]), + mkFuncSig "opt_bool" + (mkUnion #[noneType, identType .builtinsBool]) + (args := #[mkArg "x" + (mkUnion #[noneType, identType .builtinsStr])]), + mkFuncSig "opt_typed_dict" + (mkUnion #[noneType, + SpecType.typedDict loc #["x"] #[identType .builtinsStr] #[true]]), + mkFuncSig "opt_str_enum" + (mkUnion #[noneType, SpecType.stringLiteral loc "A", + SpecType.stringLiteral loc "B"]), + mkFuncSig "opt_int_enum" + (mkUnion #[noneType, SpecType.intLiteral loc 1, SpecType.intLiteral loc 2]) +] + +/-! ## Error cases (updated to verify MessageKind) -/ + +/-- +info: procedure f() returns(result:UserDefined(Any)) +-/ +#guard_msgs in +#eval runTest + #[mkFuncSig "f" + (identType (PythonIdent.mk "foo" "Bar"))] + +/-- +info: procedure f() returns(result:UserDefined(Any)) +-/ +#guard_msgs in +#eval runTest + #[mkFuncSig "f" + (mkUnion #[identType .builtinsStr, + identType .builtinsInt])] + +/-- +info: warning: pySpecToLaurel.unsupportedUnion: No type tester for 'foo.Bar' in type 'Union[_types.NoneType, foo.Bar]' +procedure f() returns(result:UserDefined(Any)) +-/ +#guard_msgs in +#eval runTest + #[mkFuncSig "f" + (mkUnion #[noneType, + identType (PythonIdent.mk "foo" "Bar")])] + +/-! ## Class and type definitions -/ + +/-- +info: type MyClass +type MyAlias +procedure my_func(x:UserDefined(Any), y:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure MyClass@get_value() returns(result:UserDefined(Any)) +-/ +#guard_msgs in +#eval runTest #[ + mkFuncSig "my_func" (identType .builtinsBool) + (args := #[mkArg "x" (identType .builtinsInt), + mkArg "y" (identType .builtinsStr) (some .none)]), + .classDef { + loc := loc, name := "MyClass" + methods := #[ + { loc := loc, nameLoc := loc, name := "get_value" + args := { args := #[mkArg "self" (identType .builtinsStr)], kwonly := #[] } + returnType := identType .builtinsStr + isOverload := false + preconditions := #[] + postconditions := #[] } + ] + }, + .typeDef { + loc := loc, nameLoc := loc + name := "MyAlias" + definition := identType .builtinsStr + } +] + +/-! ## NoneType and void return -/ + +/-- +info: procedure returns_none() returns(result:UserDefined(Any)) +procedure takes_none(x:UserDefined(Any)) returns(result:UserDefined(Any)) +-/ +#guard_msgs in +#eval runTest #[ + mkFuncSig "returns_none" noneType, + mkFuncSig "takes_none" noneType + (args := #[mkArg "x" noneType]) +] + +/-! ## Class types as UserDefined -/ + +/-- +info: type Foo +procedure uses_class(x:UserDefined(Foo)) returns(result:UserDefined(Any)) +-/ +#guard_msgs in +#eval runTest #[ + .classDef { + loc := loc, name := "Foo" + methods := #[] + }, + mkFuncSig "uses_class" (identType (PythonIdent.mk "" "Foo")) + (args := #[mkArg "x" (identType (PythonIdent.mk "" "Foo"))]) +] + +/-! ## Empty input -/ + +#guard_msgs in +#eval runTest #[] + +/-! ## Overload dispatch and method registry -/ + +/-- Helper to make an @overload function signature. -/ +private def mkOverload (name : String) (returnType : SpecType) + (args : Array Arg := #[]) : Signature := + .functionDecl { + loc := loc, nameLoc := loc, name := name + args := { args := args, kwonly := #[] } + returnType := returnType + isOverload := true + preconditions := #[], postconditions := #[] + } /-- Run signaturesToLaurel and print the full result: Laurel output, dispatch table, and method registry. Sorts by key for stable output. -/ @@ -144,7 +393,6 @@ private def list_ := SpecType.ident loc .typingList private def dict_ := SpecType.ident loc .typingDict private def listOf (t : SpecType) := SpecType.ident loc .typingList #[t] private def dictOf (k v : SpecType) := SpecType.ident loc .typingDict #[k, v] -private def mkUnion (types : Array SpecType) := SpecType.unionArray loc types private def pyClass (name : String) := SpecType.ident loc (PythonIdent.mk "" name) private def externIdent (mod name : String) := PythonIdent.mk mod name diff --git a/StrataTest/Languages/Python/run_py_analyze.sh b/StrataTest/Languages/Python/run_py_analyze.sh index 6c271661b5..faf632dbd2 100755 --- a/StrataTest/Languages/Python/run_py_analyze.sh +++ b/StrataTest/Languages/Python/run_py_analyze.sh @@ -101,6 +101,43 @@ for test_file in tests/test_*.py; do fi done +# --- --metrics integration test --- +# Run one test file with --metrics and validate the JSONL output. +metrics_test_file=$(ls tests/test_*.py 2>/dev/null | head -1) +if [ -n "$metrics_test_file" ] && [ -z "$filter" ]; then + metrics_base=$(basename "$metrics_test_file" .py) + metrics_ion="tests/${metrics_base}.python.st.ion" + metrics_out=$(mktemp) + # Ion file should already exist from the loop above + if [ -f "$metrics_ion" ]; then + (cd ../../.. && ./.lake/build/bin/strata $command --metrics "$metrics_out" "StrataTest/Languages/Python/${metrics_ion}" 2>/dev/null) || true + if [ ! -s "$metrics_out" ]; then + echo "ERROR: --metrics file is empty for $metrics_base" + failed=1 + else + bad_lines=0 + while IFS= read -r line; do + [ -z "$line" ] && continue + if ! echo "$line" | python3 -c "import sys,json; d=json.load(sys.stdin); assert 'type' in d" 2>/dev/null; then + echo "ERROR: --metrics invalid JSON line: $line" + bad_lines=$((bad_lines + 1)) + fi + done < "$metrics_out" + # Check that an outcome record exists + if ! grep -q '"outcome"' "$metrics_out"; then + echo "ERROR: --metrics missing outcome record for $metrics_base" + failed=1 + elif [ $bad_lines -gt 0 ]; then + echo "ERROR: --metrics has $bad_lines invalid lines for $metrics_base" + failed=1 + else + echo "Test passed: --metrics JSONL ($metrics_base)" + fi + fi + fi + rm -f "$metrics_out" +fi + if [ $pending -eq 1 ]; then for test_file in tests/pending/test_*.py; do [ -f "$test_file" ] || continue diff --git a/StrataTest/Pipeline/PhaseTimingTest.lean b/StrataTest/Pipeline/PhaseTimingTest.lean new file mode 100644 index 0000000000..6a9955fdc0 --- /dev/null +++ b/StrataTest/Pipeline/PhaseTimingTest.lean @@ -0,0 +1,131 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +meta import Strata.Pipeline.Context + +/-! ## Phase timing tests + +Exercises nesting of `withPhase` and `withRepeatedPhase` to validate that: +1. Repeated phases aggregate without crashing. +2. Messages emitted inside nested phases get the correct phase path. +3. Nested `withRepeatedPhase` inside `withRepeatedPhase` does not corrupt + the parent's aggregation map. +4. `withRepeatedPhasePure` evaluates its expression. +-/ + +open Strata.Pipeline + +meta def mkCtx : BaseIO PipelineContext := + PipelineContext.create (outputMode := .quiet) (profilePipeline := false) + +meta def check (cond : Bool) (msg : String) : IO Unit := + unless cond do throw <| IO.userError msg + +/-! ### Test 1: withRepeatedPhase aggregates without error -/ + +#guard_msgs in +#eval show IO Unit from do + let ctx ← mkCtx + ctx.withPhase "outer" (m := IO) do + for _ in List.range 5 do + ctx.withRepeatedPhase "iter" (m := IO) do + pure () + +/-! ### Test 2: withPhase nested inside withRepeatedPhase runs correctly -/ + +#guard_msgs in +#eval show IO Unit from do + let ctx ← mkCtx + ctx.withPhase "outer" (m := IO) do + for _ in List.range 3 do + ctx.withRepeatedPhase "iter" (m := IO) do + ctx.withPhase "inner" (m := IO) do + pure () + +/-! ### Test 3: Messages inside withRepeatedPhase get correct phase tag -/ + +#guard_msgs in +#eval show IO Unit from do + let ctx ← mkCtx + let pipelineAction : PipelineM Unit := do + Strata.Pipeline.withPhase "outer" do + for _ in List.range 2 do + let ctx ← read + ctx.withRepeatedPhase "iter" do + emitMessage .laurelLoweringNotImpl "test warning" + let _ ← pipelineAction.run ctx |>.toBaseIO + let msgs ← ctx.getMessages + check (msgs.size == 2) s!"Expected 2 messages, got {msgs.size}" + let expectedPhase := Phase.base "outer" |>.subphase "iter" + for msg in msgs do + check (msg.phase == expectedPhase) + s!"Expected phase '{expectedPhase}', got '{msg.phase}'" + +/-! ### Test 4: Nested withRepeatedPhase does not corrupt parent -/ + +#guard_msgs in +#eval show IO Unit from do + let ctx ← mkCtx + ctx.withPhase "outer" (m := IO) do + for _ in List.range 4 do + ctx.withRepeatedPhase "a" (m := IO) do + for _ in List.range 2 do + ctx.withRepeatedPhase "b" (m := IO) do + pure () + +/-! ### Test 5: Multiple distinct withPhase inside withRepeatedPhase -/ + +#guard_msgs in +#eval show IO Unit from do + let ctx ← mkCtx + ctx.withPhase "outer" (m := IO) do + for _ in List.range 3 do + ctx.withRepeatedPhase "iter" (m := IO) do + ctx.withPhase "preprocess" (m := IO) do pure () + ctx.withPhase "solve" (m := IO) do pure () + +/-! ### Test 6: Messages inside nested withPhase get deepest phase path -/ + +#guard_msgs in +#eval show IO Unit from do + let ctx ← mkCtx + let pipelineAction : PipelineM Unit := do + Strata.Pipeline.withPhase "parent" do + let ctx ← read + ctx.withRepeatedPhase "iter" do + Strata.Pipeline.withPhase "child" do + emitMessage .laurelLoweringNotImpl "deep msg" + let _ ← pipelineAction.run ctx |>.toBaseIO + let msgs ← ctx.getMessages + check (msgs.size == 1) s!"Expected 1 message, got {msgs.size}" + let expectedPhase := Phase.base "parent" |>.subphase "iter" |>.subphase "child" + match msgs[0]? with + | some msg => + check (msg.phase == expectedPhase) + s!"Expected phase '{expectedPhase}', got '{msg.phase}'" + | none => throw <| IO.userError "unreachable" + +/-! ### Test 7: withRepeatedPhasePure evaluates expression -/ + +/-- +info: withRepeatedPhasePure: evaluating +withRepeatedPhasePure: evaluating +withRepeatedPhasePure: evaluating +withRepeatedPhasePure: evaluating +-/ +#guard_msgs in +#eval show IO Unit from do + let ctx ← mkCtx + let evalRef ← IO.mkRef (0 : Nat) + ctx.withPhase "outer" (m := IO) do + for _ in List.range 4 do + let _ ← ctx.withRepeatedPhasePure "compute" fun () => + dbg_trace "withRepeatedPhasePure: evaluating" + 42 + evalRef.modify (· + 1) + let count ← evalRef.get + check (count == 4) s!"Expected 4 evaluations, got {count}" diff --git a/StrataTestExtra/Languages/Python/AnalyzeLaurelTest.lean b/StrataTestExtra/Languages/Python/AnalyzeLaurelTest.lean index 0b2c761a2e..b706b5ede7 100644 --- a/StrataTestExtra/Languages/Python/AnalyzeLaurelTest.lean +++ b/StrataTestExtra/Languages/Python/AnalyzeLaurelTest.lean @@ -23,13 +23,17 @@ Messaging) are generic and not tied to any cloud provider. namespace Strata.Python.AnalyzeLaurelTest open Strata (pythonAndSpecToLaurel pySpecsDir) +open Strata.Pipeline (PipelineContext) -private meta def testDir : System.FilePath := +meta def quietCtx : BaseIO PipelineContext := + PipelineContext.create (outputMode := .quiet) + +meta def testDir : System.FilePath := "StrataTestExtra/Languages/Python/Specs/dispatch_test" /-- Compile a Python source file to a `.python.st.ion` Ion file. Returns the path to the generated Ion file. -/ -private meta def compilePython +meta def compilePython (pythonCmd : System.FilePath) (dialectFile : System.FilePath) (pyFile : System.FilePath) (outDir : System.FilePath) : IO System.FilePath := do @@ -57,7 +61,7 @@ private meta def compilePython /-- Set up the test fixture: compile all servicelib modules and return the spec directory. The dispatch and pyspec modules are resolved by name. -/ -private meta def setupFixture (pythonCmd : System.FilePath) +meta def setupFixture (pythonCmd : System.FilePath) (outDir : System.FilePath) : IO Unit := do IO.FS.withTempFile fun _handle dialectFile => do IO.FS.writeBinFile dialectFile Python.Python.toIon @@ -70,7 +74,7 @@ private meta def setupFixture (pythonCmd : System.FilePath) | .error msg => throw <| IO.userError s!"pySpecsDir failed: {msg}" /-- Compile a test Python file to Ion format. -/ -private meta def compileTestScript (pythonCmd : System.FilePath) +meta def compileTestScript (pythonCmd : System.FilePath) (pyFile : System.FilePath) (outDir : System.FilePath) : IO System.FilePath := do IO.FS.withTempFile fun _handle dialectFile => do @@ -78,17 +82,26 @@ private meta def compileTestScript (pythonCmd : System.FilePath) compilePython pythonCmd dialectFile pyFile outDir /-- Run pyAnalyzeLaurel on a test script within the shared fixture. -/ -private meta def runAnalyze +meta def runAnalyze (pythonCmd : System.FilePath) (tmpDir : System.FilePath) (scriptName : String) : IO (Except String Core.Program) := do let testIon ← compileTestScript pythonCmd (testDir / scriptName) tmpDir + let pctx ← quietCtx let laurel ← - match ← Strata.pythonAndSpecToLaurel testIon.toString + match ← (Strata.pythonAndSpecToLaurel testIon.toString (dispatchModules := #["servicelib"]) - (specDir := tmpDir) |>.toBaseIO with + (specDir := tmpDir)).run pctx |>.toBaseIO with | .ok r => pure r - | .error err => return .error (toString err) + | .error () => + -- Flag tool errors, then user errors, then general + if let some r := (← pctx.getToolErrors).back? then + return .error <| r.message + if let some r := (← pctx.getUserCodeErrors).back? then + return .error <| s!"User code error: {r.message}" + if let some m := (←pctx.getMessages).back? then + return .error m.message + return .error "Pipeline aborted for unspecified reason (bug)" match ← Strata.translateCombinedLaurel laurel with | (some core, []) => -- Also run Core type checking to catch semantic errors (e.g. Heap vs Any) @@ -100,18 +113,22 @@ private meta def runAnalyze /-- Run pyAnalyzeLaurel with inlining and verification. When `useRoots` is true, entry points are determined via the call graph (the CLI `--entry-point roots` default); otherwise only `__main__` is used. -/ -private meta def runAnalyzeAndVerify +meta def runAnalyzeAndVerify (pythonCmd : System.FilePath) (tmpDir : System.FilePath) (scriptName : String) (useRoots : Bool := false) : IO (Except String (Array Core.VCResult)) := do let testIon ← compileTestScript pythonCmd (testDir / scriptName) tmpDir + let pctx ← quietCtx let laurel ← - match ← Strata.pythonAndSpecToLaurel testIon.toString + match ← (Strata.pythonAndSpecToLaurel testIon.toString (dispatchModules := #["servicelib"]) - (specDir := tmpDir) |>.toBaseIO with + (specDir := tmpDir)).run pctx |>.toBaseIO with | .ok r => pure r - | .error err => return .error (toString err) + | .error () => + let msgs ← pctx.getMessages + let detail := match msgs.back? with | some m => m.message | none => "Pipeline aborted" + return .error detail let (coreProgramOption, _) ← Strata.translateCombinedLaurel laurel let coreProgram ← match coreProgramOption with | none => return .error "Laurel to Core translation failed" @@ -144,13 +161,13 @@ private meta def runAnalyzeAndVerify | .error msg => return .error (toString msg) /-- Expected outcome for a test case. -/ -private inductive Expected where +inductive Expected where | success | fail (msg : String) | failPrefix (pfx : String) /-- All dispatch test cases: (filename, expected outcome). -/ -private meta def testCases : List (String × Expected) := [ +meta def testCases : List (String × Expected) := [ -- Positive tests .mk "test_single_service.py" .success, .mk "test_multi_service.py" .success, @@ -206,7 +223,7 @@ private meta def testCases : List (String × Expected) := [ ] /-- Run a single test case and return an error message on failure, or `none` on success. -/ -private meta def runTestCase (pythonCmd : System.FilePath) (tmpDir : System.FilePath) +meta def runTestCase (pythonCmd : System.FilePath) (tmpDir : System.FilePath) (scriptName : String) (expected : Expected) : IO (Option String) := do let result ← runAnalyze pythonCmd tmpDir scriptName match expected, result with @@ -246,13 +263,17 @@ private meta def runTestCase (pythonCmd : System.FilePath) (tmpDir : System.File -- causes a type unification error in Core.typeCheck, which is expected. let task ← IO.asTask do let testIon ← compileTestScript pythonCmd (testDir / "test_class_any_as_composite.py") tmpDir + let pctx ← quietCtx let laurel ← - match ← Strata.pythonAndSpecToLaurel testIon.toString + match ← (Strata.pythonAndSpecToLaurel testIon.toString (dispatchModules := #["servicelib"]) (pyspecModules := #["servicelib.Storage"]) - (specDir := tmpDir) |>.toBaseIO with + (specDir := tmpDir)).run pctx |>.toBaseIO with | .ok r => pure r - | .error err => return some s!"test_class_any_as_composite.py: {err}" + | .error () => + let msgs ← pctx.getMessages + let detail := match msgs.back? with | some m => m.message | none => "Pipeline aborted" + return some s!"test_class_any_as_composite.py: {detail}" match ← Strata.translateCombinedLaurel laurel with | (some core, []) => match Core.typeCheck Core.VerifyOptions.quiet core (moreFns := Strata.Python.ReFactory) with @@ -372,12 +393,16 @@ recursively translates subclasses, so the type setupFixture pythonCmd tmpDir let testIon ← compileTestScript pythonCmd (testDir / "test_resolution_after_filter.py") tmpDir + let pctx ← quietCtx let combined ← - match ← Strata.pythonAndSpecToLaurel testIon.toString + match ← (Strata.pythonAndSpecToLaurel testIon.toString (dispatchModules := #["servicelib"]) - (specDir := tmpDir) |>.toBaseIO with + (specDir := tmpDir)).run pctx |>.toBaseIO with | .ok r => pure r - | .error err => throw <| IO.userError s!"pyAnalyzeLaurel failed: {err}" + | .error () => + let msgs ← pctx.getMessages + let detail := match msgs.back? with | some m => m.message | none => "Pipeline aborted" + throw <| IO.userError s!"pyAnalyzeLaurel failed: {detail}" let result := Laurel.resolve combined unless result.errors.isEmpty do let msgs := result.errors.toList.map (·.message) diff --git a/StrataTestExtra/Languages/Python/Specs/IdentifyOverloadsTest.lean b/StrataTestExtra/Languages/Python/Specs/IdentifyOverloadsTest.lean index 6da52f61a7..34fab79887 100644 --- a/StrataTestExtra/Languages/Python/Specs/IdentifyOverloadsTest.lean +++ b/StrataTestExtra/Languages/Python/Specs/IdentifyOverloadsTest.lean @@ -75,10 +75,11 @@ private meta def buildOverloadTable throw <| .userError s!"pySpecsDir failed for {pyFile}: {msg}" let some ionPath := pySpecOutputPath testDir outDir pyFile | throw <| .userError s!"Cannot derive output path for {pyFile}" - match ← readDispatchOverloads #[ionPath.toString] |>.toBaseIO with - | .ok (tbl, _) => return tbl - | .error msg => - throw <| .userError s!"readDispatchOverloads failed: {msg}" + let ctx ← Strata.Pipeline.PipelineContext.create + match ← (readDispatchOverloads ctx #[ionPath.toString]).toBaseIO with + | .ok tbl => return tbl + | .error () => + throw <| .userError s!"readDispatchOverloads failed for {ionPath}" /-- Parse a user Python Ion file into statements. -/ private meta def parseStmts (ionPath : System.FilePath) From 4c669052eede6ab851606d8169e279d739bcd641 Mon Sep 17 00:00:00 2001 From: Juneyoung Lee <136006969+aqjune-aws@users.noreply.github.com> Date: Tue, 19 May 2026 17:07:53 -0500 Subject: [PATCH 18/28] Remove internal benchmark CI (#1188) **Warning:** This repository will shortly undergo a split into several separate repositories. If you're creating a PR that crosses the boundaries between these repositories, you may want to hold off until the split is complete or be prepared to rework your PR into multiple PRs once the split is complete. The code that will be moved includes: - Strata/DDM/* - Strata/Languages/Boole/* - Strata/Languages/Python/* along with Tools/Python/* - Tools/BoogieToStrata --- .github/workflows/ci.yml | 48 ---------------------------------------- 1 file changed, 48 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 9772e523dd..6fc9cc26de 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -260,51 +260,3 @@ jobs: permissions: contents: read uses: ./.github/workflows/cbmc.yml - - strata-benchmarks: - name: Run internal benchmarks of Strata - runs-on: ubuntu-latest - permissions: - id-token: write - contents: read - steps: - - name: Configure AWS credentials - uses: aws-actions/configure-aws-credentials@v6 - with: - role-to-assume: arn:aws:iam::${{secrets.AWS_BENCHMARK_ACCOUNT}}:role/github-actions-codebuild-role - aws-region: us-east-2 - - - name: Trigger CodeBuild and wait - shell: bash - run: | - aws --version - BUILD_ID=$(aws codebuild start-build \ - --project-name strata-benchmarks \ - --source-type-override GITHUB \ - --source-location-override https://github.com/strata-org/Strata.git \ - --source-version ${{ github.event.pull_request.head.sha || github.sha }} \ - --query 'build.id' --output text \ - --region us-east-2) - echo "Build started: $BUILD_ID" - echo "CodeBuild console: https://us-east-2.console.aws.amazon.com/codesuite/codebuild/projects/strata-benchmarks/build/${BUILD_ID}/?region=us-east-2" - - LOG_KEY="logs/${BUILD_ID}.log" - echo "[View build log in S3](https://s3.console.aws.amazon.com/s3/object/strata-internal-benchmarks-logs?prefix=${LOG_KEY})" >> $GITHUB_STEP_SUMMARY - - while true; do - STATUS=$(aws codebuild batch-get-builds \ - --ids "$BUILD_ID" \ - --query 'builds[0].buildStatus' --output text \ - --region us-east-2) - echo "Current status: [$STATUS]" - case "$STATUS" in - SUCCEEDED) break;; - FAILED|FAULT|TIMED_OUT|STOPPED) echo "Build failed: $STATUS" ; break ;; - IN_PROGRESS) sleep 30 ;; - *) echo "Unexpected status: $STATUS"; sleep 10 ; break ;; - esac - done - - echo "View build log in S3: https://s3.console.aws.amazon.com/s3/object/strata-internal-benchmarks-logs?prefix=${LOG_KEY}" - - test "$STATUS" = "SUCCEEDED" From b61880fb112791db7e6c67c89612e6de1b7aa4ee Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Wed, 20 May 2026 07:00:57 -0700 Subject: [PATCH 19/28] Replace empty module name strings with validated ModuleName type (#1151) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit ## Summary `PythonIdent.pythonModule` was a raw `String`, allowing empty module names to propagate silently through the system and cause downstream failures (see #1143). This PR changes `pythonModule` to use `ModuleName` — which now guarantees at least one non-empty component — and adopts it more widely through the PySpec pipeline, eliminating this class of bugs at the type level. ## Approach Rather than adding runtime checks at each use site, `ModuleName` gains a strengthened invariant via a private constructor enforcing non-empty components. `PythonIdent.ofComponent` uses `decide` to verify non-emptiness at compile time for literal module names (used in `Decls.lean`). Runtime parsing goes through `ModuleName.ofString?` which returns `Option`. ## Key changes - **PythonIdent.lean**: `PythonIdent.pythonModule` changed from `String` to `ModuleName`. New `ofComponent` constructor with compile-time proof for single-component literals. `ModuleName` API extended: `back`, `parent (n)`, `push`, `append`/`++`, `toString (sep)` - **PythonIdent.lean**: New `ModuleName.ofRelativePath` provides a single canonical function for deriving a `ModuleName` from a `.py` file path relative to a search root, handling both regular files and `__init__.py` packages. This eliminates redundant ad-hoc implementations scattered across `discoverModules`, `RelativeImportTest`, and `findInPath` — each of which had slightly different `__init__.py` handling, creating inconsistency and latent bugs (e.g., `pySpecToLaurelCommand` silently failed for package modules) - **Specs.lean**: `findInPath` simplified to return `(FilePath × Bool)` instead of `(FilePath × Array ModuleComponent)` — the `Bool` is `isInit`, and callers use `ModuleOfPath.modulePrefix` to derive the package prefix. Deleted unused `ofFile` function - **Specs/DDM.lean**: Converted `fromDDM` functions to monadic `FromDDM` (`Except (SourceRange × String)`) for proper error propagation instead of panics - **Specs/ToLaurel.lean**: `signaturesToLaurel` takes `ModuleName` instead of `String` prefix. Overload extraction factored into dedicated `ExtractM` monad (no dependency on `ToLaurelContext`) - **PySpecPipeline.lean**: `buildPySpecLaurel` takes `Array (ModuleName × String)` instead of `Array (String × String)` - **Specs.lean**: Import resolution uses `ModuleName` throughout; `translateFile` requires a `ModuleName` (no longer optional) - **Specs/Decls.lean**: Builtin idents use `ofComponent` with compile-time proof ### Unrelated cleanup - Deleted `Strata.Python.containsSubstr` helper and replaced all call sites with `String.contains` (which accepts substring patterns in Lean 4.29) By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: Claude Opus 4.6 --- Strata/Languages/Python/OverloadTable.lean | 26 +- Strata/Languages/Python/PySpecPipeline.lean | 57 +-- Strata/Languages/Python/PythonIdent.lean | 251 +++++++++++++ Strata/Languages/Python/PythonToLaurel.lean | 12 +- Strata/Languages/Python/Specs.lean | 343 +++++++----------- Strata/Languages/Python/Specs/DDM.lean | 135 +++---- Strata/Languages/Python/Specs/Decls.lean | 54 +-- .../Python/Specs/IdentifyOverloads.lean | 4 +- Strata/Languages/Python/Specs/ToLaurel.lean | 82 +++-- Strata/SimpleAPI.lean | 39 +- StrataMainLib.lean | 4 +- .../Languages/Python/PySpecArgTypeTest.lean | 18 +- StrataTest/Languages/Python/ToLaurelTest.lean | 197 +++++----- StrataTest/Util/Python.lean | 28 +- .../Languages/Python/DictNoneTest.lean | 6 +- .../Python/Specs/IdentifyOverloadsTest.lean | 27 +- .../Python/Specs/RelativeImportTest.lean | 24 +- .../Languages/Python/SpecsTest.lean | 4 +- .../Languages/Python/VerifyPythonTest.lean | 20 +- 19 files changed, 730 insertions(+), 601 deletions(-) create mode 100644 Strata/Languages/Python/PythonIdent.lean diff --git a/Strata/Languages/Python/OverloadTable.lean b/Strata/Languages/Python/OverloadTable.lean index e853cfcc7d..6edb232236 100644 --- a/Strata/Languages/Python/OverloadTable.lean +++ b/Strata/Languages/Python/OverloadTable.lean @@ -5,36 +5,12 @@ -/ module public import Std.Data.HashMap.Basic +public import Strata.Languages.Python.PythonIdent public section namespace Strata.Python -/-- -A fully-qualified Python identifier consisting of a module path and a name. -For example, `typing.List` has module "typing" and name "List". --/ -structure PythonIdent where - pythonModule : String - name : String - deriving DecidableEq, Hashable, Inhabited, Ord, Repr - -namespace PythonIdent - -protected def ofString (s : String) : Option PythonIdent := - match s.revFind? '.' with - | none => none - | some idx => - some { - pythonModule := s.extract s.startPos idx - name := s.extract idx.next! s.endPos - } - -instance : ToString PythonIdent where - toString i := s!"{i.pythonModule}.{i.name}" - -end PythonIdent - /-- All overloads for a single function name: maps a string literal argument value to the return type (`PythonIdent`), together with diff --git a/Strata/Languages/Python/PySpecPipeline.lean b/Strata/Languages/Python/PySpecPipeline.lean index f0bc843efb..5c05cfc37a 100644 --- a/Strata/Languages/Python/PySpecPipeline.lean +++ b/Strata/Languages/Python/PySpecPipeline.lean @@ -95,8 +95,8 @@ private def funcDeclToFunctionDecl (name : String) (args : Python.Specs.ArgDecls Handles both top-level functions and class methods. Strips `self` from class methods and expands `**kwargs` TypedDict fields. -/ private def extractFunctionSignatures (sigs : Array Python.Specs.Signature) - (modulePrefix : String) : Except String (Array Python.PythonFunctionDecl) := do - let funcPrefix := if modulePrefix.isEmpty then "" else modulePrefix ++ "_" + (moduleName : Python.ModuleName) : Except String (Array Python.PythonFunctionDecl) := do + let funcPrefix := moduleName.toString (sep := "_") ++ "_" let mut result : Array Python.PythonFunctionDecl := #[] for sig in sigs do match sig with @@ -130,10 +130,10 @@ private def mergeOverloads (old new : OverloadTable) : OverloadTable := accumulated into one `Laurel.Program`, and overload dispatch entries are merged into a single table. - Each entry is a `(modulePrefix, ionPath)` pair. The `modulePrefix` is used + Each entry is a `(moduleName, ionPath)` pair. The module name is used to namespace all generated Laurel names (e.g., `"servicelib_Storage"` for module `servicelib.Storage`). -/ -private def buildPySpecLaurelM (pyspecEntries : Array (String × String)) +private def buildPySpecLaurelM (pyspecEntries : Array (Python.ModuleName × String)) (overloads : OverloadTable) : Pipeline.PipelineM PySpecLaurelResult := do let mut combinedProcedures : Array (Laurel.Procedure × String) := #[] let mut combinedTypes : Array (Laurel.TypeDefinition × String) := #[] @@ -141,7 +141,7 @@ private def buildPySpecLaurelM (pyspecEntries : Array (String × String)) let mut funcSigs : Array Python.PythonFunctionDecl := #[] let mut allTypeAliases : Std.HashMap String String := {} let mut allExhaustiveClasses : Std.HashSet String := {} - for (modulePrefix, ionPath) in pyspecEntries do + for (moduleName, ionPath) in pyspecEntries do let ionFile : System.FilePath := ionPath let sigs ← match ← Python.Specs.readDDM ionFile |>.toBaseIO with @@ -149,14 +149,14 @@ private def buildPySpecLaurelM (pyspecEntries : Array (String × String)) | .error msg => emitMessageAndAbort .pySpecReadError msg (file := ionFile) let { program, errors, overloads, typeAliases, exhaustiveClasses } := - Python.Specs.ToLaurel.signaturesToLaurel ionPath sigs modulePrefix + Python.Specs.ToLaurel.signaturesToLaurel ionPath sigs moduleName for msg in errors do Pipeline.addMessage msg if msg.kind.impact.isFatal then throw () allOverloads := mergeOverloads allOverloads overloads allTypeAliases := typeAliases.fold (init := allTypeAliases) fun m k v => m.insert k v allExhaustiveClasses := exhaustiveClasses.fold (init := allExhaustiveClasses) fun s name => s.insert name - match extractFunctionSignatures sigs modulePrefix with + match extractFunctionSignatures sigs moduleName with | .ok fs => funcSigs := funcSigs ++ fs | .error msg => emitMessageAndAbort .functionSignatureError msg (file := ionFile) @@ -206,7 +206,7 @@ private def buildPySpecLaurelM (pyspecEntries : Array (String × String)) tables into a single combined result. -/ public def buildPySpecLaurel (ctx : Pipeline.PipelineContext) - (pyspecEntries : Array (String × String)) + (pyspecEntries : Array (Python.ModuleName × String)) (overloads : OverloadTable) : EIO Unit PySpecLaurelResult := buildPySpecLaurelM pyspecEntries overloads |>.run ctx @@ -234,30 +234,35 @@ public def readDispatchOverloads (dispatchPaths : Array String) : EIO Unit OverloadTable := readDispatchOverloadsM dispatchPaths |>.run ctx -/-- Resolve a parsed module name to its spec prefix and .ion path. +/-- Resolve a parsed module name to its .ion path. Returns `none` if the file is not found on disk. -/ -private def resolveModuleEntry (mod : Python.Specs.ModuleName) (specDir : System.FilePath) - : Pipeline.PipelineM (Option (String × String)) := do +private def resolveModuleEntry (mod : Python.ModuleName) (specDir : System.FilePath) + : Pipeline.PipelineM (Option (Python.ModuleName × String)) := do match ← mod.specIonPath specDir with | some specPath => - let pfx := "_".intercalate mod.components.toList - return some (pfx, specPath.toString) + return some (mod, specPath.toString) | none => return none -/-- Resolve module names that must exist. Fatal on invalid name or missing file. -/ +/-- Resolve already-parsed module names that must exist. Fatal on missing file. -/ +private def resolveModuleNames (modules : Array Python.ModuleName) (specDir : System.FilePath) + : Pipeline.PipelineM (Array (Python.ModuleName × String)) := do + let mut entries : Array (Python.ModuleName × String) := #[] + for mod in modules do + let some entry ← resolveModuleEntry mod specDir + | emitMessageAndAbort .missingPySpecModule + s!"PySpec module '{mod}' not found in {specDir}" (file := specDir) + entries := entries.push entry + return entries + +/-- Resolve module name strings that must exist. Fatal on invalid name or missing file. -/ private def resolveModules (modules : Array String) (specDir : System.FilePath) - : Pipeline.PipelineM (Array (String × String)) := do - let mut entries : Array (String × String) := #[] + : Pipeline.PipelineM (Array (Python.ModuleName × String)) := do + let mut parsed : Array Python.ModuleName := #[] for modName in modules do - match Python.Specs.ModuleName.ofString modName with - | .error _ => - emitMessageAndAbort .invalidModuleName s!"invalid module name '{modName}'" (file := specDir) - | .ok mod => - let some entry ← resolveModuleEntry mod specDir - | emitMessageAndAbort .missingPySpecModule - s!"PySpec module '{modName}' not found in {specDir}" (file := specDir) - entries := entries.push entry - return entries + let some mod := Python.ModuleName.ofString? modName + | emitMessageAndAbort .invalidModuleName s!"invalid module name '{modName}'" (file := specDir) + parsed := parsed.push mod + resolveModuleNames parsed specDir /-- Build dispatch overload table, auto-resolve pyspec files @@ -286,7 +291,7 @@ public def resolveAndBuildLaurelPrelude let autoSpecEntries ← if dispatchModules.size > 0 then let resolvedMods := resolveState.modules.toArray.qsort (· < ·) - resolveModules resolvedMods specDir + resolveModuleNames resolvedMods specDir else pure #[] -- Explicit pyspec modules (fatal on invalid name or missing file) let explicitEntries ← resolveModules pyspecModules specDir diff --git a/Strata/Languages/Python/PythonIdent.lean b/Strata/Languages/Python/PythonIdent.lean new file mode 100644 index 0000000000..58960fe207 --- /dev/null +++ b/Strata/Languages/Python/PythonIdent.lean @@ -0,0 +1,251 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public section +namespace Strata.Python + +abbrev ModuleComponent := { nm : String // nm ≠ "" } + +def ModuleComponent.ofString (s : String) (h : s ≠ "" := by decide) : ModuleComponent := ⟨s, h⟩ + +/-- +A Python module name split into its dot-separated components. +For example, `typing.List` has components `["typing", "List"]`. +The size constraint ensures at least one component exists. +-/ +structure ModuleName where + mk :: + components : Array ModuleComponent + components_size_pos : components.size > 0 + deriving DecidableEq, Hashable, Ord + +namespace ModuleName + +instance : LT ModuleName where + lt a b := compare a b == .lt + +instance (a b : ModuleName) : Decidable (a < b) := + inferInstanceAs (Decidable (compare a b == .lt)) + +instance : Inhabited ModuleName where + default := private { + components := #[⟨"placeholder", by simp⟩], + components_size_pos := by simp + } + + +private +def ofSliceAux (mod : String.Slice) (a : Array ModuleComponent) (start cur : mod.Pos) : Option ModuleName := + if h : cur.IsAtEnd then + let r := mod.extract start cur + if ne : r = "" then + .none + else + some { + components := a.push ⟨r, ne⟩ + components_size_pos := by simp + } + else + let c := cur.get h + if _ : c = '.' then + let r := mod.extract start cur + if ne : r = "" then + .none + else + let next := cur.next h + ofSliceAux mod (a.push ⟨r, ne⟩) next next + else + let next := cur.next h + ofSliceAux mod a start next + termination_by cur + +/-- Parses a dot-separated module name string (e.g., "typing.List"). -/ +def ofSlice? (mod : String.Slice) : Option ModuleName := + ofSliceAux mod #[] mod.startPos mod.startPos + +/-- Parses a dot-separated module name string (e.g., "typing.List"). -/ +def ofString? (mod : String) : Option ModuleName := + ofSlice? mod.toSlice + +/-- +Parses a dot-separated module name string (e.g., "typing.List") +and panics if parsing fails. +-/ +def ofString! (mod : String) : ModuleName := + match ofString? mod with + | .some m => m + | .none => panic! s!"Malformed module {mod}" -- nopanic:ok + +/-- Convert a module name to a string, joining components with `sep` (default `"."`). -/ +protected def toString (m : ModuleName) (sep : String := ".") : String := + let p : m.components.size > 0 := m.components_size_pos + m.components.foldl (init := m.components[0]) (start := 1) fun a m => + a ++ sep ++ m.val + +instance : ToString ModuleName where + toString m := m.toString + +/-- The last component of the module name. E.g., `"typing.List"` → `"List"`. -/ +def back (m : ModuleName) : String := + let p := m.components_size_pos + m.components.back.val + +/-- Drop the last `n` components. Returns `none` if fewer than `n` components remain. -/ +def parent (m : ModuleName) (n : Nat := 1) : Option ModuleName := + let c := m.components.take (m.components.size - n) + if h : c.size > 0 then + some ⟨c, h⟩ + else + none + +#guard (ModuleName.ofString! "a.b.c" |>.parent).map ModuleName.toString = some "a.b" +#guard (ModuleName.ofString! "a" |>.parent) = none +#guard (ModuleName.ofString! "a.b.c" |>.parent (n := 2)).map ModuleName.toString = some "a" +#guard (ModuleName.ofString! "a.b.c" |>.parent (n := 3)) = none + +/-- Create a single-component module name. -/ +def ofComponent (c : ModuleComponent) : ModuleName := + ⟨#[c], by simp⟩ + +/-- Append a component to the end. E.g., `"typing".push "List"` → `"typing.List"`. -/ +def push (m : ModuleName) (c : ModuleComponent) : ModuleName := + ⟨m.components.push c, by simp⟩ + +/-- Concatenate two module names. E.g., `"a.b" ++ "c.d"` → `"a.b.c.d"`. -/ +def append (m1 m2 : ModuleName) : ModuleName := + ⟨m1.components ++ m2.components, by have p := m1.components_size_pos; grind⟩ + +instance : HAppend ModuleName ModuleName ModuleName where + hAppend := append + +instance : Repr ModuleName where + reprPrec m prec := Repr.addAppParen s!"Strata.ModuleName.ofString! {m}" prec + +/-- +Result of parsing a Python file path into a module name. +`isInit` indicates whether the file is a package `__init__.py`. +-/ +structure ModuleOfPath where + moduleName : ModuleName + isInit : Bool + deriving DecidableEq, Repr + +namespace ModuleOfPath + +/-- The package prefix for relative import resolution. + For `__init__.py` files, this is the full module name's components. + For regular files, this is the module name minus the last component (may be empty). -/ +def modulePrefix (m : ModuleOfPath) : Array ModuleComponent := + if m.isInit then + m.moduleName.components + else + m.moduleName.components.take (m.moduleName.components.size - 1) + +/-- Package prefix as a ModuleName, or none for top-level modules. -/ +def modulePrefix? (m : ModuleOfPath) : Option ModuleName := + if m.isInit then some m.moduleName + else m.moduleName.parent + +end ModuleOfPath + +/-- Derive a `ModuleName` from a file path relative to a search root. + + Examples: + "module.py" → .ok { moduleName := "module", isInit := false } + "service/__init__.py" → .ok { moduleName := "service", isInit := true } + "service/sub/module.py" → .ok { moduleName := "service.sub.module", isInit := false } + "service/sub/__init__.py" → .ok { moduleName := "service.sub", isInit := true } + + Fails if the path doesn't end in `.py` or would produce an empty component. -/ +def ofRelativePath (relativePath : System.FilePath) : Except String ModuleOfPath := do + let parts := relativePath.components |>.toArray + let some last := parts.back? + | throw s!"empty path: {relativePath}" + let (stems, isInit) ← + if last == "__init__.py" then + pure (parts.pop, true) + else if last.endsWith ".py" then + pure (parts.pop.push (last.dropEnd 3 |>.toString), false) + else + throw s!"path does not end in .py: {relativePath}" + let components : Array ModuleComponent ← stems.mapM fun s => + if h : s = "" then + throw s!"empty component in path: {relativePath}" + else + return ⟨s, h⟩ + if h : components.size > 0 then + .ok { moduleName := ⟨components, h⟩, isInit } + else + throw s!"no module components in path: {relativePath}" + +private def testOfRelativePath (path : String) (expectedMod : String) (expectedInit : Bool) : Bool := + match ofRelativePath path with + | .ok info => info.moduleName.toString == expectedMod && info.isInit == expectedInit + | .error _ => false + +#guard testOfRelativePath "module.py" "module" false +#guard testOfRelativePath "service/__init__.py" "service" true +#guard testOfRelativePath "service/sub/module.py" "service.sub.module" false +#guard testOfRelativePath "service/sub/__init__.py" "service.sub" true +#guard ofRelativePath "readme.txt" |>.isOk |>.not +#guard ofRelativePath "__init__.py" |>.isOk |>.not + +#guard (ModuleName.ofString! "a.b.c").toString = "a.b.c" +#guard (ModuleName.ofString! "a").toString = "a" +#guard ModuleName.ofString? "" = none +#guard ModuleName.ofString? "." = none +#guard ModuleName.ofString? "a." = none +#guard ModuleName.ofString? ".a" = none +#guard ModuleName.ofString? "a..b" = none +#guard (ModuleName.ofString! "a.b.c").back = "c" +#guard (ModuleName.ofComponent ⟨"x", by decide⟩).back = "x" +#guard ((ModuleName.ofString! "a") ++ (ModuleName.ofString! "b.c")).toString = "a.b.c" + +end ModuleName + +/-- +A fully-qualified Python identifier consisting of a module path and a name. +For example, `typing.List` has module "typing" and name "List". +-/ +structure PythonIdent where + mkRaw :: + pythonModule : ModuleName + name : String + deriving DecidableEq, Hashable, Ord, Repr + +namespace PythonIdent + +instance : Inhabited PythonIdent where + default := { + pythonModule := default + name := "default" + } + +/-- Construct from a single-component module name. Compile-time error if `mod` is empty. -/ +def ofComponent (mod : String) (name : String) (h : mod ≠ "" := by decide) : PythonIdent := + { pythonModule := .ofComponent ⟨mod, h⟩, name } + +protected def ofString (s : String) : Option PythonIdent := do + let idx ← s.revFind? '.' + let m ← ModuleName.ofString? (s.extract s.startPos idx) + let next ← idx.next? + some { + pythonModule := m + name := s.extract next s.endPos + } + +/-- Convert to a string, joining module components and name with `sep` (default `"."`). -/ +protected def toString (i : PythonIdent) (sep : String := ".") : String := + i.pythonModule.toString sep ++ sep ++ i.name + +instance : ToString PythonIdent where + toString := PythonIdent.toString + +end PythonIdent + +end Strata.Python +end diff --git a/Strata/Languages/Python/PythonToLaurel.lean b/Strata/Languages/Python/PythonToLaurel.lean index 82cc202643..c6e0dd3bfa 100644 --- a/Strata/Languages/Python/PythonToLaurel.lean +++ b/Strata/Languages/Python/PythonToLaurel.lean @@ -489,12 +489,7 @@ def resolveDispatch (ctx : TranslationContext) let suffix := if fnOverloads.entries.size > 2 then s!" ... ({fnOverloads.entries.size} total)" else "" throwUserError range s!"'{funcName}' called with unknown string \"{s.val}\"; known services: {knownServices}{suffix}" - let className := - if ident.pythonModule.isEmpty then - ident.name - else - ident.pythonModule.replace "." "_" ++ "_" ++ ident.name - return some className + return some <| ident.toString (sep := "_") | _ => return none /-! ## Expression Translation -/ @@ -2752,10 +2747,7 @@ def pythonToLaurel (info : PreludeInfo) let overloadCompositeType := Std.HashSet.ofList $ (overloadTable.values.flatMap (·.entries.values)).map fun ident => - if ident.pythonModule.isEmpty then - ident.name - else - ident.pythonModule ++ "_" ++ ident.name + ident.toString (sep := "_") let mut compositeTypeNames := info.compositeTypes.union overloadCompositeType -- FIRST PASS: Collect all class definitions and field type info diff --git a/Strata/Languages/Python/Specs.lean b/Strata/Languages/Python/Specs.lean index 643ea11eb8..92663d1706 100644 --- a/Strata/Languages/Python/Specs.lean +++ b/Strata/Languages/Python/Specs.lean @@ -14,129 +14,46 @@ import Strata.Languages.Python.Specs.MessageKind import Strata.Pipeline.Messages import Strata.Util.DecideProp -open Strata.Pipeline - -namespace Strata.Python.Specs - -/-- Type class for monads that support PySpec error and warning reporting. -/ -public class PySpecMClass (m : Type → Type) where - /-- Report an error at a specific source location. -/ - specError (loc : SourceRange) (message : String) : m Unit - /-- Report a warning at a specific source location. -/ - specWarning (loc : SourceRange) (message : String) : m Unit - /-- Run an action and check if any new errors were reported. -/ - runChecked {α} (act : m α) : m (Bool × α) - /-- Run an action and return `true` if no new errors or warnings were reported. -/ - runNoWarn {α} (act : m α) : m (Bool × α) - -open PySpecMClass (specError specWarning runChecked runNoWarn) - -/-- String identifier for event types. -/ -public abbrev EventType := String - -/-- Event type for module imports. -/ -def importEvent : EventType := "import" - -/-- -Log message for event type if enabled in the given event set. -Output format: `[event]: message` --/ -public def baseLogEvent (events : Std.HashSet EventType) - (event : EventType) (message : String) : BaseIO Unit := do - if event ∈ events then - let _ ← IO.eprintln s!"[{event}]: {message}" |>.toBaseIO - pure () - -/-- -Creates `PythonToStrataOptions` from an event set. - -Enables `logPerf` when `"perf"` is present. --/ -def PythonToStrataOptions.ofEventSet (events : Std.HashSet EventType) : PythonToStrataOptions where - logPerf := events.contains "perf" - -/-- -A Python module name split into its dot-separated components. -For example, `typing.List` has components `["typing", "List"]`. -The size constraint ensures at least one component exists. --/ -public structure ModuleName where - components : Array String - componentsSizePos : components.size > 0 - -namespace ModuleName - -def ofStringAux (mod : String) (a : Array String) (start cur : mod.Pos) : Except String ModuleName := - if h : cur.IsAtEnd then - let r := mod.extract start cur - pure { - components := a.push r - componentsSizePos := by simp - } - else - let c := cur.get h - if _ : c = '.' then - let r := mod.extract start cur - let next := cur.next h - ofStringAux mod (a.push r) next next - else - let next := cur.next h - ofStringAux mod a start next - termination_by cur - -/-- Parses a dot-separated module name string (e.g., "typing.List"). -/ -public def ofString (mod : String) : Except String ModuleName := - ofStringAux mod #[] mod.startPos mod.startPos - -public instance : ToString ModuleName where - toString m := - let p : m.components.size > 0 := m.componentsSizePos - m.components.foldl (init := m.components[0]) (start := 1) (s!"{.}.{.}") +namespace Strata.Python.ModuleName public def foldlDirs {α} (mod : ModuleName) (init : α) (f : α → String → α) : α := - mod.components.foldl (init := init) (stop := mod.components.size - 1) f + mod.components.foldl (init := init) (stop := mod.components.size - 1) fun a c => f a c.val def foldlMDirs {α m} [Monad m] (mod : ModuleName) (init : α) (f : α → String → m α) : m α := do - mod.components.foldlM (init := init) (stop := mod.components.size - 1) f - -def fileRoot (mod : ModuleName) : String := - let p := mod.componentsSizePos - mod.components.back + mod.components.foldlM (init := init) (stop := mod.components.size - 1) fun a c => f a c.val /-- Locate the Python source file for a module within `searchPath`. Navigates subdirectories for intermediate components, then looks for `{leaf}.py`. Falls back to `{leaf}/__init__.py` for packages. -Returns `(filePath, modulePrefix)` where `modulePrefix` is the array -of package components for resolving relative imports. For `__init__.py` -packages this is all components; for regular files it is all but the last. +Returns `(filePath, isInit)` where `isInit` indicates whether the resolved +file is a package `__init__.py`. -/ public def findInPath (mod : ModuleName) (searchPath : System.FilePath) - : EIO String (System.FilePath × Array String) := do + : EIO String (System.FilePath × Bool) := do let findComponent path comp := do let newPath := path / comp if !(← newPath.isDir) then throw s!"Directory {newPath} not found" return newPath let dir ← mod.foldlMDirs (init := searchPath) findComponent - let file := dir / s!"{mod.fileRoot}.py" + let file := dir / s!"{mod.back}.py" if let .ok md ← file.metadata |>.toBaseIO then if md.type != .file then throw s!"{file} is not a regular file." - let modulePrefix := mod.components.toSubarray (stop := mod.components.size - 1) |>.toArray - return (file, modulePrefix) + return (file, false) -- Fall back to __init__.py for packages (directories) - let pkgDir := dir / mod.fileRoot + let pkgDir := dir / mod.back let initFile := pkgDir / "__init__.py" if let .ok md ← initFile.metadata |>.toBaseIO then if md.type != .file then throw s!"{initFile} is not a regular file." - return (initFile, mod.components) + return (initFile, true) -- Fail both throw s!"{file} not found (also no {initFile})." /-- Generates the output filename for a module's spec file. -/ -public def strataFileName (mod : ModuleName) : String := s!"{mod.fileRoot}.pyspec.st.ion" +public def strataFileName (mod : ModuleName) : String := s!"{mod.back}.pyspec.st.ion" /-- Resolve a module name to a PySpec Ion file path under `specDir`. Tries the canonical path first (`specDir/servicelib/Storage.pyspec.st.ion`), @@ -144,47 +61,61 @@ public def strataFileName (mod : ModuleName) : String := s!"{mod.fileRoot}.pyspe for package modules. Returns `none` if neither exists. -/ public def specIonPath (mod : ModuleName) (specDir : System.FilePath) : BaseIO (Option System.FilePath) := do - let canonical := mod.foldlDirs (init := specDir) (· / ·) / mod.strataFileName + let modPath := mod.foldlDirs (init := specDir) (· / ·) + let canonical := modPath / mod.strataFileName if ← canonical.pathExists then return some canonical -- Fall back to __init__ layout for package modules - let initPath := mod.foldlDirs (init := specDir) (· / ·) / mod.fileRoot / "__init__.pyspec.st.ion" + let initPath := modPath / mod.back / "__init__.pyspec.st.ion" if ← initPath.pathExists then return some initPath return none -/-- Derive a ModuleName and its search root from a Python source file path. - For regular files, the root is the parent directory. - For package init files (`__init__.py`), the module name is the parent - directory name and the root is the grandparent. - In both cases, `findInPath mod root` resolves back to the original file. -/ -public def ofFile (pythonFile : System.FilePath) - : Except String (ModuleName × System.FilePath) := do - let (stem, root) := - if pythonFile.fileName == some "__init__.py" then - (pythonFile.parent >>= (·.fileName), pythonFile.parent >>= (·.parent)) - else - (pythonFile.fileStem, pythonFile.parent) - let some s := stem | .error s!"Cannot derive module name from {pythonFile}" - let some r := root | .error s!"Cannot derive search root from {pythonFile}" - if s.contains '.' then - .error s!"File stem '{s}' contains '.'; expected a simple module name (from {pythonFile})" - pure (← ofString s, r) - --- Unit tests for ofFile -private def testOfFile (path expectedMod expectedRoot : String) : Bool := - match ofFile path with - | .ok (mod, root) => toString mod == expectedMod && root.toString == expectedRoot - | .error _ => false - -#guard testOfFile "path/to/module.py" "module" "path/to" -#guard testOfFile "path/to/service/__init__.py" "service" "path/to" -#guard testOfFile "./module.py" "module" "." --- Bare filenames without a directory context are rejected -#guard match ofFile "module.py" with | .error _ => true | .ok _ => false -#guard match ofFile "__init__.py" with | .error _ => true | .ok _ => false --- Dotted file stems are rejected (would be silently split by ofString) -#guard match ofFile "path/to/foo.bar.py" with | .error _ => true | .ok _ => false - -end ModuleName + +def mkIdent (mod : ModuleName) (name : String) : PythonIdent := + { pythonModule := mod, name } + +end Strata.Python.ModuleName + +open Strata.Pipeline + +namespace Strata.Python.Specs + +/-- Type class for monads that support PySpec error and warning reporting. -/ +public class PySpecMClass (m : Type → Type) where + /-- Report an error at a specific source location. -/ + specError (loc : SourceRange) (message : String) : m Unit + /-- Report a warning at a specific source location. -/ + specWarning (loc : SourceRange) (message : String) : m Unit + /-- Run an action and check if any new errors were reported. -/ + runChecked {α} (act : m α) : m (Bool × α) + /-- Run an action and return `true` if no new errors or warnings were reported. -/ + runNoWarn {α} (act : m α) : m (Bool × α) + +open PySpecMClass (specError specWarning runChecked runNoWarn) + + +/-- String identifier for event types. -/ +public abbrev EventType := String + +/-- Event type for module imports. -/ +def importEvent : EventType := "import" + +/-- +Log message for event type if enabled in the given event set. +Output format: `[event]: message` +-/ +public def baseLogEvent (events : Std.HashSet EventType) + (event : EventType) (message : String) : BaseIO Unit := do + if event ∈ events then + let _ ← IO.eprintln s!"[{event}]: {message}" |>.toBaseIO + pure () + +/-- +Creates `PythonToStrataOptions` from an event set. + +Enables `logPerf` when `"perf"` is present. +-/ +def PythonToStrataOptions.ofEventSet (events : Std.HashSet EventType) : PythonToStrataOptions where + logPerf := events.contains "perf" inductive SpecValue | boolConst (b : Bool) @@ -213,7 +144,7 @@ structure TypeDecl where Map from Python identifiers to their type specifications. -/ structure TypeSignature where - rank : Std.HashMap String (Option (Std.HashMap String SpecValue)) + rank : Std.HashMap ModuleName (Option (Std.HashMap String SpecValue)) namespace TypeSignature @@ -225,7 +156,7 @@ def ofList (l : List TypeDecl) : TypeSignature where | .some none => .some none | .some (some m) => m |>.insert d.ident.name d.value -def insert (sig : TypeSignature) (name : String) (m : Option (Std.HashMap String SpecValue)) := +def insert (sig : TypeSignature) (name : ModuleName) (m : Option (Std.HashMap String SpecValue)) := { sig with rank := sig.rank.insert name m } end TypeSignature @@ -284,11 +215,11 @@ structure PySpecContext where strataDir : System.FilePath /-- Root directory for module resolution. Stays constant across nested imports. -/ baseSearchPath : System.FilePath - /-- Package prefix components for resolving relative imports to absolute names. - For `__init__.py` modules, this is all components (e.g., `#["boto3"]`). - For regular modules, this is all but the last (e.g., `#["boto3"]` for `boto3.client`). - Empty for top-level modules with no package. -/ - currentModulePrefix : Array String + /-- Package prefix for resolving relative imports. + For `__init__.py` modules, this is the full module name. + For regular modules, this is the parent (e.g., `boto3` for `boto3.client`). + `none` for top-level modules with no package. -/ + currentModulePrefix : Option ModuleName /-- Ref to file map registry for source-location error reporting. -/ fileMapsRef : IO.Ref FileMaps /-- Python module name for the current file (e.g., "boto3.dynamodb"). @@ -296,18 +227,18 @@ structure PySpecContext where currentModule : ModuleName /-- Resolve a module name to a file path, registering the file's FileMap - for source-location error reporting. Returns `(filePath, modulePrefix)` - where `modulePrefix` is the package prefix for resolving relative imports. -/ + for source-location error reporting. Returns `(filePath, isInit)` + where `isInit` indicates whether the file is a package `__init__.py`. -/ def PySpecContext.readModule (ctx : PySpecContext) (mod : ModuleName) - : EIO String (System.FilePath × Array String) := do - let (pythonPath, modulePrefix) ← mod.findInPath ctx.baseSearchPath + : EIO String (System.FilePath × Bool) := do + let (pythonPath, isInit) ← mod.findInPath ctx.baseSearchPath baseLogEvent ctx.eventSet "findFile" s!"Found {mod} as {pythonPath}" match ← IO.FS.readFile pythonPath |>.toBaseIO with | .ok contents => let fm := Lean.FileMap.ofString contents ctx.fileMapsRef.modify fun m => m.insert pythonPath fm - pure (pythonPath, modulePrefix) + pure (pythonPath, isInit) | .error msg => throw s!"Could not read file {pythonPath}: {msg}" @@ -354,7 +285,7 @@ private def hasOverloadDecorator /-- Should we skip the given top-level name? -/ def shouldSkip (name : String) : PySpecM Bool := do let ctx ← read - let nameIdent := { pythonModule := toString ctx.currentModule, name } + let nameIdent := ctx.currentModule.mkIdent name return nameIdent ∈ ctx.skipNames private def pySpecParsingPhase : Phase := Phase.base "pySpecParsing" @@ -439,8 +370,7 @@ def valueAsType (loc : SourceRange) (v : SpecValue) : PySpecM SpecType := do return tp | _ => recordTypeRef loc val - let mod := toString (← read).currentModule - let pyIdent : PythonIdent := { pythonModule := mod, name := val } + let pyIdent := (← read).currentModule.mkIdent val return .ident loc pyIdent | _ => specError loc s!"Expected type instead of {repr v}." @@ -715,8 +645,7 @@ def pySpecArg (usedNames : Std.HashSet String) | some cl => if type.isSome then specError loc s!"Unexpected argument to {name}" - let mod := toString (← read).currentModule - pure <| .ident loc { pythonModule := mod, name := cl } #[] + pure <| .ident loc ((← read).currentModule.mkIdent cl) #[] assert! comment.isNone let argDefault ← match de with @@ -1303,8 +1232,7 @@ partial def pySpecClassBody (loc : SourceRange) (className : String) match value with | .Call _ (.Attribute _ (.Name _ ⟨_, "self"⟩ (.Load _)) ⟨_, innerClsName⟩ (.Load _)) _ _ => - let mod := toString (← read).currentModule - let pyIdent : PythonIdent := { pythonModule := mod, name := innerClsName } + let pyIdent := (← read).currentModule.mkIdent innerClsName let f : ClassField := { name := fieldName, type := .ident loc pyIdent #[], @@ -1337,10 +1265,10 @@ partial def pySpecClassBody (loc : SourceRange) (className : String) methods := methods } -def translateImportFrom (mod : String) (types : Std.HashMap String SpecValue) +def translateImportFrom (mod : ModuleName) (types : Std.HashMap String SpecValue) (names : Array (alias SourceRange)) : PySpecM Unit := do -- Check if module is a builtin (in prelude) - if so, don't generate extern declarations - let isBuiltinModule := preludeSig.rank.contains mod + let isBuiltinModule := mod ∈ preludeSig.rank for a in names do let name := a.name match types[name]? with @@ -1352,11 +1280,7 @@ def translateImportFrom (mod : String) (types : Std.HashMap String SpecValue) -- Generate extern declaration for imported types (but not for builtin modules) if !isBuiltinModule then if let .typeValue _ := tpv then - let source : PythonIdent := { - pythonModule := mod - name := name - } - pushSignature (.externTypeDecl asname source) + pushSignature (.externTypeDecl asname (mod.mkIdent name)) def getModifiedTime (f : System.FilePath) : IO IO.FS.SystemTime := do let md ← f.metadata @@ -1366,21 +1290,12 @@ def getModifiedTime (f : System.FilePath) : IO IO.FS.SystemTime := do Create a value map for module from signatures. -/ def signatureValueMap (mod : ModuleName) (sigs : Array Signature) : Std.HashMap String SpecValue := - let modName := toString mod let addType (m : Std.HashMap String SpecValue) (sig : Signature) := match sig with | .classDef d => - let pyIdent : PythonIdent := { - pythonModule := modName - name := d.name - } - m.insert d.name (.typeValue (.ident d.loc pyIdent)) + m.insert d.name (.typeValue (.ident d.loc (mod.mkIdent d.name))) | .typeDef d => - let pyIdent : PythonIdent := { - pythonModule := modName - name := d.name - } - m.insert d.name (.typeValue (.ident d.loc pyIdent)) + m.insert d.name (.typeValue (.ident d.loc (mod.mkIdent d.name))) | .externTypeDecl name source => m.insert name (.typeValue (.ident default source)) | .functionDecl .. => m @@ -1404,21 +1319,22 @@ public def isNewer (path : System.FilePath) (existing : IO.FS.Metadata) : BaseIO module prefix and prepends the remainder. E.g. `from ..X import Y` (level 2) in package `a.b.c` resolves to `a.b.X`. -/ def resolveRelativeModuleName (loc : SourceRange) (relName : String) (level : Int) - : PySpecM String := do - if level == 0 then return relName - let pfx := (←read).currentModulePrefix - if pfx.isEmpty then - specError loc - "Cannot use a relative import from a top-level module with no package" - return relName + : PySpecM ModuleName := do + let some m := ModuleName.ofString? relName + | specError loc s!"Invalid module name {relName}" + return default + if level == 0 then + return m + let some pfx := (←read).currentModulePrefix + | specError loc "Cannot use a relative import from a top-level module with no package" + return default let drop := level.toNat - 1 - if drop >= pfx.size then - specError loc <| - s!"Relative import (level {level}) goes beyond the top-level package; " ++ - s!"the current module is only {pfx.size} package level(s) deep" - return relName - let base := pfx.toSubarray (stop := pfx.size - drop) |>.toArray - return ".".intercalate (base.push relName).toList + let some base := pfx.parent (n := drop) + | specError loc <| + s!"Relative import (level {level}) goes beyond the top-level package; " ++ + s!"the current module is only {pfx.components.size} package level(s) deep" + return default + return base ++ m mutual @@ -1429,10 +1345,10 @@ Python source if not in cache. -/ partial def resolveModule (loc : SourceRange) (mod : ModuleName) : PySpecM (Std.HashMap String SpecValue) := do - let (pythonFile, childPrefix) ← + let (pythonFile, modPath) ← match ← (←read).readModule mod |>.toBaseIO with - | .ok r => - pure r + | .ok (path, isInit) => + pure (path, ModuleName.ModuleOfPath.mk mod isInit) | .error msg => specError loc msg return default @@ -1471,7 +1387,8 @@ partial def resolveModule (loc : SourceRange) (mod : ModuleName) : let ctx := { (←read) with pythonFile := pythonFile currentModule := mod - currentModulePrefix := childPrefix } + currentModulePrefix := modPath |>.modulePrefix? + } -- This does state shuffling to ensure warnings and errors maintain -- a reference count of 1 (for destructive updates). let s := ←get @@ -1495,37 +1412,26 @@ partial def resolveModule (loc : SourceRange) (mod : ModuleName) : return signatureValueMap mod sigs -partial def resolveModuleCached (loc : SourceRange) (mod : ModuleName) +partial def parseAndResolveModule (loc : SourceRange) (mod : ModuleName) : PySpecM (Option (Std.HashMap String SpecValue)) := do - let key := toString mod - match (←get).typeSigs.rank[key]? with + match (←get).typeSigs.rank[mod]? with | some types => return types | none => let (success, r) ← runChecked <| resolveModule loc mod let r := if success then some r else none - modify fun s => { s with typeSigs := s.typeSigs.insert key r } + modify fun s => { s with typeSigs := s.typeSigs.insert mod r } return r -/-- Parse a module name string and resolve it, returning `none` on - parse or resolution failure. -/ -partial def parseAndResolveModule (loc : SourceRange) (modName : String) - : PySpecM (Option (Std.HashMap String SpecValue)) := do - match ModuleName.ofString modName with - | .ok mod => resolveModuleCached loc mod - | .error msg => - specError loc msg - return none - /-- Resolve a module and register its exports under `"{asname}.{name}"`. If resolution fails, register `asname` as an opaque extern type. -/ partial def resolveAndRegisterModule (loc : SourceRange) - (mod asname : String) : PySpecM Unit := do + (mod : ModuleName) (asname : String) : PySpecM Unit := do if let some types ← parseAndResolveModule loc mod then for (name, tpv) in types do setNameValue s!"{asname}.{name}" tpv else - let source : PythonIdent := { pythonModule := mod, name := asname } + let source := mod.mkIdent asname let tpv : SpecValue := .typeValue (.ident loc source) setNameValue asname tpv pushSignature (.externTypeDecl asname source) @@ -1535,9 +1441,10 @@ partial def resolveAndRegisterModule (loc : SourceRange) partial def translateImport (loc : SourceRange) (names : Array (alias SourceRange)) : PySpecM Unit := do for a in names do - let mod := a.name - let asname := a.asname.getD mod - resolveAndRegisterModule loc mod asname + let asname := a.asname.getD a.name + match ModuleName.ofString? a.name with + | .some mod => resolveAndRegisterModule loc mod asname + | none => specError loc s!"Invalid module name {a.name}" /-- Handle a `from [..] module import name` statement. Supports absolute imports (level 0) and multi-level relative imports (level ≥ 1). @@ -1565,7 +1472,7 @@ partial def translateImportFromStmt (loc : SourceRange) for a in names do let name := a.name let asname := a.asname.getD name - let source : PythonIdent := { pythonModule := mod, name := name } + let source := mod.mkIdent name let tpv : SpecValue := .typeValue (.ident loc source) setNameValue asname tpv pushSignature (.externTypeDecl asname source) @@ -1645,8 +1552,7 @@ partial def translate (body : Array (stmt Strata.SourceRange)) : PySpecM Unit := let baseIdents ← resolveBaseClasses bases let (success, _) ← runChecked <| recordTypeDef loc className -- Add the class to nameMap so it can be used in forward references - let mod := toString (← read).currentModule - setNameValue className (.typeValue (.ident loc { pythonModule := mod, name := className } #[])) + setNameValue className (.typeValue (.ident loc ((← read).currentModule.mkIdent className) #[])) let d ← pySpecClassBody loc className baseIdents stmts let d := { d with exhaustive := isExhaustive } if success then @@ -1678,7 +1584,7 @@ def translateModule (pythonCmd : String := "python") (events : Std.HashSet EventType := {}) (skipNames : Std.HashSet PythonIdent := {}) - (currentModulePrefix : Array String := #[]) : + (currentModulePrefix : Option ModuleName := none) : BaseIO (FileMaps × Array Signature × Array PipelineMessage × Array PipelineMessage) := do let fmm : FileMaps := {} let fmm := fmm.insert pythonFile fileMap @@ -1702,23 +1608,18 @@ def translateModule /-- Translates a Python source file to PySpec signatures. Main entry point for translation. -/ public def translateFile (dialectFile strataDir pythonFile searchPath : System.FilePath) + (moduleName : ModuleName) (pythonCmd : String := "python") (events : Std.HashSet EventType := {}) (skipNames : Std.HashSet PythonIdent := {}) - (moduleName : Option ModuleName := none) : EIO String (Array Signature × Array String) := do - let currentModule ← match moduleName with - | some m => pure m - | none => - let (mod, _) ← match ModuleName.ofFile pythonFile with - | .ok r => pure r - | .error e => throw e - pure mod - let mod := currentModule + let mod := moduleName -- Compute the package prefix for relative import resolution. - let modulePrefix := - if pythonFile.fileName == some "__init__.py" then mod.components - else mod.components.toSubarray (stop := mod.components.size - 1) |>.toArray + let modulePrefix : Option ModuleName := + if pythonFile.fileName == some "__init__.py" then + some moduleName + else + moduleName.parent let contents ← match ← IO.FS.readFile pythonFile |>.toBaseIO with | .ok b => pure b @@ -1746,7 +1647,7 @@ public def translateFile (pythonFile := pythonFile) (.ofString contents) body - currentModule + mod let ppErr (e : PipelineMessage) : EIO String String := match fmm[e.file]? with | none => diff --git a/Strata/Languages/Python/Specs/DDM.lean b/Strata/Languages/Python/Specs/DDM.lean index 86c7526c2c..318bfcbad7 100644 --- a/Strata/Languages/Python/Specs/DDM.lean +++ b/Strata/Languages/Python/Specs/DDM.lean @@ -194,7 +194,7 @@ def DDM.Int.ofDDM {α} : DDM.Int α → _root_.Int mutual -private def SpecIdent.toDDM (si : SpecIdent) (loc : SourceRange) : DDM.SpecType SourceRange := +def SpecIdent.toDDM (si : SpecIdent) (loc : SourceRange) : DDM.SpecType SourceRange := if si.args.isEmpty then .typeIdentNoArgs loc si.name.toDDM else @@ -202,7 +202,7 @@ private def SpecIdent.toDDM (si : SpecIdent) (loc : SourceRange) : DDM.SpecType termination_by sizeOf si decreasing_by cases si; decreasing_tactic -private def SpecTypedDict.toDDM (td : SpecTypedDict) (loc : SourceRange) : DDM.SpecType SourceRange := +def SpecTypedDict.toDDM (td : SpecTypedDict) (loc : SourceRange) : DDM.SpecType SourceRange := assert! td.fields.size = td.fieldTypes.size let argc := td.fieldTypes.size let a := Array.ofFn fun (⟨i, ilt⟩ : Fin argc) => @@ -211,7 +211,7 @@ private def SpecTypedDict.toDDM (td : SpecTypedDict) (loc : SourceRange) : DDM.S termination_by sizeOf td decreasing_by cases td; decreasing_tactic -private def SpecType.toDDM (d : SpecType) : DDM.SpecType SourceRange := +def SpecType.toDDM (d : SpecType) : DDM.SpecType SourceRange := let parts : Array (DDM.SpecType SourceRange) := let r := d.idents.attach.map fun ⟨si, _⟩ => si.toDDM d.loc let ints := d.intLits.toArray.qsort (· < ·) @@ -236,7 +236,7 @@ decreasing_by end -private def SpecAtomType.toDDM (d : SpecAtomType) +def SpecAtomType.toDDM (d : SpecAtomType) (loc : SourceRange := .none) : DDM.SpecType SourceRange := match d with | .ident nm args => @@ -354,37 +354,46 @@ def Signature.toDDM (sig : Signature) : DDM.Signature SourceRange := | .typeDef d => .typeDef d.loc (.mk d.nameLoc d.name) d.definition.toDDM -def DDM.SpecType.fromDDM (d : DDM.SpecType SourceRange) : Specs.SpecType := +abbrev FromDDM := Except (SourceRange × String) + +def FromDDM.throw {α} (loc : SourceRange) (msg : String) : FromDDM α := + .error (loc, msg) + +def DDM.SpecType.fromDDM (d : DDM.SpecType SourceRange) : FromDDM Specs.SpecType := match d with | .typeClassNoArgs loc ⟨_, cl⟩ => - .ident loc { pythonModule := "", name := cl } #[] - | .typeClass loc ⟨_, cl⟩ ⟨_, args⟩ => - let a := args.map (·.fromDDM) - .ident loc { pythonModule := "", name := cl } a + match PythonIdent.ofString cl with + | none => .throw loc s!"Unsupported identifier {cl} in typeClass" + | some nm => .ok <| .ident loc nm #[] + | .typeClass loc ⟨_, cl⟩ ⟨_, args⟩ => do + let nm ← match PythonIdent.ofString cl with + | none => .throw loc s!"Unsupported identifier {cl} in typeClass" + | some nm => pure nm + let a ← args.mapM (·.fromDDM) + pure <| .ident loc nm a | .typeIdentNoArgs loc ⟨_, ident⟩ => - if let some pyIdent := PythonIdent.ofString ident then - .ident loc pyIdent #[] - else - panic! "Bad identifier" - | .typeIdent loc ⟨_, ident⟩ ⟨_, args⟩ => - let a := args.map (·.fromDDM) - if let some pyIdent := PythonIdent.ofString ident then - .ident loc pyIdent a - else - panic! "Bad identifier" - | .typeIntLiteral loc i => .intLiteral loc i.ofDDM - | .typeStringLiteral loc ⟨_, s⟩ => .stringLiteral loc s - | .typeTypedDict loc ⟨_, fields⟩ => + match PythonIdent.ofString ident with + | some pyIdent => .ok <| .ident loc pyIdent #[] + | none => .throw loc s!"Bad identifier: {ident}" + | .typeIdent loc ⟨_, ident⟩ ⟨_, args⟩ => do + let a ← args.mapM (·.fromDDM) + match PythonIdent.ofString ident with + | some pyIdent => pure <| .ident loc pyIdent a + | none => .throw loc s!"Bad identifier: {ident}" + | .typeIntLiteral loc i => .ok <| .intLiteral loc i.ofDDM + | .typeStringLiteral loc ⟨_, s⟩ => .ok <| .stringLiteral loc s + | .typeTypedDict loc ⟨_, fields⟩ => do let names := fields.map fun (.mkDictFieldDecl _ ⟨_, name⟩ _ _) => name - let types := fields.attach.map fun ⟨.mkDictFieldDecl _ _ tp _, mem⟩ => tp.fromDDM + let types ← fields.attach.mapM fun ⟨.mkDictFieldDecl _ _ tp _, mem⟩ => tp.fromDDM let required := fields.map fun (.mkDictFieldDecl _ _ _ ⟨_, r⟩) => r - .typedDict loc names types required - | .typeUnion loc ⟨_, args⟩ => + pure <| .typedDict loc names types required + | .typeUnion loc ⟨_, args⟩ => do if p : args.size > 0 then - args.attach.foldl (init := args[0].fromDDM) (start := 1) - fun a ⟨b, mem⟩ => SpecType.union loc a b.fromDDM + let init ← args[0].fromDDM + args.attach.foldlM (init := init) (start := 1) fun a ⟨b, mem⟩ => do + return .union loc a (← b.fromDDM) else - panic! "Expected non-empty union" + .throw loc "Expected non-empty union" termination_by sizeOf d decreasing_by · decreasing_tactic @@ -399,11 +408,11 @@ decreasing_by def DDM.SpecDefault.fromDDM : DDM.SpecDefault SourceRange → Specs.SpecDefault | .noneDefault _ => .none -def DDM.ArgDecl.fromDDM (d : DDM.ArgDecl SourceRange) : Specs.Arg := +def DDM.ArgDecl.fromDDM (d : DDM.ArgDecl SourceRange) : FromDDM Specs.Arg := do let .mkArgDecl _ ⟨_, name⟩ type ⟨_, default⟩ := d - { + pure { name := name - type := type.fromDDM + type := ← type.fromDDM default := default.map (·.fromDDM) } @@ -440,67 +449,69 @@ def DDM.Assertion.fromDDM (d : DDM.Assertion SourceRange) : Specs.Assertion := let .mkAssertion _ formula ⟨_, message⟩ := d { message := message.map (·.fromDDM), formula := formula.fromDDM } -def DDM.FunDecl.fromDDM (d : DDM.FunDecl SourceRange) : Specs.FunctionDecl := +def DDM.FunDecl.fromDDM (d : DDM.FunDecl SourceRange) : FromDDM Specs.FunctionDecl := do let .mkFunDecl loc ⟨nameLoc, name⟩ ⟨_, args⟩ ⟨_, kwonly⟩ ⟨_, kwargs⟩ returnType ⟨_, isOverload⟩ ⟨_, preconditions⟩ ⟨_, postconditions⟩ := d - let kwargsOpt : Option (String × Specs.SpecType) := + let kwargsOpt : Option (String × Specs.SpecType) ← match kwargs with - | some (.mkKwargsDecl _ ⟨_, kn⟩ tp) => some (kn, tp.fromDDM) - | none => none - { + | some (.mkKwargsDecl _ ⟨_, kn⟩ tp) => + pure <| some (kn, ← tp.fromDDM) + | none => + pure none + pure { loc := loc nameLoc := nameLoc name := name args := { - args := args.map (·.fromDDM) - kwonly := kwonly.map (·.fromDDM) + args := ← args.mapM (·.fromDDM) + kwonly := ← kwonly.mapM (·.fromDDM) kwargs := kwargsOpt } - returnType := returnType.fromDDM + returnType := ← returnType.fromDDM isOverload := isOverload preconditions := preconditions.map (·.fromDDM) postconditions := postconditions.map fun | .mkPostconditionEntry _ e => e.fromDDM } -def DDM.ClassDecl.fromDDM (d : DDM.ClassDecl SourceRange) : Specs.ClassDef := +def DDM.ClassDecl.fromDDM (d : DDM.ClassDecl SourceRange) : FromDDM Specs.ClassDef := do let .mkClassDecl ann ⟨_, name⟩ ⟨_, bases⟩ ⟨_, fields⟩ ⟨_, classVars⟩ ⟨_, subclasses⟩ ⟨_, methods⟩ ⟨_, exhaustive⟩ := d - { + pure { loc := ann name := name - bases := bases.map fun ⟨_, s⟩ => + bases := ← bases.mapM fun ⟨_, s⟩ => match PythonIdent.ofString s with - | some id => id - | none => panic! s!"Bad base class identifier: '{s}'" - fields := fields.map fun (.mkClassFieldDecl _ ⟨_, n⟩ tp ⟨_, cv⟩) => - { name := n, type := tp.fromDDM, constValue := cv.map (·.2) : ClassField } + | some id => pure id + | none => .throw ann s!"Bad base class identifier: '{s}'" + fields := ← fields.mapM fun (.mkClassFieldDecl _ ⟨_, n⟩ tp ⟨_, cv⟩) => do + pure { name := n, type := ← tp.fromDDM, constValue := cv.map (·.2) : ClassField } classVars := classVars.map fun (.mkClassVarDecl _ ⟨_, n⟩ ⟨_, v⟩) => { name := n, value := v : ClassVariable } - subclasses := subclasses.map (·.fromDDM) - methods := methods.map (·.fromDDM) + subclasses := ← subclasses.mapM (·.fromDDM) + methods := ← methods.mapM (·.fromDDM) exhaustive := exhaustive } -def DDM.Command.fromDDM (cmd : DDM.Command SourceRange) : Specs.Signature := +def DDM.Command.fromDDM (cmd : DDM.Command SourceRange) : FromDDM Specs.Signature := match cmd with - | .externTypeDecl _ ⟨_, name⟩ ⟨_, ddmDefinition⟩ => - if let some definition := PythonIdent.ofString ddmDefinition then - .externTypeDecl name definition - else - panic! "Extern type decl definition has bad format." - | .classDef _ decl => - .classDef decl.fromDDM - | .functionDecl _ d => .functionDecl d.fromDDM - | .typeDef loc ⟨nameLoc, name⟩ definition => + | .externTypeDecl loc ⟨_, name⟩ ⟨_, ddmDefinition⟩ => + match PythonIdent.ofString ddmDefinition with + | some definition => .ok <| .externTypeDecl name definition + | none => .throw loc s!"Extern type decl definition has bad format: {ddmDefinition}" + | .classDef _ decl => do + pure <| .classDef (← decl.fromDDM) + | .functionDecl _ d => do + pure <| .functionDecl (← d.fromDDM) + | .typeDef loc ⟨nameLoc, name⟩ definition => do let d : TypeDef := { loc := loc nameLoc := nameLoc name := name - definition := definition.fromDDM + definition := ← definition.fromDDM } - .typeDef d + pure <| .typeDef d /-- Reads Python spec signatures from a DDM Ion file. -/ public def readDDM (path : System.FilePath) : EIO String (Array Signature) := do @@ -513,7 +524,9 @@ public def readDDM (path : System.FilePath) : EIO String (Array Signature) := do let r := pgm.commands.mapM fun cmd => do let pySig ← DDM.Command.ofAst cmd - return pySig.fromDDM + match pySig.fromDDM with + | .ok sig => pure sig + | .error (_, msg) => .error msg match r with | .ok r => pure r | .error msg => throw msg diff --git a/Strata/Languages/Python/Specs/Decls.lean b/Strata/Languages/Python/Specs/Decls.lean index 21e2bc03c8..c1f2212b0c 100644 --- a/Strata/Languages/Python/Specs/Decls.lean +++ b/Strata/Languages/Python/Specs/Decls.lean @@ -6,39 +6,39 @@ module public import Std.Data.HashMap.Basic public import Strata.DDM.Util.SourceRange -public import Strata.Languages.Python.OverloadTable +public import Strata.Languages.Python.PythonIdent public section namespace Strata.Python namespace PythonIdent -def builtinsBool := mk "builtins" "bool" -def builtinsBytearray := mk "builtins" "bytearray" -def builtinsBytes := mk "builtins" "bytes" -def builtinsComplex := mk "builtins" "complex" -def builtinsDict := mk "builtins" "dict" -def builtinsException := mk "builtins" "Exception" -def builtinsFloat := mk "builtins" "float" -def builtinsInt := mk "builtins" "int" -def builtinsStr := mk "builtins" "str" -def noneType := mk "_types" "NoneType" - -def typingAny := mk "typing" "Any" -def typingBinaryIO := mk "typing" "BinaryIO" -def typingDict := mk "typing" "Dict" -def typingGenerator := mk "typing" "Generator" -def typingList := mk "typing" "List" -def typingLiteral := mk "typing" "Literal" -def typingMapping := mk "typing" "Mapping" -def typingOverload := mk "typing" "overload" -def typingSequence := mk "typing" "Sequence" -def typingTypedDict := mk "typing" "TypedDict" -def typingUnion := mk "typing" "Union" -def typingRequired := mk "typing" "Required" -def typingNotRequired := mk "typing" "NotRequired" -def typingUnpack := mk "typing" "Unpack" -def reCompile := mk "re" "compile" +def builtinsBool := ofComponent "builtins" "bool" +def builtinsBytearray := ofComponent "builtins" "bytearray" +def builtinsBytes := ofComponent "builtins" "bytes" +def builtinsComplex := ofComponent "builtins" "complex" +def builtinsDict := ofComponent "builtins" "dict" +def builtinsException := ofComponent "builtins" "Exception" +def builtinsFloat := ofComponent "builtins" "float" +def builtinsInt := ofComponent "builtins" "int" +def builtinsStr := ofComponent "builtins" "str" +def noneType := ofComponent "_types" "NoneType" + +def typingAny := ofComponent "typing" "Any" +def typingBinaryIO := ofComponent "typing" "BinaryIO" +def typingDict := ofComponent "typing" "Dict" +def typingGenerator := ofComponent "typing" "Generator" +def typingList := ofComponent "typing" "List" +def typingLiteral := ofComponent "typing" "Literal" +def typingMapping := ofComponent "typing" "Mapping" +def typingOverload := ofComponent "typing" "overload" +def typingSequence := ofComponent "typing" "Sequence" +def typingTypedDict := ofComponent "typing" "TypedDict" +def typingUnion := ofComponent "typing" "Union" +def typingRequired := ofComponent "typing" "Required" +def typingNotRequired := ofComponent "typing" "NotRequired" +def typingUnpack := ofComponent "typing" "Unpack" +def reCompile := ofComponent "re" "compile" end PythonIdent diff --git a/Strata/Languages/Python/Specs/IdentifyOverloads.lean b/Strata/Languages/Python/Specs/IdentifyOverloads.lean index ad441f595f..212acc5109 100644 --- a/Strata/Languages/Python/Specs/IdentifyOverloads.lean +++ b/Strata/Languages/Python/Specs/IdentifyOverloads.lean @@ -29,7 +29,7 @@ open Strata.Python (stmt expr keyword FunctionOverloads OverloadTable PythonIden /-- State accumulated while walking the AST. -/ public structure ResolveState where - modules : Std.HashSet String := {} + modules : Std.HashSet ModuleName := {} warnings : Array String := #[] /-- Monad for the overload-resolution walker. @@ -43,7 +43,7 @@ def warn (msg : String) : ResolveM Unit := { s with warnings := s.warnings.push msg } /-- Record a module name from a resolved overload. -/ -def recordModule (mod : String) : ResolveM Unit := +def recordModule (mod : ModuleName) : ResolveM Unit := modify fun s => { s with modules := s.modules.insert mod } diff --git a/Strata/Languages/Python/Specs/ToLaurel.lean b/Strata/Languages/Python/Specs/ToLaurel.lean index 0f7e0c8433..2f8f07897b 100644 --- a/Strata/Languages/Python/Specs/ToLaurel.lean +++ b/Strata/Languages/Python/Specs/ToLaurel.lean @@ -7,12 +7,12 @@ module public import Strata.Languages.Laurel.Laurel import Strata.DDM.Format -import Strata.Languages.Python.OverloadTable import Strata.Languages.Python.PythonLaurelTypedExpr public import Strata.Languages.Python.Specs.Decls public import Strata.Pipeline.Messages import Strata.Languages.Python.Specs.DDM import Strata.Util.DecideProp +public import Strata.Languages.Python.OverloadTable import Strata.Languages.Python.Specs.MessageKind /-! @@ -53,12 +53,15 @@ private def typeTestersMap : Std.HashMap PythonIdent String := /-- Fully qualified Laurel name for a `PythonIdent`: module dots become underscores. E.g., `"mylib.sub"` / `"Foo"` → `"mylib_sub_Foo"`. -/ def PythonIdent.toLaurelName (id : PythonIdent) : String := - let pfx := "_".intercalate (id.pythonModule.splitOn ".") - if pfx.isEmpty then id.name else pfx ++ "_" ++ id.name + id.toString (sep := "_") end -- public section end Strata.Python +namespace Strata.Python.Specs + +end Strata.Python.Specs + namespace Strata.Python.Specs.ToLaurel open Strata.Laurel @@ -130,11 +133,38 @@ def pushOverloadEntry (funcName : String) (paramName : String) { existing with entries := existing.entries.insert literalValue returnType } } -/-- Prepend the module prefix to a name. Returns the name unchanged - if the prefix is empty. -/ +/-- Extract an overload dispatch entry from an `@overload` function declaration. -/ +def extractOverloadEntry (func : FunctionDecl) : ToLaurelM Unit := do + let args := func.args.args + let .isTrue _ := decideProp (args.size > 0) + | reportError .overloadNoArgs func.loc + s!"Overloaded function '{func.name}' has no arguments" + return + let firstArgType := args[0].type + let literalValue ← + match firstArgType.asStringLiteral with + | some v => pure v + | none => + reportError .overloadArgNotStringLiteral func.loc + s!"Overloaded function '{func.name}': first argument \ + type '{firstArgType}' is not a \ + string literal (only string literal dispatch is \ + currently supported)" + return + let retType ← + match func.returnType.asIdent with + | some nm => pure nm + | none => + reportError .overloadReturnNotClass func.loc + s!"Overloaded function '{func.name}': return type \ + '{func.returnType}' is not a \ + class type" + return + pushOverloadEntry func.name args[0].name literalValue retType + +/-- Prepend the module prefix to a name. -/ def prefixName (name : String) : ToLaurelM String := do let ctx ← read - if ctx.modulePrefix.isEmpty then return name return ctx.modulePrefix ++ "_" ++ name /-! ## Helper Functions -/ @@ -579,38 +609,6 @@ def typeDefToLaurel (td : TypeDef) : ToLaurelM Unit := do instanceProcedures := [] }) -/-- Extract an overload dispatch entry from an `@overload` function declaration. - Looks for a `stringLiteral` in the first argument's type and an `.ident` - return type, and records them in the dispatch table. -/ -def extractOverloadEntry (func : FunctionDecl) : ToLaurelM Unit := do - let args := func.args.args - let .isTrue _ := decideProp (args.size > 0) - | reportError .overloadNoArgs func.loc - s!"Overloaded function '{func.name}' has no arguments" - return - let firstArgType := args[0].type - let literalValue ← - match firstArgType.asStringLiteral with - | some v => pure v - | none => - reportError .overloadArgNotStringLiteral func.loc - s!"Overloaded function '{func.name}': first argument \ - type '{firstArgType}' is not a \ - string literal (only string literal dispatch is \ - currently supported)" - return - let retType ← - match func.returnType.asIdent with - | some nm => pure nm - | none => - reportError .overloadReturnNotClass func.loc - s!"Overloaded function '{func.name}': return type \ - '{func.returnType}' is not a \ - class type" - return - -- args[0].name is the formal parameter name from the PySpec (not a call-site argument) - pushOverloadEntry func.name args[0].name literalValue retType - /-- Convert a single PySpec signature to Laurel declarations. -/ def signatureToLaurel (sig : Signature) : ToLaurelM Unit := match sig with @@ -642,9 +640,12 @@ public structure TranslationResult where /-- Run the translation and return a Laurel Program, dispatch table, and any errors. -/ public def signaturesToLaurel (filepath : System.FilePath) (sigs : Array Signature) - (modulePrefix : String) + (moduleName : ModuleName) : TranslationResult := - let ctx : ToLaurelContext := { filepath, modulePrefix } + let ctx : ToLaurelContext := { + filepath, + modulePrefix := moduleName.toString (sep := "_") + } let ((), state) := (sigs.forM signatureToLaurel).run ctx |>.run {} let pgm : Laurel.Program := { staticProcedures := state.procedures.toList @@ -673,4 +674,5 @@ public def extractOverloads (filepath : System.FilePath) (sigs : Array Signature let ((), state) := action.run ctx |>.run {} (state.overloads, state.errors) + end Strata.Python.Specs.ToLaurel diff --git a/Strata/SimpleAPI.lean b/Strata/SimpleAPI.lean index e7a8ad49c7..449b8e61f7 100644 --- a/Strata/SimpleAPI.lean +++ b/Strata/SimpleAPI.lean @@ -62,7 +62,7 @@ public section namespace Strata -open Strata.Python.Specs (ModuleName) +open Strata.Python (ModuleName) /-! ### File I/O -/ @@ -404,32 +404,29 @@ inductive WarningOutput where deriving Inhabited, BEq /-- Recursively discover all Python modules under a directory. - Returns `(moduleName, filePath)` pairs. The `components` array - accumulates directory names as we recurse, forming the dotted - module name prefix. -/ + Returns `(moduleName, filePath)` pairs. -/ private partial def discoverModules (sourceDir : System.FilePath) : IO (Array (ModuleName × System.FilePath)) := do - let rec go (dir : System.FilePath) (components : Array String) + let rec go (dir : System.FilePath) (relPrefix : System.FilePath) : IO (Array (ModuleName × System.FilePath)) := do let mut acc := #[] let entries ← dir.readDir for entry in entries do + let relChild : System.FilePath := + if relPrefix.toString.isEmpty then + entry.fileName + else + relPrefix / entry.fileName if ← entry.path.isDir then - acc := acc ++ (← go entry.path (components.push entry.fileName)) + acc := acc ++ (← go entry.path relChild) else if entry.fileName.endsWith ".py" then - let parts := - if entry.fileName == "__init__.py" then - components - else - components.push (entry.fileName.takeWhile (· != '.') |>.toString) - if parts.isEmpty then continue - let dotted := ".".intercalate parts.toList - match ModuleName.ofString dotted with - | .ok mod => acc := acc.push (mod, entry.path) + match ModuleName.ofRelativePath relChild with + | .ok info => acc := acc.push (info.moduleName, entry.path) | .error msg => let _ ← IO.eprintln s!"warning: skipping {entry.path}: {msg}" |>.toBaseIO + continue return acc - go sourceDir #[] + go sourceDir ⟨""⟩ /-- Derive the output path for a Python file by mirroring the source directory structure and replacing `.py` with `.pyspec.st.ion`. -/ @@ -480,9 +477,9 @@ def pySpecsDir (sourceDir strataDir dialectFile : System.FilePath) else let mut result := #[] for m in modules do - let mod ← match ModuleName.ofString m with - | .ok r => pure r - | .error e => throw s!"Invalid module name '{m}': {e}" + let mod ← match ModuleName.ofString? m with + | some r => pure r + | none => throw s!"Invalid module name '{m}'" let (path, _) ← match ← ModuleName.findInPath mod sourceDir |>.toBaseIO with | .ok r => pure r @@ -514,9 +511,9 @@ def pySpecsDir (sourceDir strataDir dialectFile : System.FilePath) -- Translate Python.Specs.baseLogEvent events "import" s!"Translating {mod}" match ← Strata.Python.Specs.translateFile - dialectFile strataDir pythonFile sourceDir + dialectFile strataDir pythonFile sourceDir mod (events := events) (skipNames := skipIdents) - (moduleName := mod) (pythonCmd := pythonCmd) |>.toBaseIO with + (pythonCmd := pythonCmd) |>.toBaseIO with | .error msg => Python.Specs.baseLogEvent events "import" s!"Failed {mod}: {msg}" failures := failures.push (toString mod, msg) diff --git a/StrataMainLib.lean b/StrataMainLib.lean index d45f5de868..6d2c51b501 100644 --- a/StrataMainLib.lean +++ b/StrataMainLib.lean @@ -915,14 +915,14 @@ def pySpecToLaurelCommand : Command where let strataDir : System.FilePath := v[1] let some mod := pythonFile.fileStem | exitFailure s!"No stem {pythonFile}" - let .ok mod := Strata.Python.Specs.ModuleName.ofString mod + let some mod := Strata.Python.ModuleName.ofString? mod | exitFailure s!"Invalid module {mod}" let ionFile := strataDir / mod.strataFileName let sigs ← match ← Strata.Python.Specs.readDDM ionFile |>.toBaseIO with | .ok t => pure t | .error msg => exitFailure s!"Could not read {ionFile}: {msg}" - let result := Strata.Python.Specs.ToLaurel.signaturesToLaurel pythonFile sigs "" + let result := Strata.Python.Specs.ToLaurel.signaturesToLaurel pythonFile sigs mod if result.errors.size > 0 then IO.eprintln s!"{result.errors.size} translation warning(s):" for err in result.errors do diff --git a/StrataTest/Languages/Python/PySpecArgTypeTest.lean b/StrataTest/Languages/Python/PySpecArgTypeTest.lean index ed3c71cc37..21f8e48e21 100644 --- a/StrataTest/Languages/Python/PySpecArgTypeTest.lean +++ b/StrataTest/Languages/Python/PySpecArgTypeTest.lean @@ -17,7 +17,7 @@ namespace Strata.Python.PySpecArgTypeTest open Strata.Python.Specs open Strata (buildPySpecLaurel) -open Strata.Python (OverloadTable PythonFunctionDecl PyArgInfo highTypeToPyLauType) +open Strata.Python (ModuleName OverloadTable PythonFunctionDecl PyArgInfo highTypeToPyLauType) open Strata.Laurel (Procedure formatProcedure) private def loc : SourceRange := default @@ -44,7 +44,7 @@ private def buildSpecs (sigs : Array Signature) : IO Strata.PySpecLaurelResult : let ionFile := dir / "test.pyspec.ion" writeDDM ionFile sigs let ctx ← Strata.Pipeline.PipelineContext.create - match ← (buildPySpecLaurel ctx #[("", ionFile.toString)] {}).toBaseIO with + match ← (buildPySpecLaurel ctx #[(.ofComponent (.ofString "test"), ionFile.toString)] {}).toBaseIO with | .ok r => pure r | .error () => let msgs ← ctx.getMessages @@ -57,10 +57,10 @@ private def unionType (elts : Array SpecType) : SpecType := SpecType.unionArray loc elts /-- -info: typed_func: x=Any[], y=Any[], z=Any[], w=Any[] -untyped_func: a=Any[] -mixed_func: p=Any[], q=Any[] -optional_func: s=Any[], n=Any[] +info: test_typed_func: x=Any[], y=Any[], z=Any[], w=Any[] +test_untyped_func: a=Any[] +test_mixed_func: p=Any[], q=Any[] +test_optional_func: s=Any[], n=Any[] -/ #guard_msgs in #eval do @@ -96,7 +96,7 @@ the pyspec Laurel procedure body contains the type assertions generated by preconditions redundant. -/ /-- -info: procedure typed_func(x: Any, y: Any): Any +info: procedure test_typed_func(x: Any, y: Any): Any opaque modifies * { result := ; assert Any..isfrom_int(x); assert Any..isfrom_str(y); assume Any..isfrom_float(result) }; @@ -110,8 +110,8 @@ info: procedure typed_func(x: Any, y: Any): Any (identType .builtinsFloat) ] let procs := result.laurelProgram.staticProcedures - let some proc := procs.find? (fun (p : Procedure) => p.name.text == "typed_func") - | throw <| IO.userError "typed_func not found" + let some proc := procs.find? (fun (p : Procedure) => p.name.text == "test_typed_func") + | throw <| IO.userError "test_typed_func not found" IO.println (toString (formatProcedure proc)) end Strata.Python.PySpecArgTypeTest diff --git a/StrataTest/Languages/Python/ToLaurelTest.lean b/StrataTest/Languages/Python/ToLaurelTest.lean index 05f096f8e9..bbf7e437a5 100644 --- a/StrataTest/Languages/Python/ToLaurelTest.lean +++ b/StrataTest/Languages/Python/ToLaurelTest.lean @@ -15,11 +15,14 @@ signatures into Laurel programs. namespace Strata.Python.Specs.ToLaurel.Tests +open Strata.Python (ModuleName) open Strata.Python.Specs open Strata.Laurel /-! ## Test Infrastructure -/ +private def testModule : ModuleName := .ofComponent (.ofString "test") + private def assertEq [BEq α] [ToString α] (actual expected : α) : IO Unit := do unless actual == expected do throw <| .userError s!"expected: {expected}\n actual: {actual}" @@ -90,8 +93,8 @@ private def fmtTypeDef : TypeDefinition → String /-- Run signaturesToLaurel and print formatted output. Prints warnings (if any) before procedures so `#guard_msgs` can verify them. -/ -private def runTest (sigs : Array Signature) (modulePrefix : String := "") : IO Unit := do - let result := signaturesToLaurel "" sigs modulePrefix +private def runTest (sigs : Array Signature) (moduleName : ModuleName := testModule) : IO Unit := do + let result := signaturesToLaurel "" sigs moduleName for err in result.errors do IO.println s!"warning: {err.phase}.{err.kind.category}: {err.message}" for td in result.program.types do @@ -100,15 +103,15 @@ private def runTest (sigs : Array Signature) (modulePrefix : String := "") : IO IO.println (fmtProc proc) /-- Run signaturesToLaurel expecting errors. Print error messages. -/ -private def runTestErrors (sigs : Array Signature) (modulePrefix : String := "") : IO Unit := do - let result := signaturesToLaurel "" sigs modulePrefix +private def runTestErrors (sigs : Array Signature) (moduleName : ModuleName := testModule) : IO Unit := do + let result := signaturesToLaurel "" sigs moduleName assert! result.errors.size > 0 for err in result.errors do IO.println err.message /-- Run signaturesToLaurel and print warning kinds (phase.category: message). -/ -private def runTestWarningKinds (sigs : Array Signature) (modulePrefix : String := "") : IO Unit := do - let result := signaturesToLaurel "" sigs modulePrefix +private def runTestWarningKinds (sigs : Array Signature) (moduleName : ModuleName := testModule) : IO Unit := do + let result := signaturesToLaurel "" sigs moduleName assert! result.errors.size > 0 for err in result.errors do IO.println s!"{err.phase}.{err.kind.category}: {err.message}" @@ -139,10 +142,10 @@ private def mkFuncSigWithPostcond (name : String) (returnType : SpecType) /-! ## All function params and returns map to Any -/ /-- -info: procedure returns_int(x:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure returns_bool(a:UserDefined(Any), b:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure returns_real(flag:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure with_kwonly(x:UserDefined(Any), verbose:UserDefined(Any)) returns(result:UserDefined(Any)) +info: procedure test_returns_int(x:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_returns_bool(a:UserDefined(Any), b:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_returns_real(flag:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_with_kwonly(x:UserDefined(Any), verbose:UserDefined(Any)) returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -161,11 +164,11 @@ procedure with_kwonly(x:UserDefined(Any), verbose:UserDefined(Any)) returns(resu /-! ## Complex types (Any, List, Dict, bytes) -/ /-- -info: procedure takes_any(x:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure takes_list(items:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure returns_dict() returns(result:UserDefined(Any)) -procedure typed_list() returns(result:UserDefined(Any)) -procedure typed_dict() returns(result:UserDefined(Any)) +info: procedure test_takes_any(x:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_takes_list(items:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_returns_dict() returns(result:UserDefined(Any)) +procedure test_typed_list() returns(result:UserDefined(Any)) +procedure test_typed_dict() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -185,10 +188,10 @@ procedure typed_dict() returns(result:UserDefined(Any)) /-- info: warning: pySpecToLaurel.unsupportedUnion: TypedDict 'TypedDict(f : builtins.str)' approximated as DictStrAny in type 'TypedDict(f : builtins.str)' -procedure int_literal_ret() returns(result:UserDefined(Any)) -procedure str_literal_ret() returns(result:UserDefined(Any)) -procedure typed_dict_ret() returns(result:UserDefined(Any)) -procedure str_enum() returns(result:UserDefined(Any)) +procedure test_int_literal_ret() returns(result:UserDefined(Any)) +procedure test_str_literal_ret() returns(result:UserDefined(Any)) +procedure test_typed_dict_ret() returns(result:UserDefined(Any)) +procedure test_str_enum() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -207,12 +210,12 @@ procedure str_enum() returns(result:UserDefined(Any)) /-- info: warning: pySpecToLaurel.unsupportedUnion: TypedDict 'TypedDict(x : builtins.str)' approximated as DictStrAny in type 'Union[_types.NoneType, TypedDict(x : builtins.str)]' -procedure opt_str() returns(result:UserDefined(Any)) -procedure opt_int() returns(result:UserDefined(Any)) -procedure opt_bool(x:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure opt_typed_dict() returns(result:UserDefined(Any)) -procedure opt_str_enum() returns(result:UserDefined(Any)) -procedure opt_int_enum() returns(result:UserDefined(Any)) +procedure test_opt_str() returns(result:UserDefined(Any)) +procedure test_opt_int() returns(result:UserDefined(Any)) +procedure test_opt_bool(x:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_opt_typed_dict() returns(result:UserDefined(Any)) +procedure test_opt_str_enum() returns(result:UserDefined(Any)) +procedure test_opt_int_enum() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -237,15 +240,15 @@ procedure opt_int_enum() returns(result:UserDefined(Any)) /-! ## Error cases (updated to verify MessageKind) -/ /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[mkFuncSig "f" - (identType (PythonIdent.mk "foo" "Bar"))] + (identType (PythonIdent.ofComponent "foo" "Bar"))] /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest @@ -255,21 +258,21 @@ info: procedure f() returns(result:UserDefined(Any)) /-- info: warning: pySpecToLaurel.unsupportedUnion: No type tester for 'foo.Bar' in type 'Union[_types.NoneType, foo.Bar]' -procedure f() returns(result:UserDefined(Any)) +procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[mkFuncSig "f" (mkUnion #[noneType, - identType (PythonIdent.mk "foo" "Bar")])] + identType (PythonIdent.ofComponent "foo" "Bar")])] /-! ## Class and type definitions -/ /-- -info: type MyClass -type MyAlias -procedure my_func(x:UserDefined(Any), y:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure MyClass@get_value() returns(result:UserDefined(Any)) +info: type test_MyClass +type test_MyAlias +procedure test_my_func(x:UserDefined(Any), y:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_MyClass@get_value() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -297,8 +300,8 @@ procedure MyClass@get_value() returns(result:UserDefined(Any)) /-! ## NoneType and void return -/ /-- -info: procedure returns_none() returns(result:UserDefined(Any)) -procedure takes_none(x:UserDefined(Any)) returns(result:UserDefined(Any)) +info: procedure test_returns_none() returns(result:UserDefined(Any)) +procedure test_takes_none(x:UserDefined(Any)) returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -310,8 +313,8 @@ procedure takes_none(x:UserDefined(Any)) returns(result:UserDefined(Any)) /-! ## Class types as UserDefined -/ /-- -info: type Foo -procedure uses_class(x:UserDefined(Foo)) returns(result:UserDefined(Any)) +info: type test_Foo +procedure test_uses_class(x:UserDefined(test_Foo)) returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -319,8 +322,8 @@ procedure uses_class(x:UserDefined(Foo)) returns(result:UserDefined(Any)) loc := loc, name := "Foo" methods := #[] }, - mkFuncSig "uses_class" (identType (PythonIdent.mk "" "Foo")) - (args := #[mkArg "x" (identType (PythonIdent.mk "" "Foo"))]) + mkFuncSig "uses_class" (identType (.mkRaw testModule "Foo")) + (args := #[mkArg "x" (identType (.mkRaw testModule "Foo"))]) ] /-! ## Empty input -/ @@ -343,8 +346,8 @@ private def mkOverload (name : String) (returnType : SpecType) /-- Run signaturesToLaurel and print the full result: Laurel output, dispatch table, and method registry. Sorts by key for stable output. -/ -private def runFullTest (sigs : Array Signature) (modulePrefix : String := "") : IO Unit := do - let result := signaturesToLaurel "" sigs modulePrefix +private def runFullTest (sigs : Array Signature) (moduleName : ModuleName := testModule) : IO Unit := do + let result := signaturesToLaurel "" sigs moduleName if result.errors.size > 0 then IO.println s!"errors: {result.errors.size}" for err in result.errors do @@ -393,8 +396,8 @@ private def list_ := SpecType.ident loc .typingList private def dict_ := SpecType.ident loc .typingDict private def listOf (t : SpecType) := SpecType.ident loc .typingList #[t] private def dictOf (k v : SpecType) := SpecType.ident loc .typingDict #[k, v] -private def pyClass (name : String) := SpecType.ident loc (PythonIdent.mk "" name) -private def externIdent (mod name : String) := PythonIdent.mk mod name +private def pyClass (name : String) := SpecType.ident loc (.mkRaw testModule name) +private def externIdent (mod name : String) := PythonIdent.mkRaw (.ofString! mod) name private def arg (name : String) (type : SpecType) (default : Option SpecDefault := none) : Arg := { name, type, default := default } @@ -442,10 +445,10 @@ private def externType (name : String) (ident : PythonIdent) : Signature := /-! ## All function params and returns map to Any -/ /-- -info: procedure returns_int(x:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure returns_bool(a:UserDefined(Any), b:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure returns_real(flag:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure with_kwonly(x:UserDefined(Any), verbose:UserDefined(Any)) returns(result:UserDefined(Any)) +info: procedure test_returns_int(x:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_returns_bool(a:UserDefined(Any), b:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_returns_real(flag:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_with_kwonly(x:UserDefined(Any), verbose:UserDefined(Any)) returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -460,11 +463,11 @@ procedure with_kwonly(x:UserDefined(Any), verbose:UserDefined(Any)) returns(resu /-! ## Complex types (Any, List, Dict, bytes) -/ /-- -info: procedure takes_any(x:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure takes_list(items:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure returns_dict() returns(result:UserDefined(Any)) -procedure typed_list() returns(result:UserDefined(Any)) -procedure typed_dict() returns(result:UserDefined(Any)) +info: procedure test_takes_any(x:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_takes_list(items:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_returns_dict() returns(result:UserDefined(Any)) +procedure test_typed_list() returns(result:UserDefined(Any)) +procedure test_typed_dict() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -479,10 +482,10 @@ procedure typed_dict() returns(result:UserDefined(Any)) /-- info: warning: pySpecToLaurel.unsupportedUnion: TypedDict 'TypedDict(f : builtins.str)' approximated as DictStrAny in type 'TypedDict(f : builtins.str)' -procedure int_literal_ret() returns(result:UserDefined(Any)) -procedure str_literal_ret() returns(result:UserDefined(Any)) -procedure typed_dict_ret() returns(result:UserDefined(Any)) -procedure str_enum() returns(result:UserDefined(Any)) +procedure test_int_literal_ret() returns(result:UserDefined(Any)) +procedure test_str_literal_ret() returns(result:UserDefined(Any)) +procedure test_typed_dict_ret() returns(result:UserDefined(Any)) +procedure test_str_enum() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -498,12 +501,12 @@ procedure str_enum() returns(result:UserDefined(Any)) /-- info: warning: pySpecToLaurel.unsupportedUnion: TypedDict 'TypedDict(x : builtins.str)' approximated as DictStrAny in type 'Union[_types.NoneType, TypedDict(x : builtins.str)]' -procedure opt_str() returns(result:UserDefined(Any)) -procedure opt_int() returns(result:UserDefined(Any)) -procedure opt_bool(x:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure opt_typed_dict() returns(result:UserDefined(Any)) -procedure opt_str_enum() returns(result:UserDefined(Any)) -procedure opt_int_enum() returns(result:UserDefined(Any)) +procedure test_opt_str() returns(result:UserDefined(Any)) +procedure test_opt_int() returns(result:UserDefined(Any)) +procedure test_opt_bool(x:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_opt_typed_dict() returns(result:UserDefined(Any)) +procedure test_opt_str_enum() returns(result:UserDefined(Any)) +procedure test_opt_int_enum() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -523,14 +526,14 @@ procedure opt_int_enum() returns(result:UserDefined(Any)) /-! ## Error cases (updated to verify WarningKind) -/ /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest - #[func "f" (SpecType.ident loc (PythonIdent.mk "foo" "Bar"))] + #[func "f" (SpecType.ident loc (PythonIdent.ofComponent "foo" "Bar"))] /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest @@ -538,20 +541,20 @@ info: procedure f() returns(result:UserDefined(Any)) /-- info: warning: pySpecToLaurel.unsupportedUnion: No type tester for 'foo.Bar' in type 'Union[_types.NoneType, foo.Bar]' -procedure f() returns(result:UserDefined(Any)) +procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[func "f" - (mkUnion #[none_, SpecType.ident loc (PythonIdent.mk "foo" "Bar")])] + (mkUnion #[none_, SpecType.ident loc (PythonIdent.ofComponent "foo" "Bar")])] /-! ## Class and type definitions -/ /-- -info: type MyClass -type MyAlias -procedure my_func(x:UserDefined(Any), y:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure MyClass@get_value() returns(result:UserDefined(Any)) +info: type test_MyClass +type test_MyAlias +procedure test_my_func(x:UserDefined(Any), y:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_MyClass@get_value() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -563,8 +566,8 @@ procedure MyClass@get_value() returns(result:UserDefined(Any)) /-! ## NoneType and void return -/ /-- -info: procedure returns_none() returns(result:UserDefined(Any)) -procedure takes_none(x:UserDefined(Any)) returns(result:UserDefined(Any)) +info: procedure test_returns_none() returns(result:UserDefined(Any)) +procedure test_takes_none(x:UserDefined(Any)) returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -575,8 +578,8 @@ procedure takes_none(x:UserDefined(Any)) returns(result:UserDefined(Any)) /-! ## Class types as UserDefined -/ /-- -info: type Foo -procedure uses_class(x:UserDefined(Foo)) returns(result:UserDefined(Any)) +info: type test_Foo +procedure test_uses_class(x:UserDefined(test_Foo)) returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[ @@ -595,9 +598,9 @@ procedure uses_class(x:UserDefined(Foo)) returns(result:UserDefined(Any)) -- overloads dispatching on string literals, a service class with methods, -- and a regular function. /-- -info: type SvcClient -procedure SvcClient@do_thing(x:UserDefined(Any)) returns(result:UserDefined(Any)) -procedure helper() returns(result:UserDefined(Any)) +info: type test_SvcClient +procedure test_SvcClient@do_thing(x:UserDefined(Any)) returns(result:UserDefined(Any)) +procedure test_helper() returns(result:UserDefined(Any)) dispatch create_client: "svc_a" -> mod.client.SvcClient "svc_b" -> mod.other.OtherClient @@ -618,11 +621,11 @@ dispatch create_client: -- Overloads with locally-defined class return types. /-- -info: type Alpha -type Beta +info: type test_Alpha +type test_Beta dispatch make: - "a" -> .Alpha - "b" -> .Beta + "a" -> test.Alpha + "b" -> test.Beta -/ #guard_msgs in #eval runFullTest #[ @@ -687,7 +690,7 @@ body contains FieldSelect: false (.intLit 0 loc) loc }]) - ] "" + ] testModule assert! result.errors.size = 0 match result.program.staticProcedures with | proc :: _ => @@ -703,21 +706,21 @@ body contains FieldSelect: false -- bytes, bytearray, complex now map to Any (matching PythonToLaurel) /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[func "f" bytes] /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[func "f" bytearray] /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest @@ -725,35 +728,35 @@ info: procedure f() returns(result:UserDefined(Any)) -- Optional patterns now map to Any without warnings /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[func "f" (mkUnion #[none_, float_])] /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[func "f" (mkUnion #[none_, list_])] /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[func "f" (mkUnion #[none_, dict_])] /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest #[func "f" (mkUnion #[none_, any])] /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest @@ -838,7 +841,7 @@ info: pySpecToLaurel.kwargsExpansionError: **kw has non-TypedDict type; kwargs n -- Declaration: postconditions now translated (no warning) /-- -info: procedure f() returns(result:UserDefined(Any)) +info: procedure test_f() returns(result:UserDefined(Any)) -/ #guard_msgs in #eval runTest @@ -919,7 +922,7 @@ private def translatePrecondResult (preconditions : Array Assertion) args := { args, kwonly := #[] } returnType := str, isOverload := false preconditions, postconditions := #[] - }] "" + }] testModule /-- Translate a single function with preconditions and return `(bodyString, errorCount)`. -/ @@ -965,7 +968,7 @@ private def translatePrecond (preconditions : Array Assertion) preconditions := #[{ message := #[], formula := .containsKey (.var "kwargs" loc) "key" loc }] - postconditions := #[] }] "" + postconditions := #[] }] testModule let body := getBody result |>.getD "" assertEq result.errors.size 0 assert! body.contains "result := " @@ -1016,7 +1019,7 @@ private def translateFunc (args : Array Arg := #[]) args := { args := args, kwonly := #[] } returnType, isOverload := false preconditions, postconditions - }] "" + }] testModule (getBody result |>.getD "", result.errors.size) -- No args, no preconditions: body has havoc + return type assume @@ -1052,7 +1055,7 @@ private def translateFunc (args : Array Arg := #[]) -- Composite return type: no assume (no tester for user-defined types) #eval do let (body, errs) := translateFunc - (returnType := SpecType.ident loc (PythonIdent.mk "mod" "Cls")) + (returnType := SpecType.ident loc (PythonIdent.ofComponent "mod" "Cls")) assert! errs == 0 assert! !body.contains "assume" diff --git a/StrataTest/Util/Python.lean b/StrataTest/Util/Python.lean index a1528054f6..f6abf7a1ae 100644 --- a/StrataTest/Util/Python.lean +++ b/StrataTest/Util/Python.lean @@ -68,6 +68,18 @@ def miseWhere (runtime : String) (miseCmd : String := "mise") : IO (Option Syste throw <| .userError msg pure <| some stdout.trimAscii.toString +/-- +info: none +-/ +#guard_msgs in +#eval miseWhere "Python@1.0" + +/-- +info: none +-/ +#guard_msgs in +#eval miseWhere "Python@3.12" (miseCmd := "nonexisting-mise") + /-- This checks to see if a module is found. -/ @@ -97,18 +109,6 @@ def pythonCheckModule (pythonCmd : System.FilePath) (moduleName : String) : IO B throw <| .userError s!"{pythonCmd} has unexpected exit code {exitCode}" -/-- -info: none --/ -#guard_msgs in -#eval miseWhere "Python@1.0" - -/-- -info: none --/ -#guard_msgs in -#eval miseWhere "Python@3.12" (miseCmd := "nonexisting-mise") - /-- Utility to get Python 3 minor version. @@ -208,9 +208,5 @@ def withPython (action : System.FilePath → IO Unit) : IO Unit := do s!"Python Strata libraries not installed in {pythonCmd}." action pythonCmd -/-- Check if `needle` is a substring of `haystack`. -/ -def containsSubstr (haystack needle : String) : Bool := - (haystack.splitOn needle).length != 1 - end Strata.Python end diff --git a/StrataTestExtra/Languages/Python/DictNoneTest.lean b/StrataTestExtra/Languages/Python/DictNoneTest.lean index 6ed9baaede..2dbe7a73c6 100644 --- a/StrataTestExtra/Languages/Python/DictNoneTest.lean +++ b/StrataTestExtra/Languages/Python/DictNoneTest.lean @@ -16,7 +16,7 @@ is correctly detected as a bug, both for direct assignments and dict unpacking. namespace Strata.Python.DictNoneTest -open Strata.Python (processPythonFile withPython containsSubstr) +open Strata.Python (processPythonFile withPython) open Strata.Parser (stringInputContext) -- Test 1: Using a valid int should succeed (0 diagnostics). @@ -32,7 +32,7 @@ open Strata.Parser (stringInputContext) throw <| .userError s!"Expected 0 diagnostics, got {diags.size}: {diags.map (·.message)}" private def isAssertionFailure (msg : String) : Bool := - containsSubstr msg "does not hold" || containsSubstr msg "could not be proved" + msg.contains "does not hold" || msg.contains "could not be proved" -- Test 2: Assigning None to an int variable with a value-dependent assertion. #guard_msgs in @@ -110,7 +110,7 @@ def main() -> None: match ← (processPythonFile pythonCmd (stringInputContext "test.py" program)).toBaseIO with | .ok _ => throw <| IO.userError "Expected error for len() on class without __len__" | .error err => - unless containsSubstr (toString err) "len() is not supported" do + unless (toString err).contains "len() is not supported" do throw <| IO.userError s!"Unexpected error: {err}" end Strata.Python.DictNoneTest diff --git a/StrataTestExtra/Languages/Python/Specs/IdentifyOverloadsTest.lean b/StrataTestExtra/Languages/Python/Specs/IdentifyOverloadsTest.lean index 34fab79887..604641c209 100644 --- a/StrataTestExtra/Languages/Python/Specs/IdentifyOverloadsTest.lean +++ b/StrataTestExtra/Languages/Python/Specs/IdentifyOverloadsTest.lean @@ -22,6 +22,7 @@ fewer. namespace Strata.Python.Specs.IdentifyOverloadsTest open Strata (readDispatchOverloads pySpecsDir pySpecOutputPath) +open Strata.Python (ModuleName) open Strata.Python.Specs.IdentifyOverloads (resolveOverloads) open Strata.Python (OverloadTable) @@ -95,32 +96,32 @@ private meta def resolveFile (pythonCmd : System.FilePath) (tbl : OverloadTable) (pyFile : System.FilePath) (outDir : System.FilePath) - : IO (Std.HashSet String) := do + : IO (Std.HashSet ModuleName) := do let ionPath ← compilePython pythonCmd pyFile outDir let stmts ← parseStmts ionPath return (resolveOverloads tbl stmts).modules /-- A test case: Python file and exact expected module set. -/ private structure TestCase where - file : String - expected : List String + file : System.FilePath + expected : List ModuleName private meta def testCases : List TestCase := [ -- Single service at top level { file := "test_single_service.py" - expected := ["servicelib.Storage"] }, + expected := [.ofString! "servicelib.Storage"] }, -- Multiple services { file := "test_multi_service.py" - expected := ["servicelib.Storage", "servicelib.Messaging"] }, + expected := [.ofString! "servicelib.Storage", .ofString! "servicelib.Messaging"] }, -- Dispatch inside a class method { file := "test_class_dispatch.py" - expected := ["servicelib.Storage"] }, + expected := [.ofString! "servicelib.Storage"] }, -- Dispatch in both branches of an if/else { file := "test_dispatch_in_conditional.py" - expected := ["servicelib.Storage", "servicelib.Messaging"] }, + expected := [.ofString! "servicelib.Storage", .ofString! "servicelib.Messaging"] }, -- Dispatch inside a try block { file := "test_dispatch_in_try.py" - expected := ["servicelib.Storage"] }, + expected := [.ofString! "servicelib.Storage"] }, -- No dispatch calls at all { file := "test_no_dispatch.py" expected := [] }, @@ -135,11 +136,11 @@ private meta def runTestCase (tbl : OverloadTable) (outDir : System.FilePath) (tc : TestCase) : IO (Option String) := do let modules ← resolveFile pythonCmd tbl (testDir / tc.file) outDir - let expected : Std.HashSet String := + let expected : Std.HashSet ModuleName := tc.expected.foldl (init := {}) fun s m => s.insert m if modules == expected then return none - let got := modules.toList - let exp := expected.toList + let got := modules.toList.map toString + let exp := expected.toList.map toString return some s!"{tc.file}: expected modules {exp}, got {got}" @@ -147,8 +148,8 @@ private meta def runTestCase IO.FS.withTempDir fun tmpDir => do let tbl ← buildOverloadTable pythonCmd tmpDir -- Launch all tests concurrently - let mut seen : Std.HashSet String := {} - let mut tasks : Array (String × Task (Except IO.Error (Option String))) := #[] + let mut seen : Std.HashSet System.FilePath := {} + let mut tasks : Array (System.FilePath × Task (Except IO.Error (Option String))) := #[] for tc in testCases do if tc.file ∈ seen then throw <| IO.userError s!"Duplicate test filename: {tc.file}" diff --git a/StrataTestExtra/Languages/Python/Specs/RelativeImportTest.lean b/StrataTestExtra/Languages/Python/Specs/RelativeImportTest.lean index 0c08b50acc..198d38f8b8 100644 --- a/StrataTestExtra/Languages/Python/Specs/RelativeImportTest.lean +++ b/StrataTestExtra/Languages/Python/Specs/RelativeImportTest.lean @@ -20,8 +20,8 @@ actionable error messages. namespace Strata.Python.Specs.RelativeImportTest -open Strata.Python.Specs (translateFile ModuleName) -open Strata.Python (containsSubstr) +open Strata.Python.Specs (translateFile) +open Strata.Python (ModuleName) private meta def testDir : System.FilePath := "StrataTestExtra/Languages/Python/Specs/import_test" @@ -38,26 +38,16 @@ private meta def runTest (pythonCmd : System.FilePath) (dialectFile : System.Fil let pythonFile := testDir / file let searchPath := if searchFromTestDir then testDir else pythonFile.parent.getD pythonFile - -- When searching from testDir, derive a multi-component module name - -- from the relative path so that currentModulePrefix is non-empty - -- (e.g. "service/rel_import_basic.py" → "service.rel_import_basic"). - let moduleName ← if searchFromTestDir then - let stem := if (file : String).endsWith "/__init__.py" then - ((file : String).dropEnd "/__init__.py".length).toString - else - ((file : String).dropEnd ".py".length).toString - let dotted := stem.replace "/" "." - match ModuleName.ofString dotted with - | .ok m => pure (some m) - | .error e => return some s!"{file}: bad module name: {e}" - else pure none + let moduleName ← match ModuleName.ofRelativePath file with + | .ok info => pure info.moduleName + | .error msg => return some s!"{file}: {msg}" let r ← translateFile (pythonCmd := toString pythonCmd) (dialectFile := dialectFile) (strataDir := strataDir) (pythonFile := pythonFile) (searchPath := searchPath) - (moduleName := moduleName) + moduleName |>.toBaseIO if expectedErrors.isEmpty then match r with @@ -68,7 +58,7 @@ private meta def runTest (pythonCmd : System.FilePath) (dialectFile : System.Fil | .ok _ => return some s!"{file}: expected error but translation succeeded" | .error msg => for expected in expectedErrors do - if !containsSubstr msg expected then + if !msg.contains expected then return some s!"{file}: error missing expected substring \"{expected}\"\nActual error:\n{msg}" return none diff --git a/StrataTestExtra/Languages/Python/SpecsTest.lean b/StrataTestExtra/Languages/Python/SpecsTest.lean index ef08c905ef..1bc0e66a03 100644 --- a/StrataTestExtra/Languages/Python/SpecsTest.lean +++ b/StrataTestExtra/Languages/Python/SpecsTest.lean @@ -226,6 +226,7 @@ meta def testCase : IO Unit := withPython fun pythonCmd => do (strataDir := strataDir) (pythonFile := testDir / "main.py") (searchPath := testDir) + (.ofComponent (.ofString "main")) |>.toBaseIO match r with | .ok (sigs, warnings) => @@ -264,6 +265,7 @@ meta def warningTestCase : IO Unit := withPython fun pythonCmd => do (strataDir := strataDir) (pythonFile := testDir / "warnings.py") (searchPath := testDir) + (.ofComponent (.ofString "warnings")) |>.toBaseIO match r with | .ok (sigs, warnings) => @@ -282,7 +284,7 @@ meta def warningTestCase : IO Unit := withPython fun pythonCmd => do "skipped Expr in function body" -- kw["a"] (bare expression) ] for expected in expectedWarnings do - if !warnings.any (containsSubstr · expected) then + if !warnings.any (·.contains expected) then let warnStr := warnings.foldl (init := "") fun acc w => s!"{acc}\n {w}" throw <| IO.userError s!"Missing expected warning containing \"{expected}\". Actual warnings:{warnStr}" diff --git a/StrataTestExtra/Languages/Python/VerifyPythonTest.lean b/StrataTestExtra/Languages/Python/VerifyPythonTest.lean index a8343c61a1..2e23151c6f 100644 --- a/StrataTestExtra/Languages/Python/VerifyPythonTest.lean +++ b/StrataTestExtra/Languages/Python/VerifyPythonTest.lean @@ -17,7 +17,7 @@ Python → Laurel → Core → SMT pipeline and produces diagnostics. namespace Strata.Python.VerifyPythonTest open StrataTest.Util -open Strata.Python (processPythonFile processPythonToLaurel withPython containsSubstr manglePythonMethod) +open Strata.Python (processPythonFile processPythonToLaurel withPython manglePythonMethod) open Strata.Parser (stringInputContext) /-- Run the Python → Laurel pipeline and return the Laurel program together @@ -190,7 +190,7 @@ def main() -> None: throw <| IO.userError "Expected pipeline error for too many positional arguments" catch e => let msg := toString e - unless containsSubstr msg "too many positional arguments" do + unless msg.contains "too many positional arguments" do throw <| IO.userError s!"Expected 'too many positional arguments' error, got: {msg}" -- Extra positional args with **kwargs expansion should also error. @@ -209,7 +209,7 @@ def main() -> None: throw <| IO.userError "Expected pipeline error for too many positional arguments" catch e => let msg := toString e - unless containsSubstr msg "too many positional arguments" do + unless msg.contains "too many positional arguments" do throw <| IO.userError s!"Expected 'too many positional arguments' error, got: {msg}" -- Returning a Composite-typed value from a function with Any return type @@ -341,7 +341,7 @@ def main() -> None: let (laurel, output) ← toLaurel pythonCmd program let calcAdd := manglePythonMethod "Calculator" "add" assertOpaque laurel calcAdd - unless containsSubstr output s!"{calcAdd}(" do + unless output.contains s!"{calcAdd}(" do throw <| IO.userError s!"Expected '{calcAdd}(' in Laurel output but not found" -- self.field.method() resolution and composite field initialization: @@ -372,10 +372,10 @@ def main() -> None: let (_, output) ← toLaurel pythonCmd program let innerValidate := manglePythonMethod "Inner" "validate" -- self.inner.validate() must resolve to Inner@validate StaticCall - unless containsSubstr output s!"{innerValidate}(" do + unless output.contains s!"{innerValidate}(" do throw <| IO.userError s!"Expected '{innerValidate}(' in Laurel output but not found" -- Composite field assignment (self.inner: Inner = ...) uses New initialization - unless containsSubstr output "new Inner" do + unless output.contains "new Inner" do throw <| IO.userError s!"Expected 'new Inner' in Laurel output but not found" -- Inheritance guard: when a class is part of an inheritance hierarchy, @@ -412,7 +412,7 @@ def main() -> None: | none => throw <| .userError "main procedure not found" | some proc => let mainOutput := toString (Laurel.formatProcedure proc) - if containsSubstr mainOutput s!"{baseValue}(" then + if mainOutput.contains s!"{baseValue}(" then throw <| IO.userError s!"main should NOT call {baseValue} (inheritance guard)" -- Inheritance with field type conflict: B inherits A and redeclares field x @@ -478,7 +478,7 @@ def main() -> None: | none => throw <| .userError "main procedure not found" | some proc => let mainOutput := toString (Laurel.formatProcedure proc) - if containsSubstr mainOutput s!"{aF}(" then + if mainOutput.contains s!"{aF}(" then throw <| IO.userError s!"main should NOT call {aF} (inheritance dispatch unsound)" -- Cross-class method dispatch: a method in one class calls a method on @@ -508,10 +508,10 @@ def main() -> None: let engineGetHp := manglePythonMethod "Engine" "get_hp" let carHorsepower := manglePythonMethod "Car" "horsepower" -- self.engine.get_hp() should resolve to Engine@get_hp StaticCall - unless containsSubstr output s!"{engineGetHp}(" do + unless output.contains s!"{engineGetHp}(" do throw <| IO.userError s!"Expected '{engineGetHp}(' in Laurel output but not found" -- Car@horsepower should also be a StaticCall from main - unless containsSubstr output s!"{carHorsepower}(" do + unless output.contains s!"{carHorsepower}(" do throw <| IO.userError s!"Expected '{carHorsepower}(' in Laurel output but not found" -- Full pipeline: composite field assignment goes through the entire From cd1cac78e37b5343c4c80ba8676c93b9cd086115 Mon Sep 17 00:00:00 2001 From: David Deng Date: Wed, 20 May 2026 08:20:02 -0700 Subject: [PATCH 20/28] Fix namespace collision and SMACK assert encoding in BoogieToStrata (#1149) *Issue #, if available:* #1148 *Description of changes:* 1. Namespace collision (issue 1 in #1148): Constants that share a name with a procedure are now prefixed with __const_ in the Strata output. The rename is applied consistently in declarations and references. 2. Recursive synonym resolution (Fixes issue 2 in #1148): DealiasTypeExpr now recurses on its result, resolving synonym chains like ref := i64 := int fully to the base type. Previously it resolved only one level, causing panics on comparison/arithmetic operators applied to multi-level type synonyms. 3. SMACK assert encoding (issue 3 in #1148): Procedures named assert_.* now get a requires (arg != 0) precondition emitted. Call elimination generates VCs at each call site, making SMACK assertions verifiable. 4. InferModifies: SMACK-generated Boogie often omits explicit `modifies` clauses on procedures that mutate globals. Setting `InferModifies = true` in BoogieToStrata has two effects: (1) it runs `ModSetCollector.CollectModifies(program)` to populate empty modifies clauses, and (2) through `CheckModifies` in Boogie's resolution context, it suppresses typechecking of modifies clauses. Without this, `ResolveAndTypecheck` would reject SMACK programs that omit modifies clauses. By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: David Deng Co-authored-by: Claude Opus 4.6 (1M context) --- .../Core/DDMTransform/Translate.lean | 4 +- .../BoogieToStrataIntegrationTests.cs | 200 +++++++++++++++++- Tools/BoogieToStrata/Source/BoogieToStrata.cs | 51 ++++- .../BoogieToStrata/Source/StrataGenerator.cs | 145 +++++++++++-- .../Tests/AssertPrefixFalsePositive.bpl | 12 ++ .../Tests/AssertPrefixFalsePositive.expect | 2 + .../Tests/GlobalVarRenameCollision.bpl | 9 + .../Tests/GlobalVarRenameCollision.expect | 2 + .../Tests/InferModifiesGlobal.bpl | 17 ++ .../Tests/InferModifiesGlobal.expect | 2 + .../Tests/NamespaceCollision.bpl | 25 +++ .../Tests/NamespaceCollision.expect | 4 + .../Tests/OldExprRenameCollision.bpl | 17 ++ .../Tests/OldExprRenameCollision.expect | 3 + .../Tests/SanitizationCollision.bpl | 25 +++ .../Tests/SanitizationCollision.expect | 5 + Tools/BoogieToStrata/Tests/SmackAssert.bpl | 18 ++ Tools/BoogieToStrata/Tests/SmackAssert.expect | 3 + .../Tests/SmackAssertDuplicateSpec.bpl | 30 +++ .../BoogieToStrata/Tests/TypeSynonymChain.bpl | 20 ++ .../Tests/TypeSynonymChain.expect | 5 + 21 files changed, 569 insertions(+), 30 deletions(-) create mode 100644 Tools/BoogieToStrata/Tests/AssertPrefixFalsePositive.bpl create mode 100644 Tools/BoogieToStrata/Tests/AssertPrefixFalsePositive.expect create mode 100644 Tools/BoogieToStrata/Tests/GlobalVarRenameCollision.bpl create mode 100644 Tools/BoogieToStrata/Tests/GlobalVarRenameCollision.expect create mode 100644 Tools/BoogieToStrata/Tests/InferModifiesGlobal.bpl create mode 100644 Tools/BoogieToStrata/Tests/InferModifiesGlobal.expect create mode 100644 Tools/BoogieToStrata/Tests/NamespaceCollision.bpl create mode 100644 Tools/BoogieToStrata/Tests/NamespaceCollision.expect create mode 100644 Tools/BoogieToStrata/Tests/OldExprRenameCollision.bpl create mode 100644 Tools/BoogieToStrata/Tests/OldExprRenameCollision.expect create mode 100644 Tools/BoogieToStrata/Tests/SanitizationCollision.bpl create mode 100644 Tools/BoogieToStrata/Tests/SanitizationCollision.expect create mode 100644 Tools/BoogieToStrata/Tests/SmackAssert.bpl create mode 100644 Tools/BoogieToStrata/Tests/SmackAssert.expect create mode 100644 Tools/BoogieToStrata/Tests/SmackAssertDuplicateSpec.bpl create mode 100644 Tools/BoogieToStrata/Tests/TypeSynonymChain.bpl create mode 100644 Tools/BoogieToStrata/Tests/TypeSynonymChain.expect diff --git a/Strata/Languages/Core/DDMTransform/Translate.lean b/Strata/Languages/Core/DDMTransform/Translate.lean index 1fa2b4fe95..570e02f5ad 100644 --- a/Strata/Languages/Core/DDMTransform/Translate.lean +++ b/Strata/Languages/Core/DDMTransform/Translate.lean @@ -442,8 +442,8 @@ partial def dealiasTypeExpr (p : Program) (te : TypeExpr) : TypeExpr := match te with | (.fvar _ idx #[]) => match p.globalContext.kindOf! idx with - | .expr te => te - | .type [] (.some te) => te + | .expr te => dealiasTypeExpr p te + | .type [] (.some te) => dealiasTypeExpr p te | _ => te | _ => te diff --git a/Tools/BoogieToStrata/IntegrationTests/BoogieToStrataIntegrationTests.cs b/Tools/BoogieToStrata/IntegrationTests/BoogieToStrataIntegrationTests.cs index 05e16b9b9f..2f921c041b 100644 --- a/Tools/BoogieToStrata/IntegrationTests/BoogieToStrataIntegrationTests.cs +++ b/Tools/BoogieToStrata/IntegrationTests/BoogieToStrataIntegrationTests.cs @@ -51,7 +51,28 @@ public static IEnumerable GetBoogieTestFiles() { } } + /// + /// Returns true if the first 5 lines of contain + /// the literal token "{:smack}". Files carrying this marker opt into the + /// --smack CLI flag, which gates the assert_. synthetic-requires + /// injection and InferModifies=true. + /// + private static bool HasSmackMarker(string filePath) { + if (!File.Exists(filePath)) return false; + using var reader = new StreamReader(filePath); + for (var i = 0; i < 5; i++) { + var line = reader.ReadLine(); + if (line == null) break; + if (line.Contains("{:smack}", StringComparison.Ordinal)) return true; + } + return false; + } + private (int, string, string) RunTranslation(string filePath) { + return RunTranslation(filePath, HasSmackMarker(filePath)); + } + + private (int, string, string) RunTranslation(string filePath, bool smack) { // Capture console output using var consoleOutput = new StringWriter(); using var consoleError = new StringWriter(); @@ -62,7 +83,8 @@ public static IEnumerable GetBoogieTestFiles() { try { Console.SetOut(consoleOutput); Console.SetError(consoleError); - exitCode = BoogieToStrata.Main([filePath]); + var args = smack ? new[] { "--smack", filePath } : new[] { filePath }; + exitCode = BoogieToStrata.Main(args); } catch (Exception) { exitCode = 1; } finally { @@ -149,6 +171,182 @@ public void VerifyTestFile(string fileName, string filePath) { Assert.Equal(expectedExitCode, proc.ExitCode); } + /// + /// Regression test: assert_. procedures must produce a single + /// merged spec block, not duplicates, regardless of whether the input + /// already has user-written specs. Two cases: + /// 1. existing ensures only — synthetic requires merges in. + /// 2. existing requires — synthetic requires is added alongside, + /// not silently dropped. + /// + [Fact] + public void SmackAssertProducesSingleMergedSpecBlock() { + var filePath = Path.Combine(TestsDirectory, "SmackAssertDuplicateSpec.bpl"); + Assert.True(File.Exists(filePath), $"Test file does not exist: {filePath}"); + + var (exitCode, standardOutput, errorOutput) = RunTranslation(filePath); + Assert.Equal(0, exitCode); + + // Three procedures (assert_.i32, assert_.i32_with_req, main); the two + // assert_. ones each produce one spec block; main has none. + // Count occurrences of "spec {" in the output: must be exactly 2. + var specCount = 0; + var searchFrom = 0; + while (true) { + var idx = standardOutput.IndexOf("spec {", searchFrom, StringComparison.Ordinal); + if (idx < 0) break; + specCount++; + searchFrom = idx + 1; + } + + output.WriteLine($"Output:\n{standardOutput}"); + Assert.Equal(2, specCount); + + // Overall sanity: the output contains at least one of each clause kind. + // (assert_.i32 has an `ensures`, both procedures have at least one + // `requires`.) + Assert.Contains("requires", standardOutput); + Assert.Contains("ensures", standardOutput); + + // The critical regression check: BOTH clauses must appear in the + // SECOND procedure's spec block (assert_.i32_with_req) — i.e., the + // requires-already-present case must not silently drop the synthetic + // clause. Procedures emit in source order, so the second `spec {` is + // assert_.i32_with_req's. + var firstSpec = standardOutput.IndexOf("spec {", StringComparison.Ordinal); + Assert.True(firstSpec >= 0, "Expected at least one spec block"); + var secondSpecStart = standardOutput.IndexOf("spec {", firstSpec + 1, StringComparison.Ordinal); + Assert.True(secondSpecStart >= 0, "Expected a second spec block for assert_.i32_with_req"); + var secondSpecEnd = standardOutput.IndexOf("}", secondSpecStart, StringComparison.Ordinal); + Assert.True(secondSpecEnd > secondSpecStart, "Second spec block missing closing brace"); + var secondSpec = standardOutput.Substring(secondSpecStart, secondSpecEnd - secondSpecStart); + + // The user-written `requires (p.0 > -1)` (sanitized to `p_0 > -(1)`) + // and the synthetic `requires (p.0 != 0)` (sanitized to `p_0 != 0`) + // must both be present in this single spec block. + Assert.Contains("p_0 > -(1)", secondSpec); + Assert.Contains("p_0 != 0", secondSpec); + } + + /// + /// Regression test: old() expressions must use the renamed name when a + /// variable has a name collision (e.g., global var `main` vs procedure `main`). + /// Previously, IdentifierExpr with Decl != null used NameOf() correctly, but + /// had a silent fallback to Name() when Decl was null — which would emit the + /// unrenamed (wrong) name in the collision case. Post-resolution, Decl should + /// always be non-null; the fallback masked potential bugs. + /// + [Fact] + public void OldExprUsesRenamedNameOnCollision() { + var filePath = Path.Combine(TestsDirectory, "OldExprRenameCollision.bpl"); + Assert.True(File.Exists(filePath), $"Test file does not exist: {filePath}"); + + var (exitCode, standardOutput, errorOutput) = RunTranslation(filePath); + + output.WriteLine($"Output:\n{standardOutput}"); + if (!string.IsNullOrEmpty(errorOutput)) { + output.WriteLine($"Error output: {errorOutput}"); + } + + Assert.Equal(0, exitCode); + + // The output should contain an `old` expression referencing the *renamed* + // variable (e.g., __var_main), not the raw name `main` which is the procedure. + // Look for the pattern "old __var_main" or similar renamed form. + Assert.Contains("old __var_main", standardOutput); + + // Also ensure the output does NOT contain "old main" (unrenamed fallback). + // This would indicate the fallback to Name() was used instead of NameOf(). + Assert.DoesNotContain("old main", standardOutput); + } + + /// + /// Regression test for InferModifies = true. + /// + /// SMACK-generated Boogie can omit explicit modifies clauses on procedures. + /// With InferModifies = true, Boogie's ModSetCollector infers them so that + /// the translator correctly emits globals as `inout` parameters (modified) + /// rather than read-only parameters. + /// + /// This test uses a .bpl file where procedure p() assigns to global g but + /// has no `modifies g;` clause. If InferModifies is working, the output + /// should contain `inout g` for procedure p. + /// + [Fact] + public void InferModifiesEmitsInoutForMutatedGlobal() { + var filePath = Path.Combine(TestsDirectory, "InferModifiesGlobal.bpl"); + Assert.True(File.Exists(filePath), $"Test file does not exist: {filePath}"); + + var (exitCode, standardOutput, errorOutput) = RunTranslation(filePath); + + output.WriteLine($"Output:\n{standardOutput}"); + if (!string.IsNullOrEmpty(errorOutput)) { + output.WriteLine($"Error output: {errorOutput}"); + } + + // Translation must succeed — if InferModifies is broken, Boogie would + // reject the program because g is assigned without a modifies clause. + Assert.Equal(0, exitCode); + + // The inferred modifies clause should cause the translator to emit + // `inout g` on procedure p's parameter list. + Assert.Contains("inout g", standardOutput); + } + + /// + /// Pin down the --smack gate: without the flag, the assert_. + /// pattern is treated as an opaque procedure (no synthetic requires + /// injected). Translation succeeds; the output does not contain a + /// requires clause for the assert_ procedure. + /// + [Fact] + public void SmackAssertWithoutFlagDoesNotInjectRequires() { + var filePath = Path.Combine(TestsDirectory, "SmackAssert.bpl"); + Assert.True(File.Exists(filePath), $"Test file does not exist: {filePath}"); + + var (exitCode, standardOutput, errorOutput) = RunTranslation(filePath, smack: false); + + output.WriteLine($"Output:\n{standardOutput}"); + if (!string.IsNullOrEmpty(errorOutput)) { + output.WriteLine($"Error output: {errorOutput}"); + } + + Assert.Equal(0, exitCode); + + // Without --smack, no synthetic requires is added, so no `requires` + // clause should appear anywhere in the translation of this file + // (the .bpl has no user-written requires either). + Assert.DoesNotContain("requires", standardOutput); + } + + /// + /// Pin down the --smack gate: without the flag, InferModifies is off. + /// A program that omits an explicit `modifies` clause on a procedure + /// that mutates a global is rejected at typecheck. + /// + [Fact] + public void InferModifiesOffWithoutSmackFlag() { + var filePath = Path.Combine(TestsDirectory, "InferModifiesGlobal.bpl"); + Assert.True(File.Exists(filePath), $"Test file does not exist: {filePath}"); + + var (exitCode, standardOutput, errorOutput) = RunTranslation(filePath, smack: false); + + output.WriteLine($"Exit code: {exitCode}"); + output.WriteLine($"Output:\n{standardOutput}"); + if (!string.IsNullOrEmpty(errorOutput)) { + output.WriteLine($"Error output: {errorOutput}"); + } + + // Without --smack, ResolveAndTypecheck rejects the program because + // procedure p mutates global g without an explicit `modifies g;` + // clause. BoogieToStrata.Main writes a "Failed to typecheck" line + // to stderr and returns exit code 1. Pin both signals so a future + // regression that fails for an unrelated reason (parse error, + // arg-handling change) doesn't silently pass this test. + Assert.Equal(1, exitCode); + Assert.Contains("Failed to typecheck", errorOutput); + } + [Fact] public void ErrorCodeWithNoArguments() { var result = BoogieToStrata.Main(Array.Empty()); diff --git a/Tools/BoogieToStrata/Source/BoogieToStrata.cs b/Tools/BoogieToStrata/Source/BoogieToStrata.cs index 1816f6a1fc..de97643552 100644 --- a/Tools/BoogieToStrata/Source/BoogieToStrata.cs +++ b/Tools/BoogieToStrata/Source/BoogieToStrata.cs @@ -3,22 +3,59 @@ namespace BoogieToStrata; public static class BoogieToStrata { + private const string Usage = "Usage: BoogieToStrata [--smack] "; + + private static bool _smack; + private static void PrintResolvedProgram(ExecutionEngineOptions options, ProcessedProgram prog) { var writer = new TokenTextWriter(Console.Out, options); - StrataGenerator.EmitProgramAsStrata(options, prog.Program, writer); + StrataGenerator.EmitProgramAsStrata(options, prog.Program, writer, _smack); + } + + /// + /// Parse args into (smack, filename). Returns false on any malformed + /// invocation (zero or two-plus positional args, unknown flags); the + /// caller should print Usage and return exit code 1. + /// + private static bool TryParseArgs(string[] args, out bool smack, out string filename) { + smack = false; + filename = ""; + string? positional = null; + foreach (var arg in args) { + if (arg == "--smack") { + smack = true; + } else if (arg.StartsWith("--")) { + return false; // unknown flag + } else if (positional == null) { + positional = arg; + } else { + return false; // two positional args + } + } + if (positional == null) return false; // no positional arg + filename = positional; + return true; } public static int Main(string[] args) { - if (args.Length != 1) { - Console.Error.WriteLine("Usage: BoogieToStrata "); + if (!TryParseArgs(args, out var smack, out var filename)) { + Console.Error.WriteLine(Usage); return 1; } - - var filename = args[0]; + _smack = smack; var options = new CommandLineOptions(Console.Out, new ConsolePrinter()) { Verify = false, - TypeEncodingMethod = CoreOptions.TypeEncoding.Predicates + TypeEncodingMethod = CoreOptions.TypeEncoding.Predicates, + // Under --smack, SMACK-generated Boogie often omits explicit + // `modifies` clauses on procedures that mutate globals. + // InferModifies runs ModSetCollector.CollectModifies to populate + // empty modifies clauses and suppresses modifies-clause + // typechecking (via CheckModifies), so that ResolveAndTypecheck + // does not reject SMACK programs missing modifies clauses. + // For strict Boogie input (no --smack), this stays false and + // missing modifies clauses are reported as typecheck errors. + InferModifies = smack }; var boogieEngine = ExecutionEngine.CreateWithoutSharedCache(options); @@ -44,4 +81,4 @@ public static int Main(string[] args) { return 0; } -} \ No newline at end of file +} diff --git a/Tools/BoogieToStrata/Source/StrataGenerator.cs b/Tools/BoogieToStrata/Source/StrataGenerator.cs index 368e6e7b5f..ad269fc77a 100644 --- a/Tools/BoogieToStrata/Source/StrataGenerator.cs +++ b/Tools/BoogieToStrata/Source/StrataGenerator.cs @@ -52,15 +52,33 @@ public class StrataGenerator : ReadOnlyVisitor { // Global variables collected from the program, used to convert them // into inout/input parameters on procedure headers and call sites. private List _globalVariables = []; - - private StrataGenerator(VCGenOptions options, TokenTextWriter writer, Program program) { + // Renames for declarations whose sanitized name collides with another + // declaration. Keyed by Boogie Declaration object to avoid ambiguity + // when two entities share the same original name (e.g., const main and + // procedure main). First-seen wins; later entities get prefixed. + // + // Registration order determines who wins a collision: + // 1. Procedures — registered first, always keep their name. + // 2. Implementations — claimed defensively (they share names with + // their procedures, but claiming guards against edge cases). + // 3. Constants, Functions, Globals — registered last; in a + // proc-vs-const collision the constant is always renamed. + private readonly Dictionary _renames = new(); + // True when the input is SMACK-generated Boogie. Gates SMACK-specific + // accommodations (synthetic `requires (p != 0)` on assert_. procedures). + // The companion `InferModifies = true` knob is set on the Boogie options + // by the BoogieToStrata.Main entrypoint, also gated on this flag. + private readonly bool _smack; + + private StrataGenerator(VCGenOptions options, TokenTextWriter writer, Program program, bool smack) { _options = options; _writer = writer; _program = program; + _smack = smack; } - public static void EmitProgramAsStrata(VCGenOptions options, Program p, TokenTextWriter writer) { - var generator = new StrataGenerator(options, writer, p); + public static void EmitProgramAsStrata(VCGenOptions options, Program p, TokenTextWriter writer, bool smack) { + var generator = new StrataGenerator(options, writer, p, smack); var fieldTypeCollector = new FieldTypeCollector(); fieldTypeCollector.Visit(p); @@ -74,6 +92,31 @@ public static void EmitProgramAsStrata(VCGenOptions options, Program p, TokenTex generator.FindSpecialTypes(); + // Build rename map for declarations with colliding sanitized names. + // Two kinds of collision are handled: + // 1. Cross-namespace: constant vs procedure sharing the same name + // 2. Sanitization: distinct names that map to the same string + // (e.g., $add.i32 and $add_i32 both become _add_i32) + // First-seen wins; colliding entities get a suffix (_2, _3, ...). + var claimed = new HashSet(); + + foreach (var proc in p.Procedures) + ClaimOrRename(proc, proc.Name, "__proc_", claimed, generator._renames); + // Defensive: implementations share names with their corresponding + // procedures, so they would normally never collide. Claiming them + // here guards against edge cases (e.g., an implementation whose + // procedure was pruned or renamed upstream). + foreach (var impl in p.Implementations) { + var sanitized = SanitizeNameForStrata(impl.Name); + claimed.Add(sanitized); + } + foreach (var c in liveDeclarations.OfType()) + ClaimOrRename(c, c.TypedIdent.Name, "__const_", claimed, generator._renames); + foreach (var f in liveDeclarations.OfType()) + ClaimOrRename(f, f.Name, "__func_", claimed, generator._renames); + foreach (var g in p.GlobalVariables) + ClaimOrRename(g, g.Name, "__var_", claimed, generator._renames); + var typeConstructors = p.TopLevelDeclarations.OfType().ToList(); if (typeConstructors.Count != 0) { generator.WriteLine("// Type constructors"); @@ -205,6 +248,29 @@ private static string SanitizeNameForStrata(string name) { .Replace("$", "_"); } + /// + /// Claim a sanitized name for , or rename it if the + /// name is already taken. The first declaration to claim a name wins; + /// subsequent colliders get a prefixed (and possibly suffixed) name recorded + /// in . + /// + private static void ClaimOrRename( + Declaration decl, + string originalName, + string prefix, + HashSet claimed, + Dictionary renames) { + var sanitized = SanitizeNameForStrata(originalName); + if (claimed.Add(sanitized)) return; + var candidate = $"{prefix}{sanitized}"; + if (!claimed.Add(candidate)) { + var i = 2; + while (!claimed.Add($"{candidate}_{i}")) i++; + candidate = $"{candidate}_{i}"; + } + renames[decl] = candidate; + } + private void AddUniqueConst(Type t, string name) { if (!_uniqueConstants.TryGetValue(t, out var value)) { value = new HashSet(); @@ -299,6 +365,12 @@ private string Name(string name) { return SanitizeNameForStrata(name); } + private string NameOf(Declaration decl, string originalName) { + if (_renames.TryGetValue(decl, out var renamed)) + return renamed; + return SanitizeNameForStrata(originalName); + } + private void WriteLine(string text) { _writer.WriteLine(text); } @@ -310,7 +382,10 @@ private void EmitOldExpr(Expr expr) { switch (expr) { case IdentifierExpr identExpr: WriteText("old "); - WriteText(Name(identExpr.Name)); + if (identExpr.Decl == null) + throw new StrataConversionException(identExpr.tok, + $"IdentifierExpr '{identExpr.Name}' has null Decl (expected non-null post-resolution)"); + WriteText(NameOf(identExpr.Decl, identExpr.Name)); break; case NAryExpr { Fun: MapSelect } mapSelect: WriteText("("); @@ -546,7 +621,10 @@ public override Expr VisitExpr(Expr node) { case LiteralExpr literalExpr: throw new StrataConversionException(node.tok, $"Unsupported literal type: {literalExpr}"); case IdentifierExpr identifierExpr: - WriteText(Name(identifierExpr.Name)); + if (identifierExpr.Decl == null) + throw new StrataConversionException(identifierExpr.tok, + $"IdentifierExpr '{identifierExpr.Name}' has null Decl (expected non-null post-resolution)"); + WriteText(NameOf(identifierExpr.Decl, identifierExpr.Name)); break; case NAryExpr nAryExpr: { var fun = nAryExpr.Fun; @@ -634,7 +712,7 @@ public override Expr VisitExpr(Expr node) { break; case FunctionCall functionCall: { - WriteText($"{Name(functionCall.FunctionName)}("); + WriteText($"{NameOf(functionCall.Func, functionCall.FunctionName)}("); EmitSeparated(args, e => VisitExpr(e), ", "); WriteText(")"); break; @@ -918,7 +996,7 @@ public override GotoCmd VisitGotoCmd(GotoCmd node) { private void EmitSimpleAssign(SimpleAssignLhs lhs, Expr rhs) { Indent(); - WriteText($"{Name(lhs.AssignedVariable.Name)} := "); + WriteText($"{NameOf(lhs.AssignedVariable.Decl, lhs.AssignedVariable.Name)} := "); VisitExpr(rhs); WriteLine(";"); } @@ -953,17 +1031,17 @@ public override Cmd VisitCallCmd(CallCmd node) { var modifiesNames = new HashSet(callee.Modifies.Select(m => m.Name)); Indent("call "); - WriteText($"{Name(callee.Name)}("); + WriteText($"{NameOf(callee, callee.Name)}("); // Emit: inout globals, then read-only globals, then original args, then out outputs. var needComma = false; foreach (var g in _globalVariables.Where(g => modifiesNames.Contains(g.Name))) { if (needComma) WriteText(", "); - WriteText($"inout {Name(g.Name)}"); + WriteText($"inout {NameOf(g, g.Name)}"); needComma = true; } foreach (var g in _globalVariables.Where(g => !modifiesNames.Contains(g.Name))) { if (needComma) WriteText(", "); - WriteText(Name(g.Name)); + WriteText(NameOf(g, g.Name)); needComma = true; } foreach (var arg in node.Ins) { @@ -983,7 +1061,7 @@ public override Cmd VisitCallCmd(CallCmd node) { public override Cmd VisitHavocCmd(HavocCmd node) { foreach (var x in node.Vars) { - IndentLine($"havoc {Name(x.Name)};"); + IndentLine($"havoc {NameOf(x.Decl, x.Name)};"); } // All assumptions come after all havocs! This allows where clauses @@ -1510,7 +1588,7 @@ public override Block VisitBlock(Block node) { public override Constant VisitConstant(Constant node) { var ti = node.TypedIdent; - var name = Name(ti.Name); + var name = NameOf(node, ti.Name); WriteText($"const {name} : "); VisitType(ti.Type); if (node.Unique) { @@ -1523,7 +1601,7 @@ public override Constant VisitConstant(Constant node) { public override GlobalVariable VisitGlobalVariable(GlobalVariable node) { var ti = node.TypedIdent; - WriteText($"var {Name(ti.Name)} : "); + WriteText($"var {NameOf(node, ti.Name)} : "); VisitType(ti.Type); WriteLine(";"); return node; @@ -1681,7 +1759,7 @@ private void MaybeEmitBuiltinBody(Function function) { } public override Function VisitFunction(Function node) { - WriteText($"function {Name(node.Name)}"); + WriteText($"function {NameOf(node, node.Name)}"); EmitTypeParameters(node.TypeParameters); WriteText("("); WriteFormals(node.InParams); @@ -1723,7 +1801,7 @@ private void WriteProcedureHeader(Procedure proc) { var modifiesGlobals = _globalVariables.Where(g => modifiesNames.Contains(g.Name)).ToList(); var readOnlyGlobals = _globalVariables.Where(g => !modifiesNames.Contains(g.Name)).ToList(); - WriteText($"procedure {Name(proc.Name)}"); + WriteText($"procedure {NameOf(proc, proc.Name)}"); EmitTypeParameters(proc.TypeParameters); WriteText("("); // Emit: inout globals, then read-only globals, then original inputs, then out outputs. @@ -1772,9 +1850,36 @@ private void WriteProcedureHeader(Procedure proc) { public override Procedure VisitProcedure(Procedure node) { if (!_program.Implementations.Any(i => i.Name.Equals(node.Name))) { - WriteProcedureHeader(node); - WriteLine(";"); - WriteLine(); + // Under --smack, SMACK encodes C assert(expr) as a call to + // assert_.*(cond). Inject a synthetic requires precondition so the + // call-elimination pass generates a VC checking the condition is + // non-zero. We add it to node.Requires so WriteProcedureHeader + // emits it inside a single spec block alongside any existing + // specs. The injection always fires when the name pattern matches + // (no Requires.Count == 0 guard) — if the procedure already has a + // hand-written requires, both clauses appear in the merged spec + // block, preserving the SMACK invariant unconditionally. + Requires? syntheticReq = null; + if (_smack && node.Name.StartsWith("assert_.") && node.InParams.Count > 0) { + var param = node.InParams[0]; + var paramExpr = new IdentifierExpr(param.tok, param); + var zero = new LiteralExpr(param.tok, Microsoft.BaseTypes.BigNum.FromInt(0)); + var neqExpr = Expr.Neq(paramExpr, zero); + syntheticReq = new Requires(false, neqExpr); + node.Requires.Add(syntheticReq); + } + + try { + WriteProcedureHeader(node); + WriteLine(";"); + WriteLine(); + } finally { + // Remove the synthetic requires to avoid mutating the shared + // AST, even if WriteProcedureHeader threw. + if (syntheticReq != null) { + node.Requires.Remove(syntheticReq); + } + } } return node; @@ -1787,7 +1892,7 @@ private void WriteFormals(IEnumerable variables, ref bool needComma, if (needComma) WriteText(", "); var name = v.TypedIdent.Name ?? ""; if (name == "") name = $"x{n++}"; - WriteText($"{prefix}{Name(name)} : "); + WriteText($"{prefix}{NameOf(v, name)} : "); VisitType(v.TypedIdent.Type); needComma = true; } diff --git a/Tools/BoogieToStrata/Tests/AssertPrefixFalsePositive.bpl b/Tools/BoogieToStrata/Tests/AssertPrefixFalsePositive.bpl new file mode 100644 index 0000000000..50bdf5579f --- /dev/null +++ b/Tools/BoogieToStrata/Tests/AssertPrefixFalsePositive.bpl @@ -0,0 +1,12 @@ +// {:smack} +// Regression test: procedures starting with "assert_" but NOT matching +// SMACK's assert_.TYPE pattern should NOT get a synthetic requires. +// Only assert_. (literal dot) is the SMACK pattern. + +procedure assert_helper(p: int) returns (r: int); + +procedure main() returns (r: int) +{ + // assert_helper is a normal procedure, passing 0 should be fine + call r := assert_helper(0); +} diff --git a/Tools/BoogieToStrata/Tests/AssertPrefixFalsePositive.expect b/Tools/BoogieToStrata/Tests/AssertPrefixFalsePositive.expect new file mode 100644 index 0000000000..e9e8e85d9e --- /dev/null +++ b/Tools/BoogieToStrata/Tests/AssertPrefixFalsePositive.expect @@ -0,0 +1,2 @@ +Successfully parsed. +All 0 goals passed. diff --git a/Tools/BoogieToStrata/Tests/GlobalVarRenameCollision.bpl b/Tools/BoogieToStrata/Tests/GlobalVarRenameCollision.bpl new file mode 100644 index 0000000000..5a1275cbff --- /dev/null +++ b/Tools/BoogieToStrata/Tests/GlobalVarRenameCollision.bpl @@ -0,0 +1,9 @@ +const $a.b: int; axiom $a.b > 0; +var $a_b: int; // both sanitize to _a_b +procedure main() returns (r: int) + modifies $a_b; +{ + $a_b := 1; + havoc $a_b; + r := $a.b + $a_b; +} diff --git a/Tools/BoogieToStrata/Tests/GlobalVarRenameCollision.expect b/Tools/BoogieToStrata/Tests/GlobalVarRenameCollision.expect new file mode 100644 index 0000000000..e9e8e85d9e --- /dev/null +++ b/Tools/BoogieToStrata/Tests/GlobalVarRenameCollision.expect @@ -0,0 +1,2 @@ +Successfully parsed. +All 0 goals passed. diff --git a/Tools/BoogieToStrata/Tests/InferModifiesGlobal.bpl b/Tools/BoogieToStrata/Tests/InferModifiesGlobal.bpl new file mode 100644 index 0000000000..0767f22518 --- /dev/null +++ b/Tools/BoogieToStrata/Tests/InferModifiesGlobal.bpl @@ -0,0 +1,17 @@ +// {:smack} +// Regression test for InferModifies = true. +// +// This procedure mutates the global variable `g` but has NO explicit +// `modifies g;` clause. With InferModifies = true, Boogie's +// ModSetCollector should infer the modifies clause so that the +// BoogieToStrata translator emits `inout g` for procedure p. +// If InferModifies is ever disabled or broken, this file will fail +// to translate correctly (g would be treated as read-only instead +// of inout). + +var g: int; + +procedure p() +{ + g := 1; +} diff --git a/Tools/BoogieToStrata/Tests/InferModifiesGlobal.expect b/Tools/BoogieToStrata/Tests/InferModifiesGlobal.expect new file mode 100644 index 0000000000..e9e8e85d9e --- /dev/null +++ b/Tools/BoogieToStrata/Tests/InferModifiesGlobal.expect @@ -0,0 +1,2 @@ +Successfully parsed. +All 0 goals passed. diff --git a/Tools/BoogieToStrata/Tests/NamespaceCollision.bpl b/Tools/BoogieToStrata/Tests/NamespaceCollision.bpl new file mode 100644 index 0000000000..caedc2c08a --- /dev/null +++ b/Tools/BoogieToStrata/Tests/NamespaceCollision.bpl @@ -0,0 +1,25 @@ +// Minimal reproduction: namespace collision bug in BoogieToStrata. +// Boogie allows a constant and procedure to share the same name +// because they live in separate namespaces. BoogieToStrata emits +// both into Strata Core's single namespace, causing: +// "a declaration of this name already exists" + +type ref = int; + +const main: ref; +axiom (main == 1000); + +var x: int; + +procedure main() + modifies x; +{ + var y: int; + x := 42; + assert x == 42; + // Use the constant in an expression that doesn't require the axiom to verify + y := 0; + if (main == 1000) { y := 1; } + // This assertion is trivially true regardless of the axiom + assert y == 0 || y == 1; +} diff --git a/Tools/BoogieToStrata/Tests/NamespaceCollision.expect b/Tools/BoogieToStrata/Tests/NamespaceCollision.expect new file mode 100644 index 0000000000..c2c458ba8c --- /dev/null +++ b/Tools/BoogieToStrata/Tests/NamespaceCollision.expect @@ -0,0 +1,4 @@ +Successfully parsed. +NamespaceCollision.core.st(23, 4) [assert_0]: ✅ pass +NamespaceCollision.core.st(33, 4) [assert_1]: ✅ pass +All 2 goals passed. diff --git a/Tools/BoogieToStrata/Tests/OldExprRenameCollision.bpl b/Tools/BoogieToStrata/Tests/OldExprRenameCollision.bpl new file mode 100644 index 0000000000..7494acd002 --- /dev/null +++ b/Tools/BoogieToStrata/Tests/OldExprRenameCollision.bpl @@ -0,0 +1,17 @@ +// Regression test: old() expression with a renamed (colliding) variable. +// +// The global variable `main` collides with procedure `main` after +// sanitization (cross-namespace collision). The variable must be +// renamed when emitted. An old() expression referencing that variable +// must use the *renamed* name, not the raw sanitized name. +// If the code silently falls back to Name() instead of NameOf(), the +// old() expression will reference the wrong (procedure) name. + +var main: int; + +procedure main() + modifies main; + ensures main == old(main) + 1; +{ + main := main + 1; +} diff --git a/Tools/BoogieToStrata/Tests/OldExprRenameCollision.expect b/Tools/BoogieToStrata/Tests/OldExprRenameCollision.expect new file mode 100644 index 0000000000..98a3632dbf --- /dev/null +++ b/Tools/BoogieToStrata/Tests/OldExprRenameCollision.expect @@ -0,0 +1,3 @@ +Successfully parsed. +OldExprRenameCollision.core.st(10, 2) [main_ensures_0]: ✅ pass +All 1 goals passed. diff --git a/Tools/BoogieToStrata/Tests/SanitizationCollision.bpl b/Tools/BoogieToStrata/Tests/SanitizationCollision.bpl new file mode 100644 index 0000000000..7a4f339a01 --- /dev/null +++ b/Tools/BoogieToStrata/Tests/SanitizationCollision.bpl @@ -0,0 +1,25 @@ +// Test case: sanitization collision in BoogieToStrata. +// +// SanitizeNameForStrata replaces '.', '$', '@', '#', '^' with '_'. +// This means distinct Boogie identifiers can map to the same Strata name: +// $add.i32 → _add_i32 +// $add_i32 → _add_i32 (collision!) +// +// The rename mechanism should detect this and disambiguate. + +type i32 = int; + +function {:inline} $add.i32(i1: i32, i2: i32) returns (i32) { i1 + i2 } +function {:inline} $add_i32(i1: i32, i2: i32) returns (i32) { i1 + i2 } + +procedure main() returns (r: i32) +ensures r == 5; +{ + var a: i32; + var b: i32; + a := $add.i32(2, 3); + b := $add_i32(2, 3); + assert a == 5; + assert b == 5; + r := a; +} diff --git a/Tools/BoogieToStrata/Tests/SanitizationCollision.expect b/Tools/BoogieToStrata/Tests/SanitizationCollision.expect new file mode 100644 index 0000000000..d7e99638ef --- /dev/null +++ b/Tools/BoogieToStrata/Tests/SanitizationCollision.expect @@ -0,0 +1,5 @@ +Successfully parsed. +SanitizationCollision.core.st(29, 4) [assert_0]: ✅ pass +SanitizationCollision.core.st(30, 4) [assert_1]: ✅ pass +SanitizationCollision.core.st(21, 2) [main_ensures_0]: ✅ pass +All 3 goals passed. diff --git a/Tools/BoogieToStrata/Tests/SmackAssert.bpl b/Tools/BoogieToStrata/Tests/SmackAssert.bpl new file mode 100644 index 0000000000..5094a86704 --- /dev/null +++ b/Tools/BoogieToStrata/Tests/SmackAssert.bpl @@ -0,0 +1,18 @@ +// {:smack} +// Minimal test case for SMACK assert_ pattern recognition. +// SMACK encodes C assert(expr) as a call to assert_.i32(cond). +// BoogieToStrata should recognize this pattern and emit: +// assert (cond != 0); +// instead of an opaque procedure call. + +type i32 = int; + +procedure assert_.i32(p.0: i32) returns ($r: i32); + +procedure main() returns ($r: i32) +{ + // assert(false) — should fail verification + call $r := assert_.i32(0); + $r := 0; + return; +} diff --git a/Tools/BoogieToStrata/Tests/SmackAssert.expect b/Tools/BoogieToStrata/Tests/SmackAssert.expect new file mode 100644 index 0000000000..8af84c0bbc --- /dev/null +++ b/Tools/BoogieToStrata/Tests/SmackAssert.expect @@ -0,0 +1,3 @@ +Successfully parsed. +SmackAssert.core.st(21, 6) [callElimAssert_assert__i32_requires_0_2]: ❌ fail +Finished with 0 goals passed, 1 failed. diff --git a/Tools/BoogieToStrata/Tests/SmackAssertDuplicateSpec.bpl b/Tools/BoogieToStrata/Tests/SmackAssertDuplicateSpec.bpl new file mode 100644 index 0000000000..3f3d49bce3 --- /dev/null +++ b/Tools/BoogieToStrata/Tests/SmackAssertDuplicateSpec.bpl @@ -0,0 +1,30 @@ +// {:smack} +// Regression test: assert_. procedures must produce a single +// merged spec block, not duplicates, regardless of whether the input +// already has user-written specs. +// +// Two procedures exercise the two cases: +// 1. assert_.i32 has only an existing `ensures` — output must merge +// the synthetic `requires (p.0 != 0)` with the existing ensures +// into one spec block. +// 2. assert_.i32_with_req has an existing `requires (p.0 > -1)` — +// output must contain BOTH requires clauses (the synthetic one +// and the user-written one) in a single spec block, not drop the +// synthetic one. + +type i32 = int; + +procedure assert_.i32(p.0: i32) returns ($r: i32); + ensures ($r == 0); + +procedure assert_.i32_with_req(p.0: i32) returns ($r: i32); + requires (p.0 > -1); + +procedure main() returns ($r: i32) +{ + // assert(true) -- should pass because p.0 != 0 holds for 1 + call $r := assert_.i32(1); + // call assert_.i32_with_req(1) — both `1 != 0` and `1 > -1` hold + call $r := assert_.i32_with_req(1); + return; +} diff --git a/Tools/BoogieToStrata/Tests/TypeSynonymChain.bpl b/Tools/BoogieToStrata/Tests/TypeSynonymChain.bpl new file mode 100644 index 0000000000..cc5811b580 --- /dev/null +++ b/Tools/BoogieToStrata/Tests/TypeSynonymChain.bpl @@ -0,0 +1,20 @@ +// Regression test for multi-level type synonym resolution. +// dealiasTypeExpr must recurse through: ref → i64 → int +// Without recursive resolution, comparison and arithmetic on `ref` +// trigger a panic because the type stays as a synonym instead of +// resolving to the base `int` type. + +type i64 = int; +type ref = i64; + +procedure main() returns (r: ref) +ensures r >= 0; +{ + var a: ref; + var b: ref; + a := 3; + b := a + 4; + assert b == 7; + assert a <= b; + r := b; +} diff --git a/Tools/BoogieToStrata/Tests/TypeSynonymChain.expect b/Tools/BoogieToStrata/Tests/TypeSynonymChain.expect new file mode 100644 index 0000000000..197fd783cb --- /dev/null +++ b/Tools/BoogieToStrata/Tests/TypeSynonymChain.expect @@ -0,0 +1,5 @@ +Successfully parsed. +TypeSynonymChain.core.st(22, 4) [assert_0]: ✅ pass +TypeSynonymChain.core.st(23, 4) [assert_1]: ✅ pass +TypeSynonymChain.core.st(14, 2) [main_ensures_0]: ✅ pass +All 3 goals passed. From 7b72423c4e486506aed5fc82d1ff959df2a4860a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mika=C3=ABl=20Mayer?= Date: Wed, 20 May 2026 10:23:00 -0500 Subject: [PATCH 21/28] Parallel solving (#1046) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes #1045 ## Summary Adds a `--parallel N` flag that runs up to N solver instances concurrently when verifying proof obligations. Without the flag (or with `--parallel 1`), behavior is unchanged (sequential). ## Problem Verification of programs with many obligations is bottlenecked by sequential solver invocations. Each obligation spawns a separate solver process, waits for the result, then moves to the next. ## Solution When `--parallel N` is specified (N > 1), the verification pipeline splits into two phases: 1. **Sequential preprocessing** (fast): determine checks, preprocess obligations, encode to SMT terms. Obligations resolved by the evaluator are handled immediately. 2. **Parallel solver dispatch** (slow): obligations that need the solver are placed in a shared queue. N worker tasks (on dedicated threads) continuously pull from the queue — when a solver finishes, it immediately picks up the next unsolved obligation. Results are collected in original obligation order so output is deterministic. The worker pool design avoids the "wait for slowest in batch" bottleneck: if one obligation takes 10s and others take 1s, the fast-finishing workers immediately start on the next obligation instead of idling. `stopOnFirstError` is supported via a shared flag: on failure, workers stop claiming new jobs. Already-running jobs complete naturally; skipped jobs leave their placeholder results in place. Both the incremental and batch solver paths are safe for parallel use: the incremental backend spawns independent solver processes, and the batch path uses atomic `modifyGet` for filename counter generation. **Pluggable discharge function**: The full public API (`Strata.verify`, `Core.verify`, `verifySingleEnv`, `mkDefaultCoreSMTSolver`) accepts a `mkDischarge : MkDischargeFn` parameter (defaulting to `mkDischargeFn`). External solvers (e.g. using the AbstractSolver API) can provide their own discharge function factory. ## Performance Benchmark: 30 obligations across 2 programs, z3 4.12.2, avg over 3 runs: | Mode | Time | Speedup | |------|------|---------| | `--parallel 1` (sequential) | 921ms | baseline | | `--parallel 2` | 491ms | **1.88x** | | `--parallel 3` | 405ms | **2.27x** | | `--parallel 4` | 356ms | **2.59x** | Sweet spot is `--parallel 3-4`. The 1→2 jump gives the biggest single improvement (1.88x), then diminishing returns as solver spawn overhead and sequential preprocessing become the bottleneck. ## Testing All tests that pass without `--parallel` also pass with it. The sequential path (`--parallel 1`, the default) is unchanged. --- Strata/Languages/Core/Options.lean | 5 + Strata/Languages/Core/Verifier.lean | 155 ++++++++++++++++++++++++---- StrataMainLib.lean | 14 ++- 3 files changed, 151 insertions(+), 23 deletions(-) diff --git a/Strata/Languages/Core/Options.lean b/Strata/Languages/Core/Options.lean index 1ae64192f8..3512de72b9 100644 --- a/Strata/Languages/Core/Options.lean +++ b/Strata/Languages/Core/Options.lean @@ -201,6 +201,10 @@ structure VerifyOptions where batch pipeline (write file, run solver). Opt-in via `--incremental`; disabled automatically with `--no-solve`. -/ incremental : Bool + /-- Number of parallel solver workers. When > 1, obligations are dispatched + to concurrent solver processes using `IO.asTask`. Each task spawns its + own solver instance. Default 1 (sequential). -/ + parallelWorkers : Nat def VerifyOptions.default : VerifyOptions := { verbose := .normal, @@ -222,6 +226,7 @@ def VerifyOptions.default : VerifyOptions := { profile := false incremental := false pathCap := .none + parallelWorkers := 1 } instance : Inhabited VerifyOptions where diff --git a/Strata/Languages/Core/Verifier.lean b/Strata/Languages/Core/Verifier.lean index 53a8259b8a..26e50d2c7d 100644 --- a/Strata/Languages/Core/Verifier.lean +++ b/Strata/Languages/Core/Verifier.lean @@ -1395,6 +1395,91 @@ def getObligationResult (assumptionTerms : List Term) (obligationTerm : Term) lexprModel := model } return result +/-- Data needed to dispatch a single obligation to the solver. Produced by the + sequential preprocessing phase and consumed by the (potentially parallel) + solver dispatch phase. -/ +private structure SolverJob where + obligation : ProofObligation Expression + assumptionTerms : List Term + obligationTerm : Term + ctx : SMT.Context + needSatCheck : Bool + needValCheck : Bool + peSatResult? : Option SMT.Result + peValResult? : Option SMT.Result + typedVarsInObligation : List Expression.TypedIdent + varDefs : List VarDefinition := [] + varDecls : List VarDeclaration := [] + +/-- Dispatch a single solver job. Spawns a solver process and reads the result. -/ +private def dispatchSolverJob (job : SolverJob) (p : Program) + (options : VerifyOptions) (counter : IO.Ref Nat) (tempDir : System.FilePath) + (phases : List AbstractedPhase) + (mkDischarge : MkDischargeFn := mkDischargeFn) + (pctx : PipelineContext) + : IO (Except DiagnosticModel VCResult) := do + let discharge := mkDischarge options counter tempDir + job.typedVarsInObligation job.obligation.metadata job.obligation.label pctx + let resultOrErr ← (getObligationResult job.assumptionTerms job.obligationTerm job.ctx + job.obligation p options discharge job.needSatCheck job.needValCheck phases + (varDefinitions := job.varDefs) (varDeclarations := job.varDecls)).toBaseIO + match resultOrErr with + | .error diag => return .error diag + | .ok result => + let result := match result.outcome with + | .ok solverOutcome => + let satResult := job.peSatResult?.getD solverOutcome.satisfiabilityProperty + let valResult := job.peValResult?.getD solverOutcome.validityProperty + { result with outcome := .ok { solverOutcome with + satisfiabilityProperty := satResult, + validityProperty := valResult } } + | .error _ => result + return .ok result + +/-- Dispatch solver jobs using a bounded worker pool. Workers pull from a shared + queue; results returned in original order. -/ +private def dispatchJobsParallel (jobs : List SolverJob) (p : Program) + (options : VerifyOptions) (counter : IO.Ref Nat) (tempDir : System.FilePath) + (phases : List AbstractedPhase) (workers : Nat) + (mkDischarge : MkDischargeFn := mkDischargeFn) + (pctx : PipelineContext) + : IO (List (Option (Except DiagnosticModel VCResult))) := do + let queue ← IO.mkRef (jobs.zipIdx : List (SolverJob × Nat)) + let resultMap ← IO.mkRef ({} : Std.HashMap Nat (Except DiagnosticModel VCResult)) + let shouldStop ← IO.mkRef false + let workerFn : IO Unit := do + let mut running := true + while running do + if ← shouldStop.get then break + let entry ← queue.modifyGet fun q => + match q with + | [] => (none, []) + | hd :: tl => (some hd, tl) + match entry with + | none => running := false + | some (job, idx) => + let result ← dispatchSolverJob job p options counter tempDir phases mkDischarge pctx + resultMap.modify (·.insert idx result) + if options.stopOnFirstError then + match result with + | .ok r => if r.isNotSuccess then shouldStop.set true + | .error _ => shouldStop.set true + let numWorkers := min workers jobs.length + let workerTasks ← (List.range numWorkers).mapM fun _ => + IO.asTask (prio := .dedicated) workerFn + -- Join all tasks before throwing to prevent orphaned processes + let mut firstError : Option IO.Error := none + for task in workerTasks do + match task.get with + | .ok () => pure () + | .error e => if firstError.isNone then firstError := some e + if let some e := firstError then throw e + let rmap ← resultMap.get + let mut results : List (Option (Except DiagnosticModel VCResult)) := [] + for idx in (List.range jobs.length).reverse do + results := rmap[idx]? :: results + return results + private def verifySingleEnv (oblProgram : Program) (moreFns : @Lambda.Factory CoreLParams := Lambda.Factory.default) @@ -1422,6 +1507,9 @@ def verifySingleEnv (oblProgram : Program) let mut stats : Statistics := ({} : Statistics) |>.increment s!"{Evaluator.Stats.verify_numObligations}" obligations.size let mut results := (#[] : VCResults) + let mut solverJobs : List SolverJob := [] + let mut solverJobIndices : List Nat := [] + let useParallel := options.parallelWorkers > 1 for obligation in obligations do -- Determine which checks to perform based on metadata or check mode/amount let (satisfiabilityCheck, validityCheck) := @@ -1489,27 +1577,52 @@ def verifySingleEnv (oblProgram : Program) match ty with | .some ty => return (v,LTy.forAll [] ty) | .none => throw (DiagnosticModel.fromMessage s!"{v} untyped")) - let discharge := mkDischarge options counter tempDir - typedVarsInObligation obligation.metadata obligation.label pctx - let result ← pctx.withRepeatedPhase "solver" do - getObligationResult assumptionTerms obligationTerm ctx obligation p options - discharge needSatCheck needValCheck (externalPhases ++ corePhases) - (varDefinitions := varDefs) (varDeclarations := varDecls) - -- Merge evaluator results with solver results - let result := match result.outcome with - | .ok solverOutcome => - let satResult := peSatResult?.getD solverOutcome.satisfiabilityProperty - let valResult := peValResult?.getD solverOutcome.validityProperty - { result with outcome := .ok { solverOutcome with - satisfiabilityProperty := satResult, - validityProperty := valResult } } - | .error _ => result - results := results.push result - if result.isNotSuccess then - if options.verbose >= .debug then - let prog := f!"\n\n[DEBUG] Evaluated program:\n{Core.formatProgram p}" - dbg_trace f!"\n\nResult: {result}\n{prog}" - if options.stopOnFirstError then break + if useParallel then + let job : SolverJob := { + obligation, assumptionTerms, obligationTerm, ctx, + needSatCheck, needValCheck, peSatResult?, peValResult?, + typedVarsInObligation, varDefs, varDecls } + solverJobs := job :: solverJobs + solverJobIndices := results.size :: solverJobIndices + results := results.push { obligation, outcome := .error (.encoding "pending parallel dispatch"), + verbose := options.verbose, checkLevel := options.checkLevel, + checkMode := options.checkMode, lexprModel := [] } + else + let discharge := mkDischarge options counter tempDir + typedVarsInObligation obligation.metadata obligation.label pctx + let result ← pctx.withRepeatedPhase "solver" do + getObligationResult assumptionTerms obligationTerm ctx obligation p options + discharge needSatCheck needValCheck (externalPhases ++ corePhases) + (varDefinitions := varDefs) (varDeclarations := varDecls) + -- Merge evaluator results with solver results + let result := match result.outcome with + | .ok solverOutcome => + let satResult := peSatResult?.getD solverOutcome.satisfiabilityProperty + let valResult := peValResult?.getD solverOutcome.validityProperty + { result with outcome := .ok { solverOutcome with + satisfiabilityProperty := satResult, + validityProperty := valResult } } + | .error _ => result + results := results.push result + if result.isNotSuccess then + if options.verbose >= .debug then + let prog := f!"\n\n[DEBUG] Evaluated program:\n{Core.formatProgram p}" + dbg_trace f!"\n\nResult: {result}\n{prog}" + if options.stopOnFirstError then break + -- Phase 2: Parallel solver dispatch + if useParallel && !solverJobs.isEmpty then + let phases := externalPhases ++ corePhases + let jobResults ← IO.toEIO (fun e => DiagnosticModel.fromFormat f!"{e}") + (dispatchJobsParallel solverJobs.reverse p options counter tempDir phases options.parallelWorkers mkDischarge pctx) + let mut firstError : Option DiagnosticModel := none + for (jobResult?, jobIdx) in jobResults.zip solverJobIndices.reverse do + match jobResult? with + | some (.ok result) => + results := results.setIfInBounds jobIdx result + | some (.error diag) => + if firstError.isNone then firstError := some diag + | none => pure () + if let some diag := firstError then throw diag return (results, stats) /-- Construct the default `CoreSMTSolver` that discharges obligations diff --git a/StrataMainLib.lean b/StrataMainLib.lean index 6d2c51b501..2ca6c87ba2 100644 --- a/StrataMainLib.lean +++ b/StrataMainLib.lean @@ -210,7 +210,10 @@ def verifyOptionsFlags : List Flag := [ help := "Use incremental solver backend (stdin/stdout) instead of batch file I/O." }, { name := "path-cap", help := "Maximum continuing paths between statements. 'none' (default) disables; N merges paths when count exceeds N.", - takesArg := .arg "N|none" } + takesArg := .arg "N|none" }, + { name := "parallel", + help := "Number of parallel solver workers (default: 1, sequential).", + takesArg := .arg "N" } ] /-- Build a VerifyOptions from parsed CLI flags, starting from a base config. @@ -250,6 +253,12 @@ def parseVerifyOptions (pflags : ParsedFlags) | .some n => if n == 0 then exitFailure "--path-cap must be at least 1 or 'none'." else pure (.some n) | .none => exitFailure s!"Invalid path-cap: '{s}'. Must be a positive number or 'none'." + let parallelWorkers ← match pflags.getString "parallel" with + | .none => pure base.parallelWorkers + | .some s => match s.toNat? with + | .some n => if n == 0 then exitFailure "--parallel must be at least 1." + else pure n + | .none => exitFailure s!"Invalid parallel workers: '{s}'. Must be a positive number." let vcDirectory := (pflags.getString "vc-directory" |>.map (⟨·⟩ : String → System.FilePath)).orElse (fun _ => base.vcDirectory) let skipSolver := noSolve || base.skipSolver if skipSolver && vcDirectory.isNone then @@ -272,7 +281,8 @@ def parseVerifyOptions (pflags : ParsedFlags) alwaysGenerateSMT := noSolve || base.alwaysGenerateSMT, overflowChecks, vcDirectory, - pathCap + pathCap, + parallelWorkers } /-- Additional CLI flags for `LaurelVerifyOptions` fields that are not already From 4693781bacdb1bb3dfae27ba77feb67194d449c2 Mon Sep 17 00:00:00 2001 From: Michael Tautschnig Date: Wed, 20 May 2026 18:53:35 +0200 Subject: [PATCH 22/28] Fix multi-output calls in expression position (Python front-end) (#1117) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When translateExpr produces an expression containing a nested multi-output procedure call (e.g., PSub(base, timedelta_func(...))), the new extractMultiOutputCalls pass in translateAssign rewrites it into a preceding multi-target assignment and a variable reference: var $mo_N := ...; assign $mo_N, maybe_except := timedelta_func(...); delta := PSub(base, $mo_N) This prevents multi-output calls from appearing in expression position, which would silently discard the error channel. Key design choices: - Counter seeded from source byte offset for globally unique temp variable names - Branch-local multi-output calls are wrapped in Block nodes inside their respective IfThenElse branches (not hoisted unconditionally) - Generated wrapper statements propagate source metadata from the original call - Block-flattening in the lifter uses cons-based prepend for correct evaluation order - containsBareAssignment skips Blocks so generated wrappers pass through assert/assume handlers - extractMultiOutputCalls uses structural recursion (attach) rather than partial Tested: existing tests pass, builds cleanly. Co-authored-by: Kiro By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: Kiro Co-authored-by: Mikaël Mayer Co-authored-by: Copilot Autofix powered by AI <175728472+Copilot@users.noreply.github.com> Co-authored-by: Mikael Mayer --- .../Laurel/LiftImperativeExpressions.lean | 55 +++++++- Strata/Languages/Python/PythonToLaurel.lean | 128 ++++++++++++++++-- .../test_procedure_in_assert.expected | 17 +-- .../Python/tests/test_procedure_in_assert.py | 6 +- 4 files changed, 173 insertions(+), 33 deletions(-) diff --git a/Strata/Languages/Laurel/LiftImperativeExpressions.lean b/Strata/Languages/Laurel/LiftImperativeExpressions.lean index 7c63b6870f..e87b24d480 100644 --- a/Strata/Languages/Laurel/LiftImperativeExpressions.lean +++ b/Strata/Languages/Laurel/LiftImperativeExpressions.lean @@ -174,6 +174,24 @@ def containsAssignment (expr : StmtExprMd) : Bool := decreasing_by all_goals ((try cases x); simp_all; try term_by_mem) +/-- Like containsAssignment but does NOT recurse into Blocks (treats them as opaque). + Used by assert/assume handlers to allow generated Block wrappers through. -/ +def containsBareAssignment (expr : StmtExprMd) : Bool := + match expr with + | AstNode.mk val _ => + match val with + | .Assign .. => true + | .StaticCall _ args => args.attach.any (fun x => containsBareAssignment x.val) + | .PrimitiveOp _ args => args.attach.any (fun x => containsBareAssignment x.val) + | .Block _ _ => false + | .IfThenElse cond th el => + containsBareAssignment cond || containsBareAssignment th || + match el with | some e => containsBareAssignment e | none => false + | _ => false + termination_by expr + decreasing_by + all_goals ((try cases x); simp_all; try term_by_mem) + /-- Check if an expression contains any non-functional procedure calls (recursively). -/ def containsImperativeCall (model : SemanticModel) (expr : StmtExprMd) : Bool := match expr with @@ -345,7 +363,30 @@ def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do | .Block stmts labelOption => let newStmts := (← stmts.reverse.mapM transformExpr).reverse - return ⟨ .Block (← onlyKeepSideEffectStmtsAndLast newStmts) labelOption, source⟩ + -- Flatten generated multi-output call wrappers BEFORE onlyKeepSideEffectStmtsAndLast + -- which would drop the multi-target assign. Pattern: [VarDecl, MultiAssign, VarRef]. + match newStmts with + | [decl, assign, last] => + match decl.val, assign.val with + | .Assign [t] _, .Assign targets _ => + match t.val with + | .Declare _ => + if targets.length ≥ 2 then + prepend assign + prepend decl + return last + else + let filtered ← onlyKeepSideEffectStmtsAndLast newStmts + return ⟨ .Block filtered labelOption, source⟩ + | _ => + let filtered ← onlyKeepSideEffectStmtsAndLast newStmts + return ⟨ .Block filtered labelOption, source⟩ + | _, _ => + let filtered ← onlyKeepSideEffectStmtsAndLast newStmts + return ⟨ .Block filtered labelOption, source⟩ + | _ => + let filtered ← onlyKeepSideEffectStmtsAndLast newStmts + return ⟨ .Block filtered labelOption, source⟩ | .Var (.Declare param) => -- If the substitution map has an entry for this variable, it was @@ -372,9 +413,11 @@ def transformStmt (stmt : StmtExprMd) : LiftM (List StmtExprMd) := do | AstNode.mk val source => match val with | .Assert cond => - -- Do not transform assert conditions with assignments — they must be rejected. - -- But nondeterministic holes and imperative calls need to be lifted. - if !containsAssignment cond.condition then + -- Do not transform assert conditions with bare assignments — they are + -- semantic errors that should be rejected downstream. + -- But Blocks with assignments (generated multi-output call wrappers) + -- are handled by the Block case in transformExpr above. + if !containsBareAssignment cond.condition then let seqCond ← transformExpr cond.condition let prepends ← takePrepends modify fun s => { s with subst := [] } @@ -383,9 +426,7 @@ def transformStmt (stmt : StmtExprMd) : LiftM (List StmtExprMd) := do return [stmt] | .Assume cond => - -- Do not transform assume conditions with assignments — they must be rejected. - -- But nondeterministic holes and imperative calls need to be lifted. - if !containsAssignment cond then + if !containsBareAssignment cond then let seqCond ← transformExpr cond let prepends ← takePrepends modify fun s => { s with subst := [] } diff --git a/Strata/Languages/Python/PythonToLaurel.lean b/Strata/Languages/Python/PythonToLaurel.lean index c6e0dd3bfa..0c1a030899 100644 --- a/Strata/Languages/Python/PythonToLaurel.lean +++ b/Strata/Languages/Python/PythonToLaurel.lean @@ -1331,6 +1331,78 @@ def freeVarExpr (name: String) := mkStmtExprMd (.Var (.Local name)) def maybeExceptVar := freeVarMd "maybe_except" def nullcall_var := freeVarMd "nullcall_ret" +/-- Walk an expression tree and extract any nested multi-output procedure calls + into preceding multi-target assignments. Returns (preamble, rewritten expr). + Uses a mutable counter for unique variable names. -/ +def extractMultiOutputCalls (ctx : TranslationContext) (e : StmtExprMd) + : StateM Nat (List StmtExprMd × StmtExprMd) := do + match _h : e.val with + | .StaticCall callee args => + if withException ctx callee.text then + -- Multi-output call: extract into a temp assignment and add exception check + let n ← get + set (n + 1) + let varName := s!"$mo_{n}" + let varDecl := mkVarDeclInit varName AnyTy AnyNone + let assign := mkStmtExprMdWithLoc (StmtExpr.Assign + [mkVariableMd (.Local varName), maybeExceptVar] + (mkStmtExprMdWithLoc (.StaticCall callee args) e.source)) e.source + let varRef := mkStmtExprMdWithLoc (StmtExpr.Var (.Local varName)) e.source + return ([varDecl, assign], varRef) + else + -- Recurse into arguments + let results ← args.attach.mapM fun ⟨arg, _⟩ => extractMultiOutputCalls ctx arg + let preamble := (results.map (fun (pre, _) => pre)).flatten + let newArgs := results.map (·.2) + if preamble.isEmpty then + return ([], e) + else + return (preamble, mkStmtExprMdWithLoc (.StaticCall callee.text newArgs) e.source) + | .PrimitiveOp op args => + let results ← args.attach.mapM fun ⟨arg, _⟩ => extractMultiOutputCalls ctx arg + let preamble := (results.map (fun (pre, _) => pre)).flatten + let newArgs := results.map (·.2) + if preamble.isEmpty then + return ([], e) + else + return (preamble, mkStmtExprMdWithLoc (.PrimitiveOp op newArgs) e.source) + | .IfThenElse cond thenBr elseBr => + let (preCond, cond') ← extractMultiOutputCalls ctx cond + let (preThen, then') ← extractMultiOutputCalls ctx thenBr + let preElse ← elseBr.attach.mapM fun ⟨br, _⟩ => extractMultiOutputCalls ctx br + let thenExpr := + if preThen.isEmpty then + then' + else + mkStmtExprMdWithLoc (.Block (preThen ++ [then']) none) thenBr.source + let elseExpr := preElse.map fun (pre, else') => + if pre.isEmpty then + else' + else + mkStmtExprMdWithLoc (.Block (pre ++ [else']) none) else'.source + let anyRewrite := !preCond.isEmpty || !preThen.isEmpty || + preElse.any (fun (pre, _) => !pre.isEmpty) + if anyRewrite then + return (preCond, mkStmtExprMdWithLoc + (.IfThenElse cond' thenExpr elseExpr) e.source) + else + return ([], e) + | _ => return ([], e) +termination_by sizeOf e +decreasing_by + all_goals simp_wf + all_goals (try have := AstNode.sizeOf_val_lt e) + all_goals (try term_by_mem) + all_goals (cases e; simp_all; omega) + +/-- Translate an expression and extract any nested multi-output calls into + preceding statements. -/ +def translateExprExtractingCalls (ctx : TranslationContext) (e : Python.expr SourceRange) + (counter : Nat) : Except TranslationError (List StmtExprMd × StmtExprMd × Nat) := do + let expr ← translateExpr ctx e + let ((preamble, expr'), cnt) := (extractMultiOutputCalls ctx expr).run counter + return (preamble, expr', cnt) + partial def translateAssign (ctx : TranslationContext) (lhs: Python.expr SourceRange) (annotation: Option (Python.expr SourceRange) ) @@ -1366,7 +1438,18 @@ partial def translateAssign (ctx : TranslationContext) | .Attribute _ (.Name _ name _) _ _ => name.val == "self" && ctx.currentClassName.isSome | _ => false let rhsCtx := if isSelfFieldAssign then {ctx with suppressDispatch := true} else ctx - let rhs_trans ← translateExpr rhsCtx rhs + let extractionSeed := + if rhs.ann.isNone then + -- Fallback: hash the expression text to get a unique-enough seed + let text := pyExprToString lhs ++ " <- " ++ pyExprToString rhs + text.foldl (fun acc ch => acc * 131 + ch.toNat) 0 + else + -- Use byte offset directly — globally unique per source position + rhs.ann.start.byteIdx + let (moExtracts, rhs_trans, _) ← translateExprExtractingCalls rhsCtx rhs extractionSeed + -- Use the statement's source location for extracted assignments so that + -- diagnostics (e.g. requires checks) report the statement position. + let moExtracts := moExtracts.map fun s => ⟨s.val, source⟩ -- When an unmodeled call produces a Hole, also havoc maybe_except since -- the call is a black box that could throw any exception. let rhsIsCall := match rhs with | .Call _ _ _ _ => true | _ => false @@ -1434,7 +1517,7 @@ partial def translateAssign (ctx : TranslationContext) {newctx with variableTypes:= newctx.variableTypes ++ [(n.val, className.text)]} | _=> newctx if n.val ∈ newctx.variableTypes.unzip.1 then - return (newctx, assignStmts, true) + return (newctx, moExtracts ++ assignStmts, true) else let inferType ← inferExprType ctx rhs let type := match annotation with @@ -1446,7 +1529,7 @@ partial def translateAssign (ctx : TranslationContext) if isKnownType ctx annStr then annStr else inferType let initStmt := mkVarDeclInit n.val AnyTy AnyNone newctx := {ctx with variableTypes:=(n.val, type)::ctx.variableTypes} - return (newctx, initStmt :: assignStmts, true) + return (newctx, moExtracts ++ (initStmt :: assignStmts), true) | .Subscript _ _ _ _ => match getSubscriptList lhs with | target :: slices => @@ -1455,7 +1538,7 @@ partial def translateAssign (ctx : TranslationContext) let source := sourceRangeToSource ctx.filePath lhs.toAst.ann let anySetsExpr := mkStmtExprMdWithLoc (StmtExpr.StaticCall "Any_sets!" [ListAny_mk slices, target, rhs_trans]) source let assignStmts := [mkStmtExprMdWithLoc (StmtExpr.Assign [← stmtExprToVar target] anySetsExpr) source] - return (ctx,assignStmts, false) + return (ctx, moExtracts ++ assignStmts, false) | _ => throw (.internalError "Invalid Subscript Expr") | .Attribute _ obj attr _ => match obj with @@ -1475,11 +1558,11 @@ partial def translateAssign (ctx : TranslationContext) else pure rhs_trans | none => pure rhs_trans let assignStmt := mkStmtExprMdWithLoc (StmtExpr.Assign [fieldAccess] rhs') source - return (ctx, [assignStmt], true) + return (ctx, moExtracts ++ [assignStmt], true) else let targetExpr ← translateExpr ctx lhs -- This will handle self.field via translateExpr let assignStmt := mkStmtExprMdWithLoc (StmtExpr.Assign [← stmtExprToVar targetExpr] rhs_trans) source - return (ctx, [assignStmt], true) + return (ctx, moExtracts ++ [assignStmt], true) | _ => throw (.unsupportedConstruct "Assignment targets not yet supported" (toString (repr lhs))) | _ => throw (.unsupportedConstruct "Assignment targets not yet supported" (toString (repr lhs))) @@ -1582,13 +1665,16 @@ partial def getExceptionAssertions (ctx : TranslationContext) (e : StmtExprMd) : mkExceptionCheckAssert mbe s!"Check {funcName} exception" /-- Check whether an expression tree contains a `StaticCall` to a user-defined - function (procedure). Such calls are disallowed in pure contexts (e.g. - assert bodies), so exception-check assertions that embed them must first - extract the expression into a temporary variable. See issue #1000. -/ + function (procedure) or a multi-output prelude procedure. Such calls are + disallowed in pure contexts (e.g. assert bodies), so exception-check + assertions that embed them must first extract the expression into a + temporary variable. See issue #1000. -/ partial def containsUserCall (ctx : TranslationContext) (e : StmtExprMd) : Bool := match e.val with | .StaticCall callee args => - callee.text ∈ ctx.userFunctions || args.any (containsUserCall ctx) + callee.text ∈ ctx.userFunctions || + withException ctx callee.text || + args.any (containsUserCall ctx) | .PrimitiveOp _ args => args.any (containsUserCall ctx) | .IfThenElse cond thenBranch elseBranch => containsUserCall ctx cond || containsUserCall ctx thenBranch || @@ -1616,10 +1702,26 @@ def withExceptionChecks (ctx : TranslationContext) (result : TranslationContext × List StmtExprMd) : TranslationContext × List StmtExprMd := let (newctx, stmts) := result - let rhs_exprs := stmts.flatMap fun s => - match s.val with | .Assign _ value => [value] | _ => [] + -- Generate exception checks for the last assignment's RHS. + -- Find the last Assign in the list (there may be trailing type assertions). + let lastAssignIdx := stmts.reverse.findIdx? fun s => + match s.val with | .Assign _ _ => true | _ => false + let rhs_exprs := match lastAssignIdx with + | some revIdx => + let idx := stmts.length - 1 - revIdx + match stmts[idx]!.val with | .Assign _ value => [value] | _ => [] + | none => [] let exceptionCheck := rhs_exprs.flatMap $ getExceptionAssertions ctx - (newctx, exceptionCheck ++ stmts) + if exceptionCheck.isEmpty then + (newctx, stmts) + else + match lastAssignIdx with + | some revIdx => + let idx := stmts.length - 1 - revIdx + let before := stmts.take idx + let rest := stmts.drop idx + (newctx, before ++ exceptionCheck ++ rest) + | none => (newctx, exceptionCheck ++ stmts) mutual diff --git a/StrataTest/Languages/Python/expected_laurel/test_procedure_in_assert.expected b/StrataTest/Languages/Python/expected_laurel/test_procedure_in_assert.expected index 8acc805d68..8d71e8b122 100644 --- a/StrataTest/Languages/Python/expected_laurel/test_procedure_in_assert.expected +++ b/StrataTest/Languages/Python/expected_laurel/test_procedure_in_assert.expected @@ -1,10 +1,11 @@ -test_procedure_in_assert.py(8, 4): ✅ pass - assert(311) -test_procedure_in_assert.py(9, 4): ✅ pass - (Origin_timedelta_Requires) -test_procedure_in_assert.py(9, 4): ✅ pass - (Origin_timedelta_Requires)hours_type -test_procedure_in_assert.py(9, 4): ✅ pass - (Origin_timedelta_Requires)days_pos -test_procedure_in_assert.py(9, 4): ✅ pass - (Origin_timedelta_Requires)hours_pos -test_procedure_in_assert.py(10, 4): ✅ pass - assert(361) -test_procedure_in_assert.py(11, 4): ✅ pass - should pass +test_procedure_in_assert.py(4, 4): ✅ pass - assert(55) +test_procedure_in_assert.py(5, 4): ✅ pass - (Origin_timedelta_Requires) +test_procedure_in_assert.py(5, 4): ✅ pass - (Origin_timedelta_Requires)hours_type +test_procedure_in_assert.py(5, 4): ✅ pass - (Origin_timedelta_Requires)days_pos +test_procedure_in_assert.py(5, 4): ✅ pass - (Origin_timedelta_Requires)hours_pos +test_procedure_in_assert.py(5, 17): ✅ pass - Check PSub exception +test_procedure_in_assert.py(6, 4): ✅ pass - assert(117) +test_procedure_in_assert.py(7, 4): ✅ pass - should pass test_procedure_in_assert.py(3, 14): ✅ pass - (main ensures) Return type constraint -DETAIL: 8 passed, 0 failed, 0 inconclusive +DETAIL: 9 passed, 0 failed, 0 inconclusive RESULT: Analysis success diff --git a/StrataTest/Languages/Python/tests/test_procedure_in_assert.py b/StrataTest/Languages/Python/tests/test_procedure_in_assert.py index 6fb2a194a2..2ee6e652a7 100644 --- a/StrataTest/Languages/Python/tests/test_procedure_in_assert.py +++ b/StrataTest/Languages/Python/tests/test_procedure_in_assert.py @@ -1,12 +1,8 @@ from datetime import timedelta def main() -> int: - # Test that a procedure call (timedelta_func) can appear in an - # assignment whose result is then used in an assert. - # The call is in assignment position (not expression position), - # which is the correct pattern for multi-output procedures. base: int = 100 - delta = timedelta(days=7) + delta: Any = base - timedelta(days=7) result: int = 1 assert result == 1, "should pass" return result From 792abccc1d7167a36571d83007e19d737a89d96c Mon Sep 17 00:00:00 2001 From: Remy Willems Date: Wed, 20 May 2026 20:23:49 +0200 Subject: [PATCH 23/28] Fix scoping bug in HeapParam pass (#1113) ### Changes - Fix scoping bug in HeapParam pass where `Declare` targets inside blocks created by `heapTransformExpr` were invisible to subsequent statements - Fix small transparency bug in ConstrainedTypeElim - Factor out `heapVarName` / `heapInVarName` constants to avoid duplicated magic strings across passes - Add consistency check to LaurelCompilationPipeline to detect bugs in passes - Move intermediate program output to `.lake/build/intermediatePrograms/` ### Testing - Existing tests pass, new consistency check added By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: Michael Tautschnig Co-authored-by: keyboardDrummer-bot Co-authored-by: keyboardDrummer-bot Co-authored-by: Mikael Mayer --- .gitignore | 2 +- .../Languages/Laurel/ConstrainedTypeElim.lean | 2 +- .../Laurel/HeapParameterization.lean | 149 +++++++++--------- .../Laurel/HeapParameterizationConstants.lean | 6 + .../Laurel/LaurelCompilationPipeline.lean | 3 + Strata/Languages/Laurel/ModifiesClauses.lean | 5 +- Strata/Languages/Laurel/TypeHierarchy.lean | 3 +- .../Laurel/ConstrainedTypeElimTest.lean | 3 + .../Examples/Objects/T1_MutableFields.lean | 2 +- .../Objects/T7_InstanceProcedures.lean | 4 +- StrataTest/Languages/Laurel/TestExamples.lean | 13 ++ 11 files changed, 112 insertions(+), 80 deletions(-) diff --git a/.gitignore b/.gitignore index 3776616d98..f7d8f2cb47 100644 --- a/.gitignore +++ b/.gitignore @@ -12,4 +12,4 @@ vcs/*.smt2 *.py.ion *.py.ion.core.st -Strata.code-workspace \ No newline at end of file +Strata.code-workspace diff --git a/Strata/Languages/Laurel/ConstrainedTypeElim.lean b/Strata/Languages/Laurel/ConstrainedTypeElim.lean index 7e86c374a1..dce1a2eef3 100644 --- a/Strata/Languages/Laurel/ConstrainedTypeElim.lean +++ b/Strata/Languages/Laurel/ConstrainedTypeElim.lean @@ -224,7 +224,7 @@ private def mkWitnessProc (ptMap : ConstrainedTypeMap) (ct : ConstrainedType) : { name := mkId s!"$witness_{ct.name.text}" inputs := [] outputs := [] - body := .Transparent ⟨.Block [witnessInit, assert] none, src⟩ + body := .Opaque [] (some ⟨.Block [witnessInit, assert] none, src⟩) [] preconditions := [] isFunctional := false decreases := none } diff --git a/Strata/Languages/Laurel/HeapParameterization.lean b/Strata/Languages/Laurel/HeapParameterization.lean index fecaf5350c..dae58c3caa 100644 --- a/Strata/Languages/Laurel/HeapParameterization.lean +++ b/Strata/Languages/Laurel/HeapParameterization.lean @@ -9,6 +9,7 @@ public import Strata.Languages.Laurel.Laurel public import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator public import Strata.Languages.Laurel.LaurelTypes public import Strata.Languages.Laurel.HeapParameterizationConstants +public import Strata.Languages.Laurel.MapStmtExpr public import Strata.Util.Tactics /- @@ -253,6 +254,10 @@ def resolveQualifiedFieldName (model: SemanticModel) (fieldName : Identifier) : | .unresolved _ => none | _ => dbg_trace s!"BUG: resolveQualifiedFieldName {fieldName} did resolved to something other than a field"; none +private def wrapList (source : Option FileRange) : List StmtExprMd → StmtExprMd + | [single] => single + | many => ⟨.Block many none, source⟩ + /-- Transform an expression, adding heap parameters where needed. - `heapVar`: the name of the heap variable to use @@ -260,22 +265,25 @@ Transform an expression, adding heap parameters where needed. - `valueUsed`: whether the result value of this expression is used (affects optimization of heap-writing calls) -/ def heapTransformExpr (heapVar : Identifier) (model: SemanticModel) (expr : StmtExprMd) (valueUsed : Bool := true) : TransformM StmtExprMd := - recurse expr valueUsed + recurseOne expr valueUsed where - recurse (exprMd : StmtExprMd) (valueUsed : Bool := true) : TransformM StmtExprMd := do + recurseOne (exprMd : StmtExprMd) (valueUsed : Bool := true) : TransformM StmtExprMd := + wrapList exprMd.source <$> recurse exprMd valueUsed + termination_by (sizeOf exprMd, 1) + recurse (exprMd : StmtExprMd) (valueUsed : Bool := true) : TransformM (List StmtExprMd) := do let ⟨expr, source⟩ := exprMd match _h : expr with | .Var (.Field selectTarget fieldName) => do let some qualifiedName := resolveQualifiedFieldName model fieldName - | return ⟨ .Hole, source ⟩ + | return [⟨ .Hole, source ⟩] let valTy := (model.get fieldName).getType let readExpr := ⟨ .StaticCall "readField" [mkMd (.Var (.Local heapVar)), selectTarget, mkMd (.StaticCall qualifiedName [])], source ⟩ -- Unwrap Box: apply the appropriate destructor recordBoxConstructor model valTy.val - return mkMd <| .StaticCall (boxDestructorName model valTy.val) [readExpr] + return [mkMd <| .StaticCall (boxDestructorName model valTy.val) [readExpr]] | .StaticCall callee args => - let args' ← args.mapM (recurse ·) + let args' ← args.mapM (recurseOne ·) let calleeReadsHeap ← readsHeap callee let calleeWritesHeap ← writesHeap callee if calleeWritesHeap then @@ -284,7 +292,7 @@ where let callWithHeap := ⟨ .Assign [mkVarMd (.Local heapVar), mkVarMd (.Declare ⟨freshVar, computeExprType model exprMd⟩)] (⟨ .StaticCall callee (mkMd (.Var (.Local heapVar)) :: args'), source ⟩), source ⟩ - return ⟨ .Block [callWithHeap, mkMd (.Var (.Local freshVar))] none, source ⟩ + return [callWithHeap, mkMd (.Var (.Local freshVar))] else -- Generate throwaway Declare targets for any non-heap outputs let procOutputs := match model.get callee with @@ -294,18 +302,18 @@ where let extraTargets ← procOutputs.mapM fun out => do pure (mkVarMd (.Declare ⟨← freshVarName, out.type⟩)) let allTargets := mkVarMd (.Local heapVar) :: extraTargets - return ⟨ .Assign allTargets (⟨ .StaticCall callee (mkMd (.Var (.Local heapVar)) :: args'), source ⟩), source ⟩ + return [⟨ .Assign allTargets (⟨ .StaticCall callee (mkMd (.Var (.Local heapVar)) :: args'), source ⟩), source ⟩] else if calleeReadsHeap then - return ⟨ .StaticCall callee (mkMd (.Var (.Local heapVar)) :: args'), source ⟩ + return [⟨ .StaticCall callee (mkMd (.Var (.Local heapVar)) :: args'), source ⟩] else - return ⟨ .StaticCall callee args', source ⟩ + return [⟨ .StaticCall callee args', source ⟩] | .InstanceCall callTarget callee args => - let t ← recurse callTarget - let args' ← args.mapM (recurse ·) - return ⟨ .InstanceCall t callee args', source ⟩ + let t ← recurseOne callTarget + let args' ← args.mapM (recurseOne ·) + return [⟨ .InstanceCall t callee args', source ⟩] | .IfThenElse c t e => - let e' ← match e with | some x => some <$> recurse x valueUsed | none => pure none - return ⟨ .IfThenElse (← recurse c) (← recurse t valueUsed) e', source ⟩ + let e' ← match e with | some x => some <$> recurseOne x valueUsed | none => pure none + return [⟨ .IfThenElse (← recurseOne c) (← recurseOne t valueUsed) e', source ⟩] | .Block stmts label => let n := stmts.length let rec processStmts (idx : Nat) (remaining : List StmtExprMd) : TransformM (List StmtExprMd) := do @@ -315,16 +323,16 @@ where let isLast := idx == n - 1 let s' ← recurse s (isLast && valueUsed) let rest' ← processStmts (idx + 1) rest - pure (s' :: rest') - termination_by sizeOf remaining + pure (s' ++ rest') + termination_by (sizeOf remaining, 0) let stmts' ← processStmts 0 stmts - return ⟨ .Block stmts' label, source ⟩ + return [⟨ .Block stmts' label, source ⟩] | .While c invs d b => - let invs' ← invs.mapM (recurse ·) - return ⟨ .While (← recurse c) invs' d (← recurse b false), source ⟩ + let invs' ← invs.mapM (recurseOne ·) + return [⟨ .While (← recurseOne c) invs' d (← recurseOne b false), source ⟩] | .Return v => - let v' ← match v with | some x => some <$> recurse x | none => pure none - return ⟨ .Return v', source ⟩ + let v' ← match v with | some x => some <$> recurseOne x | none => pure none + return [⟨ .Return v', source ⟩] | .Assign targets v => -- Process field targets @@ -338,7 +346,7 @@ where let valTy := (model.get fieldName).getType recordBoxConstructor model valTy.val let freshVar ← freshVarName - let target' ← recurse target + let target' ← recurseOne target let boxedVal := mkMd <| .StaticCall (boxConstructorName model valTy.val) [mkMd (.Var (.Local freshVar))] let updateStmt : StmtExprMd := ⟨ .Assign [mkVarMd (.Local heapVar)] (mkMd (.StaticCall "updateField" [mkMd (.Var (.Local heapVar)), target', mkMd (.StaticCall qualifiedName []), boxedVal])), source ⟩ @@ -350,7 +358,7 @@ where -- Detect calls and add a heap argument if needed let (v', addedHeap) <- match _hv : v.val with | .StaticCall callee args => do - let args' <- args.mapM recurse + let args' <- args.mapM recurseOne let calleeWritesHeap ← writesHeap callee let calleeReadsHeap ← readsHeap callee if calleeWritesHeap then @@ -360,11 +368,11 @@ where else pure (⟨ .StaticCall callee args', v.source ⟩, false) | .InstanceCall callTarget _callee args => do - let _callTarget' ← recurse callTarget - let _args' <- args.mapM recurse + let _callTarget' ← recurseOne callTarget + let _args' <- args.mapM recurseOne pure (⟨ .InstanceCall _callTarget' _callee _args', v.source ⟩, false) | _ => - pure (<- recurse v, false) + pure (<- recurseOne v, false) let allTargets := if addedHeap then ⟨ Variable.Local heapVar, v.source ⟩ :: processedTargets else processedTargets @@ -387,15 +395,12 @@ where else updateStatements pure (newAssign, suffixes) - -- Create a block if necessary - if suffixes.length > 0 then - return ⟨ StmtExpr.Block (newAssign :: suffixes) none, source ⟩ - else - return newAssign + -- Return the list of statements directly (flattened into enclosing block) + return newAssign :: suffixes - | .PureFieldUpdate t f v => return ⟨ .PureFieldUpdate (← recurse t) f (← recurse v), source ⟩ + | .PureFieldUpdate t f v => return [⟨ .PureFieldUpdate (← recurseOne t) f (← recurseOne v), source ⟩] | .PrimitiveOp op args => - let args' ← args.mapM (recurse ·) + let args' ← args.mapM (recurseOne ·) -- For == and != on Composite types, compare refs instead match op, args with | .Eq, [e1, _e2] => @@ -404,58 +409,58 @@ where | .UserDefined _ => let ref1 := mkMd (.StaticCall "Composite..ref!" [args'[0]!]) let ref2 := mkMd (.StaticCall "Composite..ref!" [args'[1]!]) - return ⟨ .PrimitiveOp .Eq [ref1, ref2], source ⟩ - | _ => return ⟨ .PrimitiveOp op args', source ⟩ + return [⟨ .PrimitiveOp .Eq [ref1, ref2], source ⟩] + | _ => return [⟨ .PrimitiveOp op args', source ⟩] | .Neq, [e1, _e2] => let ty := (computeExprType model e1).val match ty with | .UserDefined _ => let ref1 := mkMd (.StaticCall "Composite..ref!" [args'[0]!]) let ref2 := mkMd (.StaticCall "Composite..ref!" [args'[1]!]) - return ⟨ .PrimitiveOp .Neq [ref1, ref2], source ⟩ - | _ => return ⟨ .PrimitiveOp op args', source ⟩ - | _, _ => return ⟨ .PrimitiveOp op args', source ⟩ - | .New _ => return exprMd - | .ReferenceEquals l r => return ⟨ .ReferenceEquals (← recurse l) (← recurse r), source ⟩ + return [⟨ .PrimitiveOp .Neq [ref1, ref2], source ⟩] + | _ => return [⟨ .PrimitiveOp op args', source ⟩] + | _, _ => return [⟨ .PrimitiveOp op args', source ⟩] + | .New _ => return [exprMd] + | .ReferenceEquals l r => return [⟨ .ReferenceEquals (← recurseOne l) (← recurseOne r), source ⟩] | .AsType t ty => - let t' ← recurse t valueUsed + let t' ← recurseOne t valueUsed let isCheck := ⟨ .IsType t' ty, source ⟩ let assertStmt := ⟨ .Assert { condition := isCheck }, source ⟩ - return ⟨ .Block [assertStmt, t'] none, source ⟩ - | .IsType t ty => return ⟨ .IsType (← recurse t) ty, source ⟩ + return [⟨ .Block [assertStmt, t'] none, source ⟩] + | .IsType t ty => return [⟨ .IsType (← recurseOne t) ty, source ⟩] | .Quantifier mode p trigger b => - let trigger' ← trigger.attach.mapM fun ⟨t, _⟩ => recurse t - return ⟨.Quantifier mode p trigger' (← recurse b), source⟩ - | .Assigned n => return ⟨ .Assigned (← recurse n), source ⟩ - | .Old v => return ⟨ .Old (← recurse v), source ⟩ - | .Fresh v => return ⟨ .Fresh (← recurse v), source ⟩ + let trigger' ← trigger.attach.mapM fun ⟨t, _⟩ => recurseOne t + return [⟨.Quantifier mode p trigger' (← recurseOne b), source⟩] + | .Assigned n => return [⟨ .Assigned (← recurseOne n), source ⟩] + | .Old v => return [⟨ .Old (← recurseOne v), source ⟩] + | .Fresh v => return [⟨ .Fresh (← recurseOne v), source ⟩] | .Assert ⟨condExpr, summary⟩ => - return ⟨ .Assert { condition := ← recurse condExpr, summary }, source ⟩ - | .Assume c => return ⟨ .Assume (← recurse c), source ⟩ - | .ProveBy v p => return ⟨ .ProveBy (← recurse v) (← recurse p), source ⟩ - | .ContractOf ty f => return ⟨ .ContractOf ty (← recurse f), source ⟩ - | _ => return exprMd - termination_by sizeOf exprMd - decreasing_by - all_goals simp_wf - all_goals (try have := AstNode.sizeOf_val_lt exprMd) - all_goals (try have := AstNode.sizeOf_val_lt v) - all_goals (try term_by_mem) - all_goals (try (cases exprMd; simp_all; omega)) - -- For field inner expressions in attach-based: - all_goals (try ( - have := List.sizeOf_lt_of_mem ‹_› - have := Variable.sizeOf_field_target_lt_of_eq _htv - omega)) - -- Remaining goals - all_goals ( - cases exprMd with | mk val src mmd => - simp_all - omega) + return [⟨ .Assert { condition := ← recurseOne condExpr, summary }, source ⟩] + | .Assume c => return [⟨ .Assume (← recurseOne c), source ⟩] + | .ProveBy v p => return [⟨ .ProveBy (← recurseOne v) (← recurseOne p), source ⟩] + | .ContractOf ty f => return [⟨ .ContractOf ty (← recurseOne f), source ⟩] + | _ => return [exprMd] + termination_by (sizeOf exprMd, 0) + decreasing_by + all_goals simp_wf + all_goals (try have := AstNode.sizeOf_val_lt exprMd) + all_goals (try have := AstNode.sizeOf_val_lt v) + all_goals (try term_by_mem) + all_goals (try (cases exprMd; simp_all; omega)) + -- For field inner expressions in attach-based: + all_goals (try ( + have := List.sizeOf_lt_of_mem ‹_› + have := Variable.sizeOf_field_target_lt_of_eq _htv + omega)) + -- Remaining goals + all_goals ( + cases exprMd with | mk val src => + simp_all + omega) def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : TransformM Procedure := do - let heapName : Identifier := "$heap" - let heapInName : Identifier := "$heap_in" + let heapName := heapVarName + let heapInName := heapInVarName let readsHeap := (← get).heapReaders.contains proc.name let writesHeap := (← get).heapWriters.contains proc.name diff --git a/Strata/Languages/Laurel/HeapParameterizationConstants.lean b/Strata/Languages/Laurel/HeapParameterizationConstants.lean index 758aa149a1..bfa76a4a59 100644 --- a/Strata/Languages/Laurel/HeapParameterizationConstants.lean +++ b/Strata/Languages/Laurel/HeapParameterizationConstants.lean @@ -15,6 +15,12 @@ namespace Strata.Laurel public section +/-- The name of the heap variable used by the heap parameterization pass. -/ +def heapVarName : Identifier := "$heap" + +/-- The name of the input heap parameter used by the heap parameterization pass. -/ +def heapInVarName : Identifier := "$heap_in" + /-- The Laurel Core prelude defines the heap model types and operations used by the Laurel-to-Core translator. These declarations are expressed diff --git a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean index e809401ccc..54b97fdfd9 100644 --- a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean +++ b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean @@ -179,6 +179,9 @@ private def runLaurelPasses (options : LaurelTranslateOptions) -- Run resolve after the pass if needed if pass.needsResolves then let result := resolve program (some model) + let newErrors := result.errors.filter fun e => !resolutionErrors.contains e + if !newErrors.isEmpty then + emit pass.name "laurel.st" program program := result.program model := result.model emit pass.name "laurel.st" program diff --git a/Strata/Languages/Laurel/ModifiesClauses.lean b/Strata/Languages/Laurel/ModifiesClauses.lean index 20fd01445d..5fb37c60ad 100644 --- a/Strata/Languages/Laurel/ModifiesClauses.lean +++ b/Strata/Languages/Laurel/ModifiesClauses.lean @@ -9,6 +9,7 @@ public import Strata.Languages.Laurel.Laurel public import Strata.Languages.Laurel.LaurelTypes public import Strata.Languages.Core.Verifier public import Strata.Languages.Laurel.Resolution +import Strata.Languages.Laurel.HeapParameterizationConstants /- Modifies clause transformation (Laurel → Laurel). @@ -159,8 +160,8 @@ def transformModifiesClauses (model: SemanticModel) -- modifies * means the procedure can modify anything; no frame condition .ok { proc with body := .Opaque postconds impl [] } else if hasHeapOut proc then - let heapInName : Identifier := "$heap_in" - let heapName : Identifier := "$heap" + let heapInName := heapInVarName + let heapName := heapVarName let frameCondition := buildModifiesEnsures proc model modifiesExprs heapInName heapName let postconds' := match frameCondition with | some frame => postconds ++ [{ condition := frame, summary := "modifies clause" }] diff --git a/Strata/Languages/Laurel/TypeHierarchy.lean b/Strata/Languages/Laurel/TypeHierarchy.lean index 411c61b95f..26b72ff23f 100644 --- a/Strata/Languages/Laurel/TypeHierarchy.lean +++ b/Strata/Languages/Laurel/TypeHierarchy.lean @@ -8,6 +8,7 @@ module public import Strata.Languages.Laurel.MapStmtExpr public import Strata.Languages.Laurel.LaurelTypes public import Strata.DL.Imperative.MetaData +import Strata.Languages.Laurel.HeapParameterizationConstants import Strata.Util.Tactics public section @@ -235,7 +236,7 @@ Lower `New name` to a block that: 3. Constructs a `MkComposite(counter, name_TypeTag())` value -/ def lowerNew (name : Identifier) (source : Option FileRange) : THM StmtExprMd := do - let heapVar : Identifier := "$heap" + let heapVar := heapVarName let freshVar ← freshVarName let getCounter := mkMd (.StaticCall "Heap..nextReference!" [mkMd (.Var (.Local heapVar))]) let saveCounter := mkMd (.Assign [mkVarMd (.Declare ⟨freshVar, ⟨.TInt, none⟩⟩)] getCounter) diff --git a/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean b/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean index 86ce51e683..0811d5e955 100644 --- a/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean +++ b/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean @@ -52,6 +52,7 @@ procedure test(n: int) ensures nat$constraint(r) { assert r >= 0; var y: int := n; assert nat$constraint(y); return y }; procedure $witness_nat() + opaque { var $witness: int := 0; assert nat$constraint($witness) }; -/ #guard_msgs in @@ -80,6 +81,7 @@ info: function pos$constraint(v: int): bool procedure test(b: bool) { if b then { var x: int := 1; assert pos$constraint(x) }; { var x: int := -5; x := -10 } }; procedure $witness_pos() + opaque { var $witness: int := 1; assert pos$constraint($witness) }; -/ #guard_msgs in @@ -104,6 +106,7 @@ info: function posint$constraint(x: int): bool procedure f() { var x: int; assume posint$constraint(x); assert x == 1 }; procedure $witness_posint() + opaque { var $witness: int := 1; assert posint$constraint($witness) }; -/ #guard_msgs in diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean b/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean index 7dbf35022d..e46f03ef99 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean @@ -199,5 +199,5 @@ procedure fieldTargetInMultiAssign() }; "# -#guard_msgs(drop info, error) in +#guard_msgs (drop info, error) in #eval testInputWithOffset "MutableFields" program 14 processLaurelFile diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean b/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean index ec05fcfd3d..189295102d 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean @@ -15,8 +15,8 @@ namespace Strata.Laurel def instanceProcedureProgram := r" composite Counter { var count: int - procedure increment(self: Counter) -// ^^^^^^^^^ error: Instance procedure 'increment' on composite type 'Counter' is not yet supported + procedure self_increment(self: Counter) +// ^^^^^^^^^^^^^^ error: Instance procedure 'self_increment' on composite type 'Counter' is not yet supported opaque { self#count := self#count + 1 diff --git a/StrataTest/Languages/Laurel/TestExamples.lean b/StrataTest/Languages/Laurel/TestExamples.lean index 5affbb2813..00d14ae804 100644 --- a/StrataTest/Languages/Laurel/TestExamples.lean +++ b/StrataTest/Languages/Laurel/TestExamples.lean @@ -36,4 +36,17 @@ def processLaurelFileWithOptions (options : LaurelVerifyOptions) (input : InputC def processLaurelFile (input : InputContext) : IO (Array Diagnostic) := processLaurelFileWithOptions default input +/-- Path to the directory for intermediate files, inside the build directory. + Resolved from the current working directory so it works on any machine. -/ +def buildDir : IO String := do + let cwd ← IO.currentDir + return s!"{cwd}/.lake/build/intermediatePrograms/" + +/-- Debug helper: run the Laurel pipeline keeping intermediate pass outputs in `.lake/build/intermediatePrograms/`. + Not used by any test in this repo; invoke manually via `#eval processLaurelFileKeepIntermediates (stringInputContext …)` + when diagnosing pass-internal issues. -/ +def processLaurelFileKeepIntermediates (input : InputContext) : IO (Array Diagnostic) := do + let dir ← buildDir + processLaurelFileWithOptions { translateOptions := { keepAllFilesPrefix := dir}} input + end Laurel From a845a654b36fbb520c9c920d278cbb3656d76ba3 Mon Sep 17 00:00:00 2001 From: Michael Tautschnig Date: Wed, 20 May 2026 20:24:24 +0200 Subject: [PATCH 24/28] InferHoleTypes: recover param types for datatype destructors/testers (#1134) Holes in arguments to datatype destructors (e.g. `Any..as_ListAny!()`) and testers (e.g. `Any..isfrom_str()`) were left untyped after `InferHoleTypes`, producing "could not infer type" diagnostics and downstream `Unknown`-typed `$hole_N` functions. The fix surfaces the parent datatype through the semantic model so `InferHoleTypes` can recover parameter types via `uniqueId`-based model lookups (per the Laurel steering doc, post-resolution passes should rely on model lookups, not textual names). Key changes: - New `ResolvedNode.datatypeDestructor` variant carrying the parent type name and field parameter, with corresponding updates to `ResolvedNodeKind`, `.kind`, `.getType`, and `SemanticModel.isFunction`. - Datatype scope registration chains `defineNameCheckDup` calls so safe/unsafe destructors and tester/constructor names share a single `uniqueId`. - `buildRefToDef` registers each constructor parameter as `.datatypeDestructor`. - `calleeParamTypes` matches `.datatypeConstructor` and `.datatypeDestructor` directly, synthesizing the correct `.UserDefined` input type. - `ResolvedNode.getType` now uses explicit pattern matches instead of a catch-all, so new constructors trigger compile errors rather than silently falling through. - `SemanticModel.refToDef` is now `private`; external code uses `SemanticModel.get?` (returning `Option ResolvedNode`) or `SemanticModel.get` to look up nodes by `Identifier`, preventing arbitrary `Nat` key access. Tests: three new `#guard_msgs` cases for holes inside destructors/testers, plus updated expected diagnostics in `ResolutionKindTests`. Existing tests pass. By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: Kiro Co-authored-by: Mikael Mayer --- Strata/Languages/Laurel/InferHoleTypes.lean | 12 ++++- .../Laurel/LaurelToCoreTranslator.lean | 2 +- Strata/Languages/Laurel/LaurelTypes.lean | 1 + Strata/Languages/Laurel/Resolution.lean | 48 ++++++++++++++----- .../Languages/Laurel/LiftHolesTest.lean | 48 +++++++++++++++++++ .../Languages/Laurel/ResolutionKindTests.lean | 2 +- 6 files changed, 98 insertions(+), 15 deletions(-) diff --git a/Strata/Languages/Laurel/InferHoleTypes.lean b/Strata/Languages/Laurel/InferHoleTypes.lean index d56ad86881..ff80f37c5e 100644 --- a/Strata/Languages/Laurel/InferHoleTypes.lean +++ b/Strata/Languages/Laurel/InferHoleTypes.lean @@ -35,10 +35,20 @@ private def inferComparisonArgType (model : SemanticModel) (args : List StmtExpr args.findSome? (fun a => match a.val with | .Hole _ _ => none | _ => some (computeExprType model a)) |>.getD ⟨ .TInt, source ⟩ -- use Int as a default type for comparisons where both operands are holes -/-- Get the expected type for each argument of a call from the callee's parameter list. -/ +/-- Get the expected type for each argument of a call from the callee's parameter list. + + Auto-generated datatype destructors (`TypeName..fieldName[!]`) and testers + (`TypeName..isCtor`) are unary, taking the datatype itself as their single + input. Their `ResolvedNode` (`.datatypeDestructor` / `.datatypeConstructor`) + carries the resolved type Identifier (with its `uniqueId`), so we can + construct the input `HighType` directly without falling back to textual + decoding of the override name. -/ private def calleeParamTypes (model : SemanticModel) (callee : Identifier) : Option (List HighTypeMd) := match model.get callee with | .staticProcedure proc => some (proc.inputs.map (·.type)) + | .datatypeConstructor typeName _ + | .datatypeDestructor typeName _ => + some [⟨.UserDefined typeName, callee.source⟩] | _ => none inductive InferHoleTypesStats where diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index 04c307520f..9e02d9a825 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -93,7 +93,7 @@ def translateType (ty : HighTypeMd) : TranslateM LMonoTy := do | .TSet elementType => return Core.mapTy (← translateType elementType) LMonoTy.bool | .TMap keyType valueType => return Core.mapTy (← translateType keyType) (← translateType valueType) | .UserDefined name => - match name.uniqueId.bind model.refToDef.get? with + match model.get? name with | some (.compositeType _) => return .tcons "Composite" [] | some (.datatypeDefinition dt) => return .tcons dt.name.text [] | some (.datatypeConstructor typeName _) => return .tcons typeName.text [] diff --git a/Strata/Languages/Laurel/LaurelTypes.lean b/Strata/Languages/Laurel/LaurelTypes.lean index ff07ae5171..9bbdc86a83 100644 --- a/Strata/Languages/Laurel/LaurelTypes.lean +++ b/Strata/Languages/Laurel/LaurelTypes.lean @@ -24,6 +24,7 @@ namespace Strata.Laurel def getCallType (source : Option FileRange) (model : SemanticModel) (callee : Identifier): HighTypeMd := match model.get callee with | .datatypeConstructor t _ => ⟨ .UserDefined t, source ⟩ + | .datatypeDestructor _ fld => fld.type | .parameter p => p.type | .staticProcedure proc => match proc.outputs with | [singleOutput] => singleOutput.type diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index 71c1510d91..75e6ac1292 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -75,6 +75,7 @@ inductive ResolvedNodeKind where | constrainedType | datatypeDefinition | datatypeConstructor + | datatypeDestructor | typeAlias | constant | quantifierVar @@ -91,6 +92,7 @@ def ResolvedNodeKind.name : ResolvedNodeKind → String | .constrainedType => "constrained type" | .datatypeDefinition => "datatype definition" | .datatypeConstructor => "datatype constructor" + | .datatypeDestructor => "datatype destructor" | .typeAlias => "type alias" | .constant => "constant" | .quantifierVar => "quantifier variable" @@ -116,6 +118,10 @@ inductive ResolvedNode where | datatypeDefinition (ty : DatatypeDefinition) /-- A datatype constructor. -/ | datatypeConstructor (typeName : Identifier) (ctor : DatatypeConstructor) + /-- An auto-generated destructor (or unsafe `!`-destructor) for a datatype field. + `typeName` is the resolved Identifier of the parent datatype (with its + `uniqueId`), and `field` is the underlying constructor parameter. -/ + | datatypeDestructor (typeName : Identifier) (field : Parameter) /-- A type alias. -/ | typeAlias (ty : TypeAlias) /-- A constant. -/ @@ -139,6 +145,7 @@ def ResolvedNode.kind : ResolvedNode → ResolvedNodeKind | .constrainedType .. => .constrainedType | .datatypeDefinition .. => .datatypeDefinition | .datatypeConstructor .. => .datatypeConstructor + | .datatypeDestructor .. => .datatypeDestructor | .typeAlias .. => .typeAlias | .constant .. => .constant | .quantifierVar .. => .quantifierVar @@ -149,29 +156,35 @@ def ResolvedNode.getType (node: ResolvedNode): HighTypeMd := match node with | .parameter p => p.type | .field _ f => f.type | .datatypeConstructor type _ => ⟨ .UserDefined type, none ⟩ + | .datatypeDestructor _ fld => fld.type | .constant c => c.type | .quantifierVar _ type => type | .unresolved source => ⟨ .Unknown, source ⟩ - | _ => dbg_trace s!"SOUND BUG: getType called on {repr node}"; default + | .staticProcedure _ | .instanceProcedure _ _ | .compositeType _ + | .constrainedType _ | .datatypeDefinition _ | .typeAlias _ => ⟨ .Unknown, none ⟩ /-! ## Resolution result -/ structure SemanticModel where nextId: Nat compositeCount: Nat - refToDef: Std.HashMap Nat ResolvedNode + private refToDef: Std.HashMap Nat ResolvedNode deriving Repr +/-- Look up the resolved node for an identifier, returning `none` if the identifier + has no `uniqueId` or is not in the model. -/ +def SemanticModel.get? (model: SemanticModel) (iden: Identifier): Option ResolvedNode := + iden.uniqueId.bind model.refToDef.get? + def SemanticModel.get (model: SemanticModel) (iden: Identifier): ResolvedNode := - match iden.uniqueId with - | some key => (model.refToDef.get? key).getD default - | none => default + (model.get? iden).getD default def SemanticModel.isFunction (model: SemanticModel) (id: Identifier): Bool := match model.get id with | .staticProcedure proc => proc.isFunctional | .parameter _ => true | .datatypeConstructor _ _ => true + | .datatypeDestructor _ _ => true | .constant _ => true | .unresolved _ => true -- functions calls are more permissive, so true avoids possibly incorrect errors | node => @@ -446,7 +459,7 @@ def resolveStmtExpr (exprMd : StmtExprMd) : ResolveM StmtExprMd := do pure (.PureFieldUpdate target' fieldName' newVal') | .StaticCall callee args => let callee' ← resolveRef callee source - (expected := #[.parameter, .staticProcedure, .datatypeConstructor, .constant]) + (expected := #[.parameter, .staticProcedure, .datatypeConstructor, .datatypeDestructor, .constant]) -- Resolve arguments in value context (their results are used as values) let saved := (← get).inValueContext modify fun s => { s with inValueContext := true } @@ -821,7 +834,11 @@ private def collectTypeDefinition (map : Std.HashMap Nat ResolvedNode) (td : Typ dt.constructors.foldl (fun map ctor => let map := register map ctor.name (.datatypeConstructor dt.name ctor) ctor.args.foldl (fun map p => - let map := register map p.name (.parameter p) + -- The constructor parameter's `uniqueId` (set by `resolveTypeDefinition`) + -- is the shared uniqueId of the safe/unsafe destructor scope entries, + -- so registering it here as `.datatypeDestructor` covers calls of the + -- form `TypeName..fieldName` and `TypeName..fieldName!`. + let map := register map p.name (.datatypeDestructor dt.name p) collectHighType map p.type ) map ) map @@ -873,12 +890,19 @@ private def preRegisterTopLevel (program : Program) : ResolveM Unit := do | .Datatype dt => let _ ← defineNameCheckDup dt.name (.datatypeDefinition dt) for ctor in dt.constructors do - _ ← defineNameCheckDup ctor.name (.datatypeConstructor dt.name ctor) (some (dt.testerName ctor)) - let _ ← defineNameCheckDup ctor.name (.datatypeConstructor dt.name ctor) + -- Register the tester override first; the second call reuses the + -- returned Identifier (now carrying a uniqueId) so the unprefixed + -- constructor name and the `TypeName..isCtor` tester name resolve to + -- the same uniqueId, which `buildRefToDef` in turn maps to + -- `.datatypeConstructor`. + let ctorName ← defineNameCheckDup ctor.name (.datatypeConstructor dt.name ctor) (some (dt.testerName ctor)) + let _ ← defineNameCheckDup ctorName (.datatypeConstructor dt.name ctor) for p in ctor.args do - let _ ← defineNameCheckDup p.name (.parameter p) (some (dt.destructorName p)) - -- unsafeDestructorId - let _ ← defineNameCheckDup p.name (.parameter p) (some (dt.unsafeDestructorName p)) + -- Same chaining trick for the safe and unsafe destructor names: both + -- point to the same uniqueId so `IntList..head` and `IntList..head!` + -- resolve to the same `.datatypeDestructor` model entry. + let pName ← defineNameCheckDup p.name (.datatypeDestructor dt.name p) (some (dt.destructorName p)) + let _ ← defineNameCheckDup pName (.datatypeDestructor dt.name p) (some (dt.unsafeDestructorName p)) | .Alias ta => let _ ← defineNameCheckDup ta.name (.typeAlias ta) -- Pre-register constants diff --git a/StrataTest/Languages/Laurel/LiftHolesTest.lean b/StrataTest/Languages/Laurel/LiftHolesTest.lean index 14d25a4416..0f5a4997d3 100644 --- a/StrataTest/Languages/Laurel/LiftHolesTest.lean +++ b/StrataTest/Languages/Laurel/LiftHolesTest.lean @@ -332,4 +332,52 @@ procedure test() { var x: int := ; assert }; -- Nondet hole in function → should be rejected (not tested here since -- the error occurs at Core translation time, which requires the full pipeline). +/-! ## Holes inside datatype destructor / tester arguments -/ + +-- Hole as argument to a (safe) datatype destructor → typed as the parent +-- datatype, then lifted to a generated `$hole_0` returning that datatype. +-- Regression test for PR #1134: the destructor's `ResolvedNode` carries the +-- parent datatype's resolved Identifier (with `uniqueId`), so this works +-- without textual decoding of the override name. +/-- +info: function $hole_0() + returns ($result: IntList) + opaque; +procedure test() +{ var x: int := IntList..head($hole_0()) }; +-/ +#guard_msgs in +#eval! parseElimAndPrint r" +datatype IntList { Nil(), Cons(head: int, tail: IntList) } +procedure test() { var x: int := IntList..head() }; +" + +-- Hole as argument to an unsafe `!` destructor → same datatype recovery. +/-- +info: function $hole_0() + returns ($result: IntList) + opaque; +procedure test() +{ var x: int := IntList..head!($hole_0()) }; +-/ +#guard_msgs in +#eval! parseElimAndPrint r" +datatype IntList { Nil(), Cons(head: int, tail: IntList) } +procedure test() { var x: int := IntList..head!() }; +" + +-- Hole as argument to a tester → typed as the parent datatype. +/-- +info: function $hole_0() + returns ($result: IntList) + opaque; +procedure test() +{ assert IntList..isCons($hole_0()) }; +-/ +#guard_msgs in +#eval! parseElimAndPrint r" +datatype IntList { Nil(), Cons(head: int, tail: IntList) } +procedure test() { assert IntList..isCons() }; +" + end Laurel diff --git a/StrataTest/Languages/Laurel/ResolutionKindTests.lean b/StrataTest/Languages/Laurel/ResolutionKindTests.lean index 6c58bcd573..52355edf11 100644 --- a/StrataTest/Languages/Laurel/ResolutionKindTests.lean +++ b/StrataTest/Languages/Laurel/ResolutionKindTests.lean @@ -66,7 +66,7 @@ def typeAsStaticCall := r" composite Foo { } procedure bar() opaque { var x: int := Foo() -// ^^^^^ error: 'Foo' resolves to composite type, but expected parameter, static procedure, datatype constructor, constant +// ^^^^^ error: 'Foo' resolves to composite type, but expected parameter, static procedure, datatype constructor, datatype destructor, constant }; " From 5749bff94de0a20a972b0441b4a7422dcd5a7fbe Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Wed, 20 May 2026 13:54:39 -0700 Subject: [PATCH 25/28] Migrate StrataTest files to be Lean modules (#1010) Migrate 241 of 282 non-Boole StrataTest files to be Lean modules, completing the module migration started in #982. - **Added `module` keyword** to 241 test files. The Boole test files are excluded because `gen_smt_vcs` produces proof terms that fail kernel type-checking when the file is a module. - **Added `meta import`** for Strata/StrataTest dependencies where `#eval`, `#guard_msgs`, or `#guard` need native implementations from the imported module. - **Added `meta import all`** where proofs use `simp`, `rfl`, or `native_decide` on definitions whose bodies must be visible across the module boundary. - **Added `import all`** where non-meta definitions (types, instances) need access to definition bodies from other StrataTest modules. - **Added `meta section` wrappers** around test code that exercises native implementations, since `#eval`/`#guard_msgs`/`#guard` require meta context to call into compiled code from another module. - **Added `import Strata.DDM.Integration.Lean.HashCommands`** (non-meta) in files using `#strata`/`#dialect` syntax, since the syntax extension must be available at parse time regardless of meta context. - **Updated byte offsets** in `#guard_msgs` docstrings where expected output includes position-dependent labels (e.g., invariant names derived from source positions shifted by added import lines). By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --------- Co-authored-by: Claude Opus 4.6 --- .../Backends/CBMC/GOTO/E2E_CoreToGOTO.lean | 10 +- StrataTest/Backends/CBMC/GOTO/ExprTests.lean | 6 +- .../CBMC/GOTO/LambdaToCProverGOTO.lean | 6 +- .../Backends/CBMC/GOTO/ToCProverGOTO.lean | 11 +- .../Backends/CBMC/SimpleAdd/SimpleAdd.lean | 1 + StrataTest/DL/Imperative/Arith.lean | 10 +- StrataTest/DL/Imperative/ArithEval.lean | 8 +- StrataTest/DL/Imperative/ArithExpr.lean | 1 + StrataTest/DL/Imperative/ArithType.lean | 7 +- .../DL/Imperative/CFGToCProverGOTO.lean | 10 +- StrataTest/DL/Imperative/DDMDefinition.lean | 1 + StrataTest/DL/Imperative/DDMTranslate.lean | 81 ++++-- StrataTest/DL/Imperative/Examples.lean | 8 +- StrataTest/DL/Imperative/FormatStmtTest.lean | 8 +- StrataTest/DL/Imperative/SMTEncoder.lean | 10 +- StrataTest/DL/Imperative/StepStmtTest.lean | 7 +- StrataTest/DL/Imperative/Verify.lean | 12 +- StrataTest/DL/Lambda/AdtRankAxiomsModels.lean | 1 + StrataTest/DL/Lambda/AdtRankAxiomsTests.lean | 7 +- StrataTest/DL/Lambda/FuncAttrTests.lean | 7 +- StrataTest/DL/Lambda/LExprEqTests.lean | 11 +- StrataTest/DL/Lambda/LExprEvalTests.lean | 7 +- StrataTest/DL/Lambda/LExprTTests.lean | 5 +- StrataTest/DL/Lambda/LExprTests.lean | 5 +- StrataTest/DL/Lambda/LExprTypeEnvTests.lean | 5 +- StrataTest/DL/Lambda/LExprWFTests.lean | 5 +- StrataTest/DL/Lambda/LTyTests.lean | 6 +- StrataTest/DL/Lambda/LTyUnifyTests.lean | 5 +- StrataTest/DL/Lambda/Lambda.lean | 8 +- StrataTest/DL/Lambda/PreconditionsTests.lean | 7 +- .../DL/Lambda/RecursiveAxiomsTests.lean | 9 +- StrataTest/DL/Lambda/ReflectTests.lean | 9 +- StrataTest/DL/Lambda/ScopesTests.lean | 5 +- .../DL/Lambda/SubstFvarsBugFromState.lean | 7 +- StrataTest/DL/Lambda/TestGen.lean | 9 +- StrataTest/DL/Lambda/TestGenTests.lean | 8 +- StrataTest/DL/Lambda/TypeFactoryTests.lean | 9 +- .../DL/SMT/DDMTransform/TranslateTests.lean | 6 +- StrataTest/DL/SMT/DenoteTests.lean | 97 ++++++- StrataTest/DL/SMT/EncoderTests.lean | 12 +- StrataTest/DL/SMT/SolverTests.lean | 7 +- StrataTest/DL/SMT/TranslateTests.lean | 7 +- .../Languages/B3/DDMConversionErrorTests.lean | 6 +- .../B3/DDMFormatDeclarationsTests.lean | 8 +- .../B3/DDMFormatExpressionsTests.lean | 7 +- .../Languages/B3/DDMFormatProgramsTests.lean | 9 +- .../B3/DDMFormatStatementsTests.lean | 8 +- StrataTest/Languages/B3/DDMFormatTests.lean | 10 +- .../B3/Verifier/TranslationTests.lean | 10 +- .../Languages/B3/Verifier/VerifierTests.lean | 12 +- .../Languages/C_Simp/Examples/Coprime.lean | 12 +- .../C_Simp/Examples/LinearSearch.lean | 12 +- .../C_Simp/Examples/LoopElimTests.lean | 12 +- .../Languages/C_Simp/Examples/LoopSimple.lean | 12 +- .../C_Simp/Examples/LoopTrivial.lean | 12 +- StrataTest/Languages/C_Simp/Examples/Min.lean | 10 +- .../Languages/C_Simp/Examples/SimpleTest.lean | 10 +- .../Languages/C_Simp/Examples/Trivial.lean | 10 +- .../Languages/Core/Examples/AdvancedMaps.lean | 7 +- .../Core/Examples/AdvancedQuantifiers.lean | 8 +- .../Languages/Core/Examples/AlwaysRunSMT.lean | 7 +- .../Languages/Core/Examples/Axioms.lean | 10 +- .../Core/Examples/BinaryTreeSize.lean | 6 +- .../Languages/Core/Examples/BitVecParse.lean | 7 +- .../Languages/Core/Examples/CallElim.lean | 8 +- StrataTest/Languages/Core/Examples/Cover.lean | 10 +- .../Core/Examples/CoverDiagnostics.lean | 7 +- .../Core/Examples/DDMAxiomsExtraction.lean | 263 +++++++++--------- .../Languages/Core/Examples/DDMTransform.lean | 6 +- .../Core/Examples/DatatypeAlias.lean | 6 +- .../Languages/Core/Examples/DatatypeEnum.lean | 6 +- .../Languages/Core/Examples/DatatypeList.lean | 6 +- .../Core/Examples/DatatypeOption.lean | 6 +- .../Languages/Core/Examples/DatatypeTree.lean | 6 +- StrataTest/Languages/Core/Examples/Exit.lean | 12 +- .../Core/Examples/FailingAssertion.lean | 8 +- .../Core/Examples/FreeRequireEnsure.lean | 7 +- .../Core/Examples/FunctionPreconditions.lean | 6 +- .../Languages/Core/Examples/Functions.lean | 9 +- StrataTest/Languages/Core/Examples/Havoc.lean | 7 +- StrataTest/Languages/Core/Examples/Loops.lean | 19 +- StrataTest/Languages/Core/Examples/Map.lean | 6 +- .../Languages/Core/Examples/MapBranching.lean | 6 +- StrataTest/Languages/Core/Examples/Min.lean | 7 +- .../Core/Examples/MutualDatatypes.lean | 6 +- .../Core/Examples/NoFilterWFProc.lean | 6 +- .../Core/Examples/OldExpressions.lean | 7 +- .../Core/Examples/ProcedureCall.lean | 9 +- .../Languages/Core/Examples/Quantifiers.lean | 8 +- .../Examples/QuantifiersWithTypeAliases.lean | 8 +- .../Core/Examples/RealBitVector.lean | 8 +- .../Core/Examples/RecursiveProcIte.lean | 8 +- StrataTest/Languages/Core/Examples/Regex.lean | 7 +- .../Core/Examples/RemoveIrrelevantAxioms.lean | 7 +- .../Languages/Core/Examples/SafeMap.lean | 10 +- .../Core/Examples/SelectiveVerification.lean | 8 +- StrataTest/Languages/Core/Examples/Seq.lean | 6 +- .../Languages/Core/Examples/SimpleProc.lean | 7 +- .../Languages/Core/Examples/String.lean | 7 +- .../Core/Examples/SubstFvarsCaptureTests.lean | 7 +- .../Languages/Core/Examples/TermFormula.lean | 6 +- .../Languages/Core/Examples/TypeAlias.lean | 7 +- .../Languages/Core/Examples/TypeDecl.lean | 7 +- .../Languages/Core/Examples/TypeDeclStmt.lean | 6 +- .../Examples/TypeVarImplicitlyQuantified.lean | 8 +- .../Core/Examples/UnreachableAssert.lean | 7 +- .../Core/Tests/AssertionDefaultNames.lean | 10 +- .../Core/Tests/AtSignDisambiguationTest.lean | 10 +- .../Core/Tests/CallElimWithOldGlobals.lean | 10 +- .../Languages/Core/Tests/CallGraphTest.lean | 7 +- .../Languages/Core/Tests/CmdEvalTests.lean | 7 +- .../Languages/Core/Tests/CoreOpTests.lean | 7 +- .../Languages/Core/Tests/DatatypeEval.lean | 8 +- .../Languages/Core/Tests/DatatypeTests.lean | 8 +- .../Core/Tests/DatatypeTypingTests.lean | 8 +- .../Core/Tests/DuplicateAssumeLabels.lean | 12 +- .../Core/Tests/DuplicateBlockLabels.lean | 10 +- .../Core/Tests/DuplicateDDMBindings.lean | 10 +- .../Languages/Core/Tests/ExprEvalTest.lean | 38 +-- .../Core/Tests/FuncDeclStmtTest.lean | 9 +- .../Core/Tests/FuncTypeCheckBody.lean | 10 +- .../Core/Tests/FunctionDeclDDMTest.lean | 10 +- .../Languages/Core/Tests/FunctionTests.lean | 7 +- .../Languages/Core/Tests/GeneratedLabels.lean | 10 +- .../Core/Tests/GenericCallFallbackTest.lean | 7 +- .../Core/Tests/IfElsePrecedenceTest.lean | 8 +- .../Tests/InlineAssertionMetadataTest.lean | 10 +- .../Languages/Core/Tests/Issue1146Test.lean | 8 +- .../Core/Tests/LambdaHigherOrderTests.lean | 12 +- .../Tests/LoopElimEntryInvariantTest.lean | 8 +- .../Languages/Core/Tests/ModelLiftTest.lean | 8 +- .../MutualRecursiveFunctionErrorTest.lean | 8 +- .../Tests/MutualRecursiveFunctionTests.lean | 8 +- .../Core/Tests/NestedVarScopingTest.lean | 12 +- .../Core/Tests/OverflowCheckTest.lean | 11 +- .../Languages/Core/Tests/PolyUnifTest.lean | 10 +- .../Core/Tests/PolymorphicDatatypeTest.lean | 8 +- .../Core/Tests/PolymorphicFunctionTest.lean | 10 +- .../Core/Tests/PolymorphicProcedureTest.lean | 8 +- .../Languages/Core/Tests/PrecedenceCheck.lean | 8 +- .../Core/Tests/ProcedureTypeTests.lean | 7 +- .../Core/Tests/ProgramEvalTests.lean | 10 +- .../Core/Tests/ProgramTypeTests.lean | 7 +- .../Core/Tests/QuantifierBvarIndexTest.lean | 10 +- .../Core/Tests/RecursiveFunctionDDMTest.lean | 8 +- .../Tests/RecursiveFunctionErrorTest.lean | 8 +- .../Core/Tests/RecursiveFunctionTests.lean | 8 +- .../Languages/Core/Tests/RoundtripTest.lean | 14 +- .../Core/Tests/SMTEncoderDatatypeTest.lean | 33 ++- .../Languages/Core/Tests/SMTEncoderTests.lean | 10 +- .../Core/Tests/SanitizeFilenameTest.lean | 7 +- .../Core/Tests/SarifOutputTests.lean | 11 +- .../Languages/Core/Tests/ShadowedVars.lean | 10 +- .../Core/Tests/StatementEvalTests.lean | 7 +- .../Core/Tests/StatementTypeTests.lean | 7 +- .../Languages/Core/Tests/StatisticsTest.lean | 12 +- .../Core/Tests/TerminationCheckTests.lean | 8 +- .../Languages/Core/Tests/TestASTtoCST.lean | 10 +- .../Languages/Core/Tests/TypeDeclTests.lean | 7 +- .../Languages/Core/Tests/VCGPathTests.lean | 10 +- StrataTest/Languages/Core/VCOutcomeTests.lean | 9 +- .../Languages/Dyn/Examples/Arithmetic.lean | 6 +- .../Languages/Dyn/Examples/BasicTypes.lean | 6 +- .../Languages/Dyn/Examples/ControlFlow.lean | 6 +- .../Languages/Dyn/Examples/FunctionCalls.lean | 6 +- .../Languages/Dyn/Examples/HeapOps.lean | 6 +- .../Dyn/Examples/ListOperations.lean | 6 +- .../Languages/Dyn/Examples/StringOps.lean | 6 +- .../Languages/Dyn/Examples/Trivial.lean | 7 +- .../Dyn/Examples/TypeIntrospection.lean | 6 +- .../AbstractToConcreteTreeTranslatorTest.lean | 15 +- .../Laurel/ConstrainedTypeElimTest.lean | 17 +- .../Laurel/DivisionByZeroCheckTest.lean | 10 +- .../Languages/Laurel/DuplicateNameTests.lean | 17 +- .../Fundamentals/T10_ConstrainedTypes.lean | 7 +- .../T10_ConstrainedTypesError.lean | 7 +- .../Examples/Fundamentals/T12_Operators.lean | 7 +- .../Examples/Fundamentals/T13_WhileLoops.lean | 7 +- .../Fundamentals/T14_Quantifiers.lean | 7 +- .../Fundamentals/T15_ShortCircuit.lean | 7 +- .../Fundamentals/T16_PropertySummary.lean | 7 +- .../Examples/Fundamentals/T17_ForLoop.lean | 7 +- .../Fundamentals/T18_RecursiveFunction.lean | 7 +- .../Fundamentals/T19_BitvectorTypes.lean | 7 +- .../Examples/Fundamentals/T19_InvokeOn.lean | 7 +- .../Examples/Fundamentals/T1_AssertFalse.lean | 7 +- .../Fundamentals/T20_InferTypeError.lean | 7 +- .../T20_TransparentBodyError.lean | 7 +- .../Fundamentals/T21_ExitMultiPathAssert.lean | 7 +- .../Fundamentals/T22_ArityMismatch.lean | 7 +- .../Fundamentals/T22_MultipleReturns.lean | 7 +- .../Fundamentals/T2_ImpureExpressions.lean | 7 +- .../T2_ImpureExpressionsError.lean | 7 +- .../Examples/Fundamentals/T3_ControlFlow.lean | 7 +- .../Fundamentals/T3_ControlFlowError.lean | 7 +- .../Examples/Fundamentals/T4_LoopJumps.lean | 7 +- .../Examples/Fundamentals/T4b_Exit.lean | 7 +- .../Fundamentals/T5_ProcedureCalls.lean | 7 +- .../Fundamentals/T6_Preconditions.lean | 7 +- .../Examples/Fundamentals/T7_Decreases.lean | 7 +- .../Fundamentals/T8_Postconditions.lean | 7 +- .../Fundamentals/T8_PostconditionsErrors.lean | 7 +- .../T8b_EarlyReturnPostconditions.lean | 7 +- .../Fundamentals/T8c_BodilessInlining.lean | 6 +- .../T8d_HeapMutatingValueReturn.lean | 7 +- .../Fundamentals/T9_Nondeterministic.lean | 7 +- .../Examples/Objects/T1_MutableFields.lean | 7 +- .../Examples/Objects/T2_ModifiesClauses.lean | 7 +- .../Examples/Objects/T5_inheritance.lean | 7 +- .../Objects/T5_inheritanceErrors.lean | 7 +- .../Laurel/Examples/Objects/T6_Datatypes.lean | 7 +- .../Objects/T7_InstanceProcedures.lean | 7 +- .../Objects/T8_NonCompositeModifies.lean | 7 +- .../Examples/PrimitiveTypes/T1_Decimals.lean | 7 +- .../Examples/PrimitiveTypes/T2_String.lean | 7 +- .../T2_StringConcatLifting.lean | 7 +- .../Laurel/LiftExpressionAssignmentsTest.lean | 15 +- .../Languages/Laurel/LiftHolesTest.lean | 19 +- .../LiftImperativeCallsInAssertTest.lean | 15 +- .../Languages/Laurel/MapStmtExprTest.lean | 18 +- .../Languages/Laurel/ResolutionKindTests.lean | 17 +- .../Languages/Laurel/StatisticsTest.lean | 17 +- StrataTest/Languages/Laurel/TestExamples.lean | 19 +- .../Languages/Laurel/TypeAliasElimTest.lean | 17 +- .../Languages/Python/CorePreludeTest.lean | 8 +- .../Languages/Python/PreludeVerifyTest.lean | 10 +- .../Languages/Python/PySpecArgTypeTest.lean | 8 +- .../Languages/Python/Regex/ReParserTests.lean | 6 +- .../Languages/Python/Regex/ReToCoreTests.lean | 8 +- .../Languages/Python/Specs/DeclsTest.lean | 7 +- StrataTest/Languages/Python/TestExamples.lean | 13 +- StrataTest/Languages/Python/ToLaurelTest.lean | 8 +- StrataTest/Transform/ANFEncoderTests.lean | 9 +- StrataTest/Transform/CallElim.lean | 22 +- StrataTest/Transform/DetToKleene.lean | 14 +- StrataTest/Transform/LoopElim.lean | 7 +- StrataTest/Transform/PrecondElim.lean | 12 +- StrataTest/Transform/ProcBodyVerify.lean | 10 +- StrataTest/Transform/ProcedureInlining.lean | 22 +- StrataTest/Transform/SymbolicEvalTests.lean | 11 +- StrataTest/Util/IO.lean | 7 +- StrataTest/Util/Python.lean | 3 +- StrataTest/Util/TestDiagnostics.lean | 10 +- .../Languages/Python/Issue1000Test.lean | 1 + .../Languages/Python/VerifyPythonTest.lean | 3 +- 245 files changed, 1852 insertions(+), 676 deletions(-) diff --git a/StrataTest/Backends/CBMC/GOTO/E2E_CoreToGOTO.lean b/StrataTest/Backends/CBMC/GOTO/E2E_CoreToGOTO.lean index a33056b01b..55eb7e676a 100644 --- a/StrataTest/Backends/CBMC/GOTO/E2E_CoreToGOTO.lean +++ b/StrataTest/Backends/CBMC/GOTO/E2E_CoreToGOTO.lean @@ -3,8 +3,10 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.Backends.CBMC.CollectSymbols -import Strata.Backends.CBMC.GOTO.CoreToGOTOPipeline +module +meta import Strata.Backends.CBMC.CollectSymbols +meta import Strata.Backends.CBMC.GOTO.CoreToGOTOPipeline +import Strata.DDM.Integration.Lean.HashCommands /-! ## End-to-end tests: Core program → GOTO JSON @@ -16,6 +18,8 @@ Core-to-GOTO gap-filling work: - Bitvector operations -/ +meta section + open Strata private def translateCore (p : Strata.Program) : Core.Program := @@ -372,3 +376,5 @@ procedure test(x : int) { assert! (gotoStr.splitOn "x must be positive").length > 1 -- It should NOT contain the default label as the comment assert! (gotoStr.splitOn "assert_0").length == 1 + +end diff --git a/StrataTest/Backends/CBMC/GOTO/ExprTests.lean b/StrataTest/Backends/CBMC/GOTO/ExprTests.lean index dddba35764..b66eeeb632 100644 --- a/StrataTest/Backends/CBMC/GOTO/ExprTests.lean +++ b/StrataTest/Backends/CBMC/GOTO/ExprTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Backends.CBMC.GOTO.Expr +meta import Strata.Backends.CBMC.GOTO.Expr + +meta section namespace CProverGOTO.Tests @@ -36,3 +39,4 @@ private def add_expr : Expr := #eval format add_expr end CProverGOTO.Tests +end diff --git a/StrataTest/Backends/CBMC/GOTO/LambdaToCProverGOTO.lean b/StrataTest/Backends/CBMC/GOTO/LambdaToCProverGOTO.lean index 0906556278..4e505fa3b4 100644 --- a/StrataTest/Backends/CBMC/GOTO/LambdaToCProverGOTO.lean +++ b/StrataTest/Backends/CBMC/GOTO/LambdaToCProverGOTO.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Backends.CBMC.GOTO.LambdaToCProverGOTO +meta import Strata.Backends.CBMC.GOTO.LambdaToCProverGOTO + +meta section namespace Lambda @@ -186,3 +189,4 @@ open LTy.Syntax in assert! idx.id == CProverGOTO.Expr.Identifier.nullary (.constant "0") end Lambda +end diff --git a/StrataTest/Backends/CBMC/GOTO/ToCProverGOTO.lean b/StrataTest/Backends/CBMC/GOTO/ToCProverGOTO.lean index 4f74eae46b..0d563e12a4 100644 --- a/StrataTest/Backends/CBMC/GOTO/ToCProverGOTO.lean +++ b/StrataTest/Backends/CBMC/GOTO/ToCProverGOTO.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Backends.CBMC.GOTO.LambdaToCProverGOTO -import Strata.DL.Imperative.ToCProverGOTO -import Strata.Backends.CBMC.GOTO.InstToJson +meta import all StrataTest.Backends.CBMC.GOTO.LambdaToCProverGOTO +meta import all Strata.DL.Imperative.ToCProverGOTO +meta import all Strata.Backends.CBMC.GOTO.InstToJson + +meta section ------------------------------------------------------------------------------- @@ -543,3 +546,5 @@ def ExampleNoPropertySummary : Imperative.Cmds LExprTP := ------------------------------------------------------------------------------- end + +end diff --git a/StrataTest/Backends/CBMC/SimpleAdd/SimpleAdd.lean b/StrataTest/Backends/CBMC/SimpleAdd/SimpleAdd.lean index 75ec025247..b20b610cc3 100644 --- a/StrataTest/Backends/CBMC/SimpleAdd/SimpleAdd.lean +++ b/StrataTest/Backends/CBMC/SimpleAdd/SimpleAdd.lean @@ -3,6 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module import Strata.Backends.CBMC.GOTO.CoreToCProverGOTO diff --git a/StrataTest/DL/Imperative/Arith.lean b/StrataTest/DL/Imperative/Arith.lean index 61b7fa404b..d67e19437f 100644 --- a/StrataTest/DL/Imperative/Arith.lean +++ b/StrataTest/DL/Imperative/Arith.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.DL.Imperative.ArithExpr -import StrataTest.DL.Imperative.ArithEval -import StrataTest.DL.Imperative.ArithType +meta import all StrataTest.DL.Imperative.ArithExpr +meta import all StrataTest.DL.Imperative.ArithEval +meta import all StrataTest.DL.Imperative.ArithType + +meta section --------------------------------------------------------------------- namespace Arith @@ -77,3 +80,4 @@ genNum: 0 end Arith --------------------------------------------------------------------- +end diff --git a/StrataTest/DL/Imperative/ArithEval.lean b/StrataTest/DL/Imperative/ArithEval.lean index 85a908fd69..8a0246a515 100644 --- a/StrataTest/DL/Imperative/ArithEval.lean +++ b/StrataTest/DL/Imperative/ArithEval.lean @@ -3,11 +3,14 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.DL.Imperative.ArithExpr -import Strata.DL.Imperative.CmdEval +import all StrataTest.DL.Imperative.ArithExpr +meta import Strata.DL.Imperative.CmdEval + +meta section namespace Arith @@ -230,3 +233,4 @@ genNum: 1 end Eval end Arith +end diff --git a/StrataTest/DL/Imperative/ArithExpr.lean b/StrataTest/DL/Imperative/ArithExpr.lean index 401b6db065..46959d1829 100644 --- a/StrataTest/DL/Imperative/ArithExpr.lean +++ b/StrataTest/DL/Imperative/ArithExpr.lean @@ -3,6 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module import Strata.DL.Imperative.Cmd import Strata.DL.Imperative.EvalError diff --git a/StrataTest/DL/Imperative/ArithType.lean b/StrataTest/DL/Imperative/ArithType.lean index c0cd92f189..35b0267bda 100644 --- a/StrataTest/DL/Imperative/ArithType.lean +++ b/StrataTest/DL/Imperative/ArithType.lean @@ -3,12 +3,14 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Imperative.CmdType -import StrataTest.DL.Imperative.ArithExpr +meta import Strata.DL.Imperative.CmdType +import all StrataTest.DL.Imperative.ArithExpr open Strata +meta section namespace Arith /-! ## Instantiate `Imperative`'s Type Checker @@ -215,3 +217,4 @@ private def testProgram8 : Cmds Arith.PureExpr := end TypeCheck end Arith +end diff --git a/StrataTest/DL/Imperative/CFGToCProverGOTO.lean b/StrataTest/DL/Imperative/CFGToCProverGOTO.lean index 09db1b9c23..3b00a093e7 100644 --- a/StrataTest/DL/Imperative/CFGToCProverGOTO.lean +++ b/StrataTest/DL/Imperative/CFGToCProverGOTO.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Imperative.CFGToCProverGOTO -import Strata.Transform.StructuredToUnstructured -import StrataTest.Backends.CBMC.GOTO.LambdaToCProverGOTO +meta import Strata.DL.Imperative.CFGToCProverGOTO +meta import Strata.Transform.StructuredToUnstructured +meta import all StrataTest.Backends.CBMC.GOTO.LambdaToCProverGOTO + +meta section /-! ## Tests for CFG-to-CProverGOTO translation @@ -310,3 +313,4 @@ info: ok: () ------------------------------------------------------------------------------- end +end diff --git a/StrataTest/DL/Imperative/DDMDefinition.lean b/StrataTest/DL/Imperative/DDMDefinition.lean index 308632d4cf..9136b765f8 100644 --- a/StrataTest/DL/Imperative/DDMDefinition.lean +++ b/StrataTest/DL/Imperative/DDMDefinition.lean @@ -3,6 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module import Strata.DDM.Integration.Lean --------------------------------------------------------------------- diff --git a/StrataTest/DL/Imperative/DDMTranslate.lean b/StrataTest/DL/Imperative/DDMTranslate.lean index 7e06275df1..6650817e78 100644 --- a/StrataTest/DL/Imperative/DDMTranslate.lean +++ b/StrataTest/DL/Imperative/DDMTranslate.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.DL.Imperative.Arith -import StrataTest.DL.Imperative.DDMDefinition +meta import all StrataTest.DL.Imperative.Arith +meta import all StrataTest.DL.Imperative.DDMDefinition +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace ArithPrograms open Std (ToFormat Format format) @@ -53,15 +57,21 @@ instance : Inhabited (TransBindings × Arith.Command) where default := ({}, .set "default_var" .nondet .empty) /-- -info: inductive ArithPrograms.ArithProgramsType : Type → Type +info: private inductive ArithPrograms.ArithProgramsType : Type → Type number of parameters: 1 constructors: -ArithPrograms.ArithProgramsType.bvar : {α : Type} → α → Nat → ArithProgramsType α -ArithPrograms.ArithProgramsType.tvar : {α : Type} → α → String → ArithProgramsType α -ArithPrograms.ArithProgramsType.fvar : {α : Type} → α → Nat → Array (ArithProgramsType α) → ArithProgramsType α -ArithPrograms.ArithProgramsType.arrow : {α : Type} → α → ArithProgramsType α → ArithProgramsType α → ArithProgramsType α -ArithPrograms.ArithProgramsType.bool : {α : Type} → α → ArithProgramsType α -ArithPrograms.ArithProgramsType.num : {α : Type} → α → ArithProgramsType α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.ArithProgramsType.bvar : {α : Type} → + α → Nat → ArithPrograms.ArithProgramsType✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.ArithProgramsType.tvar : {α : Type} → + α → String → ArithPrograms.ArithProgramsType✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.ArithProgramsType.fvar : {α : Type} → + α → Nat → Array (ArithPrograms.ArithProgramsType✝ α) → ArithPrograms.ArithProgramsType✝¹ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.ArithProgramsType.arrow : {α : Type} → + α → ArithPrograms.ArithProgramsType✝ α → ArithPrograms.ArithProgramsType✝ α → ArithPrograms.ArithProgramsType✝¹ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.ArithProgramsType.bool : {α : Type} → + α → ArithPrograms.ArithProgramsType✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.ArithProgramsType.num : {α : Type} → + α → ArithPrograms.ArithProgramsType✝ α -/ #guard_msgs in #print ArithProgramsType @@ -73,18 +83,23 @@ def translateType (tp : ArithProgramsType α) : Arith.Ty := | .bvar _ _ | .tvar _ _ | .fvar _ _ _ | .arrow _ _ _ => .Num /-- -info: inductive ArithPrograms.Expr : Type → Type +info: private inductive ArithPrograms.Expr : Type → Type number of parameters: 1 constructors: -ArithPrograms.Expr.fvar : {α : Type} → α → Nat → Expr α -ArithPrograms.Expr.bvar : {α : Type} → α → Nat → Expr α -ArithPrograms.Expr.app : {α : Type} → α → Expr α → Expr α → Expr α -ArithPrograms.Expr.numLit : {α : Type} → α → Strata.Ann Nat α → Expr α -ArithPrograms.Expr.btrue : {α : Type} → α → Expr α -ArithPrograms.Expr.bfalse : {α : Type} → α → Expr α -ArithPrograms.Expr.add_expr : {α : Type} → α → Expr α → Expr α → Expr α -ArithPrograms.Expr.mul_expr : {α : Type} → α → Expr α → Expr α → Expr α -ArithPrograms.Expr.eq_expr : {α : Type} → α → ArithProgramsType α → Expr α → Expr α → Expr α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Expr.fvar : {α : Type} → α → Nat → ArithPrograms.Expr✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Expr.bvar : {α : Type} → α → Nat → ArithPrograms.Expr✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Expr.app : {α : Type} → + α → ArithPrograms.Expr✝ α → ArithPrograms.Expr✝ α → ArithPrograms.Expr✝¹ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Expr.numLit : {α : Type} → + α → Strata.Ann Nat α → ArithPrograms.Expr✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Expr.btrue : {α : Type} → α → ArithPrograms.Expr✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Expr.bfalse : {α : Type} → α → ArithPrograms.Expr✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Expr.add_expr : {α : Type} → + α → ArithPrograms.Expr✝ α → ArithPrograms.Expr✝ α → ArithPrograms.Expr✝¹ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Expr.mul_expr : {α : Type} → + α → ArithPrograms.Expr✝ α → ArithPrograms.Expr✝ α → ArithPrograms.Expr✝¹ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Expr.eq_expr : {α : Type} → + α → ArithPrograms.ArithProgramsType✝ α → ArithPrograms.Expr✝ α → ArithPrograms.Expr✝ α → ArithPrograms.Expr✝¹ α -/ #guard_msgs in #print Expr @@ -113,10 +128,11 @@ def translateExpr (bindings : TransBindings) (e : ArithPrograms.Expr α) : Trans | .app .. => TransM.error "Unexpected app in ArithPrograms" /-- -info: inductive ArithPrograms.Label : Type → Type +info: private inductive ArithPrograms.Label : Type → Type number of parameters: 1 constructors: -ArithPrograms.Label.label : {α : Type} → α → Strata.Ann String α → Label α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Label.label : {α : Type} → + α → Strata.Ann String α → ArithPrograms.Label✝ α -/ #guard_msgs in #print Label @@ -125,15 +141,21 @@ def translateLabel (_bindings : TransBindings) (e : ArithPrograms.Label α) : Tr match e with | .label _ s => return s.val /-- -info: inductive ArithPrograms.Command : Type → Type +info: private inductive ArithPrograms.Command : Type → Type number of parameters: 1 constructors: -ArithPrograms.Command.init : {α : Type} → α → Strata.Ann String α → ArithProgramsType α → Expr α → Command α -ArithPrograms.Command.var : {α : Type} → α → Strata.Ann String α → ArithProgramsType α → Command α -ArithPrograms.Command.assign : {α : Type} → α → Strata.Ann String α → Expr α → Command α -ArithPrograms.Command.assume : {α : Type} → α → Label α → Expr α → Command α -ArithPrograms.Command.assert : {α : Type} → α → Label α → Expr α → Command α -ArithPrograms.Command.havoc : {α : Type} → α → Strata.Ann String α → Command α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Command.init : {α : Type} → + α → Strata.Ann String α → ArithPrograms.ArithProgramsType✝ α → ArithPrograms.Expr✝ α → ArithPrograms.Command✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Command.var : {α : Type} → + α → Strata.Ann String α → ArithPrograms.ArithProgramsType✝ α → ArithPrograms.Command✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Command.assign : {α : Type} → + α → Strata.Ann String α → ArithPrograms.Expr✝ α → ArithPrograms.Command✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Command.assume : {α : Type} → + α → ArithPrograms.Label✝ α → ArithPrograms.Expr✝ α → ArithPrograms.Command✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Command.assert : {α : Type} → + α → ArithPrograms.Label✝ α → ArithPrograms.Expr✝ α → ArithPrograms.Command✝ α +_private.StrataTest.DL.Imperative.DDMDefinition.0.ArithPrograms.Command.havoc : {α : Type} → + α → Strata.Ann String α → ArithPrograms.Command✝ α -/ #guard_msgs in #print Command @@ -201,7 +223,7 @@ assert [test]: (1 == 2); var y : num; #end -/-- info: (translateProgram testEnv.commands).run : Arith.Commands × Array Std.Format -/ +/-- info: (translateProgram testEnv.commands).run : Arith.Commands✝ × Array Std.Format -/ #guard_msgs in #check TransM.run (translateProgram (testEnv.commands)) @@ -220,3 +242,4 @@ init (y : Num) := (init_y_1 : Num) end section --------------------------------------------------------------------- +end diff --git a/StrataTest/DL/Imperative/Examples.lean b/StrataTest/DL/Imperative/Examples.lean index 957882be97..850a1f152c 100644 --- a/StrataTest/DL/Imperative/Examples.lean +++ b/StrataTest/DL/Imperative/Examples.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.DL.Imperative.Verify +meta import all StrataTest.DL.Imperative.Verify +import Strata.DDM.Integration.Lean.HashCommands + +meta section --------------------------------------------------------------------- namespace Strata @@ -95,3 +99,5 @@ Result: verified #eval Strata.ArithPrograms.verify testProgram3 --------------------------------------------------------------------- +end Strata +end diff --git a/StrataTest/DL/Imperative/FormatStmtTest.lean b/StrataTest/DL/Imperative/FormatStmtTest.lean index 3b4062c932..c1e6101c18 100644 --- a/StrataTest/DL/Imperative/FormatStmtTest.lean +++ b/StrataTest/DL/Imperative/FormatStmtTest.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.Languages.Core.Statement -import Strata.Languages.Core.DDMTransform.FormatCore +module +meta import Strata.Languages.Core.Statement +meta import Strata.Languages.Core.DDMTransform.FormatCore + +meta section namespace FormatStmtTest open Core @@ -174,3 +177,4 @@ info: { Statement.assert "check" xEq1 .empty] : Ss) end FormatStmtTest +end diff --git a/StrataTest/DL/Imperative/SMTEncoder.lean b/StrataTest/DL/Imperative/SMTEncoder.lean index 072f0d65f1..eff1c4fff9 100644 --- a/StrataTest/DL/Imperative/SMTEncoder.lean +++ b/StrataTest/DL/Imperative/SMTEncoder.lean @@ -3,12 +3,15 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.DL.Imperative.Arith -import Strata.DL.Imperative.EvalContext -import Strata.DL.SMT.SMT +meta import all StrataTest.DL.Imperative.Arith +meta import Strata.DL.Imperative.EvalContext +meta import Strata.DL.SMT.SMT import Init.Data.String.Extra +meta section + namespace Arith /-! ## SMT Encoder for `ArithPrograms`' Verification Conditions @@ -85,3 +88,4 @@ def encodeArithToSMTTerms (ts : List Term) : SolverM (List String × EncoderStat --------------------------------------------------------------------- end Arith +end diff --git a/StrataTest/DL/Imperative/StepStmtTest.lean b/StrataTest/DL/Imperative/StepStmtTest.lean index 15734ec0cc..4712b61e5e 100644 --- a/StrataTest/DL/Imperative/StepStmtTest.lean +++ b/StrataTest/DL/Imperative/StepStmtTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Imperative.StmtSemantics +meta import Strata.DL.Imperative.StmtSemantics +import all Strata.DL.Imperative.CmdSemantics + +meta section /-! # Tests for the small-step `StepStmt` semantics -/ @@ -538,3 +542,4 @@ theorem reinit_stuck : --------------------------------------------------------------------- end StepStmtTest +end diff --git a/StrataTest/DL/Imperative/Verify.lean b/StrataTest/DL/Imperative/Verify.lean index 49d54578c7..ac4f0844e7 100644 --- a/StrataTest/DL/Imperative/Verify.lean +++ b/StrataTest/DL/Imperative/Verify.lean @@ -3,11 +3,14 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.DL.Imperative.DDMTranslate -import StrataTest.DL.Imperative.SMTEncoder -import Strata.DL.Imperative.SMTUtils -import Strata.Pipeline.Messages +meta import all StrataTest.DL.Imperative.DDMTranslate +meta import all StrataTest.DL.Imperative.SMTEncoder +meta import Strata.DL.Imperative.SMTUtils +meta import Strata.Pipeline.Messages + +meta section --------------------------------------------------------------------- namespace Arith @@ -99,3 +102,4 @@ end ArithPrograms end Strata --------------------------------------------------------------------- +end diff --git a/StrataTest/DL/Lambda/AdtRankAxiomsModels.lean b/StrataTest/DL/Lambda/AdtRankAxiomsModels.lean index 283a1cc45e..1be9646c80 100644 --- a/StrataTest/DL/Lambda/AdtRankAxiomsModels.lean +++ b/StrataTest/DL/Lambda/AdtRankAxiomsModels.lean @@ -3,6 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /-! ## Models for adtRank Axioms diff --git a/StrataTest/DL/Lambda/AdtRankAxiomsTests.lean b/StrataTest/DL/Lambda/AdtRankAxiomsTests.lean index 6880efedb6..a8f6e77b3d 100644 --- a/StrataTest/DL/Lambda/AdtRankAxiomsTests.lean +++ b/StrataTest/DL/Lambda/AdtRankAxiomsTests.lean @@ -3,9 +3,10 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.AdtRankAxioms -import Strata.DL.Lambda.TypeFactory +meta import Strata.DL.Lambda.AdtRankAxioms +meta import Strata.DL.Lambda.TypeFactory /-! ## Tests for adtRank axiom generation @@ -14,6 +15,7 @@ Unit tests for `mkAdtRankFunc`, `mkAdtRankPerConstrAxioms`, and `mkAdtRankDeclsForBlock` from `AdtRankAxioms.lean`. -/ +meta section namespace Lambda open Std (ToFormat Format format) @@ -224,3 +226,4 @@ info: (∀ (bvar:RoseTree) (∀ (bvar:RoseList) ((~Int.Lt : (arrow int (arrow in #eval (mkAdtRankDeclsForBlock (T := TP) roseBlock ()).1.map (·.name) end Lambda +end diff --git a/StrataTest/DL/Lambda/FuncAttrTests.lean b/StrataTest/DL/Lambda/FuncAttrTests.lean index d69b45bebb..cea51615c7 100644 --- a/StrataTest/DL/Lambda/FuncAttrTests.lean +++ b/StrataTest/DL/Lambda/FuncAttrTests.lean @@ -3,9 +3,10 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.Lambda -import Strata.DL.Lambda.TypeFactory +meta import Strata.DL.Lambda.Lambda +meta import Strata.DL.Lambda.TypeFactory /-! ## Tests for FuncAttr with non-zero paramIdx @@ -14,6 +15,7 @@ Tests that `inlineIfConstr 1` correctly inlines when the second argument is a constructor application, and does not inline when it is symbolic. -/ +meta section namespace Lambda open Std (ToFormat Format format) @@ -91,3 +93,4 @@ info: ((~myIsNil : (arrow int (arrow MyList bool))) #42 (~xs_sym : MyList)) esM[((~myIsNil #42) ~xs_sym)] end Lambda +end diff --git a/StrataTest/DL/Lambda/LExprEqTests.lean b/StrataTest/DL/Lambda/LExprEqTests.lean index c087516fb0..242901ed80 100644 --- a/StrataTest/DL/Lambda/LExprEqTests.lean +++ b/StrataTest/DL/Lambda/LExprEqTests.lean @@ -3,11 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.LExprEval -import Strata.DL.Lambda.IntBoolFactory -import Strata.DL.Lambda.TypeFactory -import Strata.DL.Lambda.Lambda +meta import Strata.DL.Lambda.LExprEval +meta import Strata.DL.Lambda.IntBoolFactory +meta import Strata.DL.Lambda.TypeFactory +meta import Strata.DL.Lambda.Lambda /-! ## Tests for `eql` @@ -18,6 +19,7 @@ Tests that equality comparison correctly: - Proves equality and inequality of datatype constructor applications -/ +meta section namespace Lambda open LTy.Syntax LExpr.SyntaxMono @@ -174,3 +176,4 @@ private def constrFactory : Factory TP := esM[(((~MkTriple #1) #3) y)] end Lambda +end diff --git a/StrataTest/DL/Lambda/LExprEvalTests.lean b/StrataTest/DL/Lambda/LExprEvalTests.lean index fa25791f0f..901ae26370 100644 --- a/StrataTest/DL/Lambda/LExprEvalTests.lean +++ b/StrataTest/DL/Lambda/LExprEvalTests.lean @@ -3,12 +3,14 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.Semantics -import Strata.DL.Lambda.LExprEval +meta import all Strata.DL.Lambda.Semantics +meta import all Strata.DL.Lambda.LExprEval --------------------------------------------------------------------- +meta section namespace Lambda open Std (ToFormat Format format) @@ -770,3 +772,4 @@ end EvalTest --------------------------------------------------------------------- end LExpr end Lambda +end diff --git a/StrataTest/DL/Lambda/LExprTTests.lean b/StrataTest/DL/Lambda/LExprTTests.lean index 5bff65db07..5398ba79ab 100644 --- a/StrataTest/DL/Lambda/LExprTTests.lean +++ b/StrataTest/DL/Lambda/LExprTTests.lean @@ -3,9 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.LExprT +meta import Strata.DL.Lambda.LExprT +meta section namespace Lambda --------------------------------------------------------------------- open Std (ToFormat Format format) @@ -256,3 +258,4 @@ end Tests --------------------------------------------------------------------- end Lambda +end diff --git a/StrataTest/DL/Lambda/LExprTests.lean b/StrataTest/DL/Lambda/LExprTests.lean index 73003f587c..1510bf07aa 100644 --- a/StrataTest/DL/Lambda/LExprTests.lean +++ b/StrataTest/DL/Lambda/LExprTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.LExpr +meta import Strata.DL.Lambda.LExpr + +meta section namespace Lambda.LExpr.SyntaxTests diff --git a/StrataTest/DL/Lambda/LExprTypeEnvTests.lean b/StrataTest/DL/Lambda/LExprTypeEnvTests.lean index 84fa52b542..4695819d9e 100644 --- a/StrataTest/DL/Lambda/LExprTypeEnvTests.lean +++ b/StrataTest/DL/Lambda/LExprTypeEnvTests.lean @@ -3,11 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.LExprTypeEnv +meta import Strata.DL.Lambda.LExprTypeEnv /-! ## Tests for LExprTypeEnv -/ +meta section namespace Lambda open Std (ToFormat Format format) open LTy.Syntax @@ -163,3 +165,4 @@ info: ok: (x : $__ty0) (y : int) (z : $__ty0) return Signature.format ans.fst end Lambda +end diff --git a/StrataTest/DL/Lambda/LExprWFTests.lean b/StrataTest/DL/Lambda/LExprWFTests.lean index ca5acbaecb..293383a073 100644 --- a/StrataTest/DL/Lambda/LExprWFTests.lean +++ b/StrataTest/DL/Lambda/LExprWFTests.lean @@ -3,9 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.LExprWF +meta import Strata.DL.Lambda.LExprWF +meta section namespace Lambda.LExpr.WFTests open Lambda @@ -103,3 +105,4 @@ def qa (e : MonoExpr) : MonoExpr := .quant () .all "" .none (bv 0) e #guard substFvarsLifting (fv "x") [] == fv "x" end Lambda.LExpr.WFTests +end diff --git a/StrataTest/DL/Lambda/LTyTests.lean b/StrataTest/DL/Lambda/LTyTests.lean index 3db8b1e5fb..2dfc22bee2 100644 --- a/StrataTest/DL/Lambda/LTyTests.lean +++ b/StrataTest/DL/Lambda/LTyTests.lean @@ -3,11 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.LTy +meta import Strata.DL.Lambda.LTy /-! ## Tests for LTy -/ +meta section namespace Lambda open Std (format) @@ -53,7 +55,7 @@ info: [Lambda.LMonoTy.tcons "arrow" [Lambda.LMonoTy.ftvar "_dummy0", Lambda.LMon #eval LMonoTy.inputTypes mty[pair int bool] end Lambda - +end /-! ## Syntax Tests for LTy -/ diff --git a/StrataTest/DL/Lambda/LTyUnifyTests.lean b/StrataTest/DL/Lambda/LTyUnifyTests.lean index 4e0a042e89..ba973721e2 100644 --- a/StrataTest/DL/Lambda/LTyUnifyTests.lean +++ b/StrataTest/DL/Lambda/LTyUnifyTests.lean @@ -3,11 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.LTyUnify +meta import Strata.DL.Lambda.LTyUnify /-! ## Tests for LTyUnify -/ +meta section namespace Lambda open Std (ToFormat Format format) open LTy.Syntax @@ -39,3 +41,4 @@ First mismatch: (Map bool int) with int. | .error e => format e end Lambda +end diff --git a/StrataTest/DL/Lambda/Lambda.lean b/StrataTest/DL/Lambda/Lambda.lean index 9a74e57dc6..8178930db7 100644 --- a/StrataTest/DL/Lambda/Lambda.lean +++ b/StrataTest/DL/Lambda/Lambda.lean @@ -3,14 +3,16 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.Lambda -import Strata.DL.Lambda.IntBoolFactory +meta import Strata.DL.Lambda.Lambda +meta import Strata.DL.Lambda.IntBoolFactory --------------------------------------------------------------------- +meta section namespace Lambda open Std (ToFormat Format format) @@ -71,4 +73,6 @@ info: #150 end Test +end Lambda +end --------------------------------------------------------------------- diff --git a/StrataTest/DL/Lambda/PreconditionsTests.lean b/StrataTest/DL/Lambda/PreconditionsTests.lean index 2a76634f5c..51a3b9e40a 100644 --- a/StrataTest/DL/Lambda/PreconditionsTests.lean +++ b/StrataTest/DL/Lambda/PreconditionsTests.lean @@ -3,11 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.DL.Lambda.IntBoolFactory -import Strata.DL.Lambda.Preconditions +module +meta import Strata.DL.Lambda.IntBoolFactory +meta import Strata.DL.Lambda.Preconditions /-! # Preconditions Tests -/ +meta section namespace Lambda open Std (ToFormat Format format) @@ -106,3 +108,4 @@ info: [WFObligation(safeDiv, (∀ (bvar:int) ((~Bool.Implies : (arrow bool (arro esM[((λ (int): %0) ((~safeDiv a) b))] end Lambda +end diff --git a/StrataTest/DL/Lambda/RecursiveAxiomsTests.lean b/StrataTest/DL/Lambda/RecursiveAxiomsTests.lean index 2b149e941f..4ee46123d1 100644 --- a/StrataTest/DL/Lambda/RecursiveAxiomsTests.lean +++ b/StrataTest/DL/Lambda/RecursiveAxiomsTests.lean @@ -3,15 +3,17 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.RecursiveAxioms -import Strata.DL.Lambda.Lambda -import Strata.DL.Lambda.IntBoolFactory +meta import Strata.DL.Lambda.RecursiveAxioms +meta import Strata.DL.Lambda.Lambda +meta import Strata.DL.Lambda.IntBoolFactory /-! ## Tests for genRecursiveAxioms -/ +meta section namespace Lambda open Std (ToFormat Format format) @@ -255,3 +257,4 @@ info: (∀ (bvar:int) (∀ (bvar:int) (∀ (bvar:int) (∀ (bvar:IntList) (((~re | .ok axs => return format axs[1]! end Lambda +end diff --git a/StrataTest/DL/Lambda/ReflectTests.lean b/StrataTest/DL/Lambda/ReflectTests.lean index 266a74bebd..f8b1aca928 100644 --- a/StrataTest/DL/Lambda/ReflectTests.lean +++ b/StrataTest/DL/Lambda/ReflectTests.lean @@ -3,8 +3,9 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.Reflect +public import Strata.DL.Lambda.Reflect /-! ## Tests for Reflect -/ @@ -19,7 +20,7 @@ info: Lean.Expr.app (Lean.Expr.app (Lean.Expr.const `Map []) (Lean.Expr.const `I #guard_msgs in #eval LMonoTy.toExpr mty[Map int bool] -def test1 : MetaM Lean.Expr := +meta def test1 : MetaM Lean.Expr := LExpr.toExpr (.quant () .all "" (some mty[int]) (LExpr.noTrigger ()) (.eq () (.fvar () "x" mty[int]) (.bvar () 0))) @@ -60,7 +61,7 @@ open Lean Elab Tactic Expr Meta Term open Std (ToFormat Format format) open LTy.Syntax LExpr.Syntax -def test1' : MetaM Lean.Expr := +meta def test1' : MetaM Lean.Expr := LExpr.toExpr (.quant () .all "" (some mty[int]) (LExpr.noTrigger ()) (.eq () (.fvar () "x" mty[int]) (.bvar () 0))) @@ -73,7 +74,7 @@ elab "test1" : term => do #check test1 -def test2 : MetaM Lean.Expr := +meta def test2 : MetaM Lean.Expr := LExpr.toExpr (LExpr.app () (.abs () "" (some mty[bool]) (.bvar () 0)) (.eq () (.const () (.intConst 4)) (.const () (.intConst 4)))) diff --git a/StrataTest/DL/Lambda/ScopesTests.lean b/StrataTest/DL/Lambda/ScopesTests.lean index bf24bd3626..28d7acdee9 100644 --- a/StrataTest/DL/Lambda/ScopesTests.lean +++ b/StrataTest/DL/Lambda/ScopesTests.lean @@ -3,11 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.Scopes +meta import Strata.DL.Lambda.Scopes /-! ## Tests for Scopes -/ +meta section namespace Lambda open Std (ToFormat Format format) open LTy.Syntax LExpr.SyntaxMono @@ -64,3 +66,4 @@ info: (a : int) → (if #true then #8 else (a : int)) ("z", (mty[int], (.intConst () 100)))] end Lambda +end diff --git a/StrataTest/DL/Lambda/SubstFvarsBugFromState.lean b/StrataTest/DL/Lambda/SubstFvarsBugFromState.lean index fab49cf738..248f703a81 100644 --- a/StrataTest/DL/Lambda/SubstFvarsBugFromState.lean +++ b/StrataTest/DL/Lambda/SubstFvarsBugFromState.lean @@ -3,12 +3,14 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.LExprEval -import Strata.DL.Lambda.IntBoolFactory +meta import Strata.DL.Lambda.LExprEval +meta import Strata.DL.Lambda.IntBoolFactory /-! # Iterated substFvar bug in substFvarsFromState (LState) -/ +meta section namespace Lambda open LExpr LTy.Syntax LExpr.SyntaxMono @@ -40,3 +42,4 @@ private def result := LExpr.substFvarsFromState testState expr #eval format result end Lambda +end diff --git a/StrataTest/DL/Lambda/TestGen.lean b/StrataTest/DL/Lambda/TestGen.lean index 9503feec94..4e13507279 100644 --- a/StrataTest/DL/Lambda/TestGen.lean +++ b/StrataTest/DL/Lambda/TestGen.lean @@ -11,9 +11,14 @@ import Plausible.Gen public meta import Strata.DL.Lambda.Factory public meta import Strata.DL.Lambda.Identifiers -import Strata.DL.Lambda.IntBoolFactory +meta import Strata.DL.Lambda.IntBoolFactory public meta import Strata.DL.Lambda.LExpr -import Strata.DL.Lambda.LExprT +import all Strata.DL.Lambda.LExpr +meta import Strata.DL.Lambda.LExprT +import all Strata.DL.Lambda.IntBoolFactory +import all Strata.DL.Lambda.LExprT +import all Strata.DL.Lambda.LExprTypeEnv +import all Strata.DL.Lambda.LTy public meta import Strata.DL.Lambda.LExprTypeEnv public meta import Strata.DL.Lambda.LExprWF public meta import Strata.DL.Lambda.MetaData diff --git a/StrataTest/DL/Lambda/TestGenTests.lean b/StrataTest/DL/Lambda/TestGenTests.lean index ab4c416cbe..c12e406757 100644 --- a/StrataTest/DL/Lambda/TestGenTests.lean +++ b/StrataTest/DL/Lambda/TestGenTests.lean @@ -3,12 +3,15 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Util.Random -import StrataTest.DL.Lambda.TestGen +meta import all Strata.Util.Random +meta import all StrataTest.DL.Lambda.TestGen +meta import Strata.DL.Lambda.IntBoolFactory /-! ## Tests for TestGen -/ +meta section namespace Lambda open Plausible open LTy @@ -181,3 +184,4 @@ in factory continue end Lambda +end diff --git a/StrataTest/DL/Lambda/TypeFactoryTests.lean b/StrataTest/DL/Lambda/TypeFactoryTests.lean index 76d9fc443f..4d5b8d2465 100644 --- a/StrataTest/DL/Lambda/TypeFactoryTests.lean +++ b/StrataTest/DL/Lambda/TypeFactoryTests.lean @@ -3,10 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.Lambda.Lambda -import Strata.DL.Lambda.IntBoolFactory -import Strata.DL.Lambda.TypeFactory +meta import Strata.DL.Lambda.Lambda +meta import Strata.DL.Lambda.IntBoolFactory +meta import Strata.DL.Lambda.TypeFactory /-! # TypeFactory Tests @@ -20,6 +21,7 @@ functions). --------------------------------------------------------------------- +meta section namespace Lambda open Std (ToFormat Format format) @@ -1153,3 +1155,4 @@ Constructors: end MutualRecursion end Lambda +end diff --git a/StrataTest/DL/SMT/DDMTransform/TranslateTests.lean b/StrataTest/DL/SMT/DDMTransform/TranslateTests.lean index 5a2bde64ca..7f4c84cdaa 100644 --- a/StrataTest/DL/SMT/DDMTransform/TranslateTests.lean +++ b/StrataTest/DL/SMT/DDMTransform/TranslateTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.SMT.DDMTransform.Translate +meta import Strata.DL.SMT.DDMTransform.Translate + +meta section /-! ## Tests for SMT DDM Translate -/ @@ -49,3 +52,4 @@ namespace Strata.SMTDDM .quant .all [⟨"a", bv32⟩] trigger body)) end Strata.SMTDDM +end diff --git a/StrataTest/DL/SMT/DenoteTests.lean b/StrataTest/DL/SMT/DenoteTests.lean index 70c08d9ca4..54d29093c1 100644 --- a/StrataTest/DL/SMT/DenoteTests.lean +++ b/StrataTest/DL/SMT/DenoteTests.lean @@ -3,11 +3,71 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.SMT.Denote +meta import all Strata.DL.SMT.Denote +import all Strata.DL.SMT.TermType +import all Strata.DL.SMT.Term +import all Strata.DL.SMT.Op +import all Strata.Languages.Core.SMTEncoder + +meta section open Strata.SMT +-- In the module system, some definition bodies from non-module libraries (Std, +-- Init) are opaque to the kernel. We prove the needed emptiness facts via +-- `native_decide` and then use `simp` to rewrite them before `rfl`. +private theorem hashset_empty_isEmpty : ({} : Std.HashSet String).isEmpty = true := by + native_decide +@[simp] private theorem array_empty_isEmpty : + (#[] : Array α).isEmpty = true := by rfl +@[simp] private theorem map_empty_isEmpty : + (Map.empty : Map α β).isEmpty = true := by rfl + +-- The `denoteQuery` function uses `Std.HashSet.isEmpty` which is opaque +-- to the kernel in the module system. We unfold `denoteQuery`, resolve +-- the isEmpty checks, and normalize the Option monad before `rfl`. +-- Helper lemmas to normalize `Option` monad operations that the kernel +-- cannot reduce in the module system. +private theorem option_bind_some {f : α → Option β} {x : α} : + Option.bind (some x) f = f x := rfl +private theorem option_map_some {f : α → β} {x : α} : + Option.map f (some x) = some (f x) := rfl + +-- The `do { pure PUnit.unit; body }` desugars to `Bind.bind (pure PUnit.unit) (fun _ => body)`. +-- In the `Option` monad, `pure x = some x`, so after simp it becomes +-- `Option.bind (some PUnit.unit) (fun _ => body) = body`. +-- We add a `Pure.pure` + `Bind.bind` rewrite to handle this pattern. +private theorem option_pure_bind {f : PUnit → Option β} : + (Bind.bind (Pure.pure PUnit.unit : Option PUnit) f : Option β) = f PUnit.unit := rfl + +macro "denoteQuery_rfl" : tactic => + `(tactic| (simp only [denoteQuery, hashset_empty_isEmpty, array_empty_isEmpty, map_empty_isEmpty, + Bool.not_true, Bool.false_or, Bool.false_eq_true, ↓reduceIte, + option_bind_some, option_map_some, option_pure_bind, Option.map]; + rfl)) + +-- For examples with `sorts := #[...]`, `denoteBoolTermFromContext` involves +-- `bindUS`/`denoteSort` which the kernel cannot fully reduce. We use the +-- elaborator's `reduce` to normalize the LHS and then clean up the residual +-- `mkTypeFunType`/`mkNonemptyPred` applications. +private theorem mkISContext_nil : mkISContext [] = ∅ := by rfl +private theorem list_reverse_empty_map : List.reverse (∅ : Map α β) = ∅ := by rfl + +set_option linter.unusedSimpArgs false in +macro "denoteQuery_sorts_rfl" : tactic => + `(tactic| ( + unfold denoteQuery; + simp only [hashset_empty_isEmpty, array_empty_isEmpty, map_empty_isEmpty, + Bool.not_true, Bool.false_or, Bool.false_eq_true, ↓reduceIte, + option_pure_bind, mkISContext_nil, list_reverse_empty_map, + List.reverse_nil, List.reverse_cons, List.nil_append, + mkISContext, mkISContext.go]; + conv => lhs; reduce; + simp only [mkTypeFunType, Nat.repeat, mkNonemptyPred]; + rfl)) + /-- info: some (Int.ofNat 3) -/ #guard_msgs in #reduce denoteIntTermAux (.app .add [.prim (.int 1), .prim (.int 2)] (.prim .int)) @@ -26,7 +86,7 @@ example : let a := { id := "a", ty := .prim (.bitvec 32) } (denoteQuery {} [] (.quant .all [a] a (.app .bvugt [.prim (.bitvec (42 : BitVec 32)), a] (.prim (.bitvec 32))))) = .some (∀ (x : BitVec 32), 42 > x) := by - rfl + denoteQuery_rfl example : let a := { id := "a", args := [], out := .prim (.bitvec 32) } @@ -35,30 +95,38 @@ example : (.app .eq [.app .bvconcat [.app (.uf a) [] a.out, .app (.uf b) [] b.out] (.prim (.bitvec 48)), .app .bvconcat [.app (.uf b) [] b.out, .app (.uf a) [] a.out] (.prim (.bitvec 48))] (.prim .bool))) = .some (∀ (x : BitVec 32) (y : BitVec 16), x ++ y = y ++ x) := by - rfl + denoteQuery_rfl +set_option maxHeartbeats 40000000 in +set_option maxRecDepth 4096 in example : let α := { name := "α", arity := 0 } let a := { id := "a", args := [], out := .constr α.name [] } (denoteQuery { sorts := #[α], ufs := #[a] } [] (.app .eq [.app (.uf a) [] a.out, .app (.uf a) [] a.out] (.prim .bool))) = .some (∀ (α : Type) [Nonempty α] (x : α), x = x) := by - rfl + denoteQuery_sorts_rfl +set_option maxHeartbeats 40000000 in +set_option maxRecDepth 4096 in example : let α := { name := "α", arity := 1 } let a := { id := "a", args := [], out := .constr α.name [.prim .int] } (denoteQuery { sorts := #[α], ufs := #[a] } [] (.app .eq [.app (.uf a) [] a.out, .app (.uf a) [] a.out] (.prim .bool))) = .some (∀ (α : Type → Type) [∀ x, Nonempty (α x)] (x : α Int), x = x) := by - rfl + denoteQuery_sorts_rfl +set_option maxHeartbeats 80000000 in +set_option maxRecDepth 4096 in example : let α := { name := "α", arity := 2 } let β := { name := "β", arity := 0 } let a := { id := "a", args := [], out := .constr α.name [.constr β.name [], .prim .bool] } (denoteQuery { sorts := #[α, β], ufs := #[a] } [] (.app .eq [.app (.uf a) [] a.out, .app (.uf a) [] a.out] (.prim .bool))) = .some (∀ (α : Type → Type → Type) [∀ x y, Nonempty (α x y)] (β : Type) [Nonempty β] (x : α β Prop), x = x) := by - rfl + denoteQuery_sorts_rfl +set_option maxHeartbeats 80000000 in +set_option maxRecDepth 4096 in example : let α := { name := "α", arity := 2 } let β := { name := "β", arity := 0 } @@ -68,7 +136,7 @@ example : .some (∀ (α : Type → Type → Type) [∀ (x y : Type), Nonempty (α x y)] (β : Type) [Nonempty β], let γ := α β Prop ∀ (a : γ), a = a) := by - rfl + denoteQuery_sorts_rfl example : let α := ("α", .prim .bool) @@ -76,7 +144,7 @@ example : (denoteQuery { ufs := #[a], tySubst := [α] } [] (.app .not [.app (.uf a) [] a.out] (.prim .bool))) = .some (let α := Prop ∀ (a : α), ¬a) := by - rfl + denoteQuery_rfl example : let α := ("α", .prim .bool) @@ -84,26 +152,26 @@ example : (denoteQuery { ufs := #[a], tySubst := [α] } [] (.app .not [.app (.uf a) [] a.out] (.prim .bool))) = .some (let α := Prop ∀ (a : α), ¬a) := by - rfl + denoteQuery_rfl example : let a := { id := "a", args := [], out := .prim .int } (denoteQuery { ufs := #[a] } [] (.app .gt [.prim (.int 42), .app (.uf a) [] a.out] (.prim .int))) = .some (∀ (x : Int), 42 > x) := by - rfl + denoteQuery_rfl example : let a := { id := "a", args := [], out := .prim .int } (denoteQuery {ufs := #[a]} [] (.app .gt [.prim (.int 42), .app (.uf a) [] (.prim .int)] (.prim .int))) = .some (∀ (x : Int), 42 > x) := by - rfl + denoteQuery_rfl example : let f := { id := "f", args := [{ id := "a", ty := .prim .int }], out := .prim .int } let f3 := .app (.uf f) [.prim (.int 3)] (.prim .int) (denoteQuery {ufs := #[f]} [] (.app .gt [.prim (.int 42), f3] (.prim .int))) = .some (∀ (f : Int → Int), 42 > f 3) := by - rfl + denoteQuery_rfl example : let a := { id := "a", ty := .prim .int } @@ -111,7 +179,7 @@ example : let f3 := .app (.uf f.uf) [.prim (.int 3)] (.prim .int) (denoteQuery {ifs := #[f]} [] (.app .gt [.prim (.int 42), f3] (.prim .int))) = .some (let f (a : Int) := a + 2; 42 > f 3) := by - rfl + denoteQuery_rfl example : let ctx := { @@ -144,4 +212,5 @@ example : (TermType.prim (TermPrimType.bool)) (denoteQuery ctx ts t) = .some (∀ («$__n0» : Int), 0 < «$__n0» → «$__n0» ≥ 0 → 0 ≤ «$__n0» ∧ True) := by - rfl + denoteQuery_rfl +end diff --git a/StrataTest/DL/SMT/EncoderTests.lean b/StrataTest/DL/SMT/EncoderTests.lean index 5fcb5056ed..4d8aa7b9df 100644 --- a/StrataTest/DL/SMT/EncoderTests.lean +++ b/StrataTest/DL/SMT/EncoderTests.lean @@ -3,11 +3,16 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.SMT.Encoder +meta import all Strata.DL.SMT.Encoder +import all Strata.DL.SMT.Encoder +import all Init.Data.Repr +import all Strata.Util.Name /-! ## Tests and proofs for Strata.Name.disambiguate / Strata.Name.breakDisambiguated -/ +meta section namespace Strata.SMT.Encoder /-! ### Concrete roundtrip checks -/ @@ -24,6 +29,11 @@ namespace Strata.SMT.Encoder -- Names with existing disambiguation #guard Strata.Name.breakDisambiguated "x@1" == ("x", 2) +end Strata.SMT.Encoder +end + +namespace Strata.SMT.Encoder + /-! ### Roundtrip proof -/ /-! #### Helper: digitChar properties -/ diff --git a/StrataTest/DL/SMT/SolverTests.lean b/StrataTest/DL/SMT/SolverTests.lean index 4be2f4a0bb..d9f877a990 100644 --- a/StrataTest/DL/SMT/SolverTests.lean +++ b/StrataTest/DL/SMT/SolverTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.SMT.Solver +meta import Strata.DL.SMT.Solver + +meta section /-! ## Tests for Solver.termToSMTString / Solver.typeToSMTString error handling @@ -56,3 +59,5 @@ info: typeToSMTString correctly threw: Solver.typeToSMTString failed: don't know IO.println "ERROR: typeToSMTString did not throw" catch e => IO.println s!"typeToSMTString correctly threw: {e}" + +end diff --git a/StrataTest/DL/SMT/TranslateTests.lean b/StrataTest/DL/SMT/TranslateTests.lean index aee007efbc..82452ad725 100644 --- a/StrataTest/DL/SMT/TranslateTests.lean +++ b/StrataTest/DL/SMT/TranslateTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.DL.SMT.Translate +meta import Strata.DL.SMT.Translate + +meta section open Lean open Strata @@ -224,3 +227,5 @@ info: ∀ (α : Type → Type → Type) [inst : ∀ (α_1 α_2 : Type), Nonempty [(.app .mod [(.prim (.int 10)), (.prim (.int 3)), (.prim (.int 2))] (.prim .int)), (.prim (.int 1))] (.prim .bool)) + +end diff --git a/StrataTest/Languages/B3/DDMConversionErrorTests.lean b/StrataTest/Languages/B3/DDMConversionErrorTests.lean index 4536e3e953..c30bce3729 100644 --- a/StrataTest/Languages/B3/DDMConversionErrorTests.lean +++ b/StrataTest/Languages/B3/DDMConversionErrorTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.B3.DDMTransform.Conversion +meta import Strata.Languages.B3.DDMTransform.Conversion + +meta section /-! # B3 Conversion Error Tests @@ -115,3 +118,4 @@ Variable @1 not supported in concrete syntax (.binaryOp 0 (.add 0) (.id 10 1) (.id 20 1)) end StrataTest.B3.ConversionErrors +end diff --git a/StrataTest/Languages/B3/DDMFormatDeclarationsTests.lean b/StrataTest/Languages/B3/DDMFormatDeclarationsTests.lean index e89cbf8731..3e498123e7 100644 --- a/StrataTest/Languages/B3/DDMFormatDeclarationsTests.lean +++ b/StrataTest/Languages/B3/DDMFormatDeclarationsTests.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Languages.B3.DDMFormatTests -import Strata.Languages.B3.DDMTransform.Conversion +meta import all StrataTest.Languages.B3.DDMFormatTests +meta import Strata.Languages.B3.DDMTransform.Conversion + +meta section /-! # B3 Declaration Formatting Tests @@ -835,3 +838,4 @@ procedure incrementWithOld(inout x: int) end DeclarationRoundtripTests end B3 +end diff --git a/StrataTest/Languages/B3/DDMFormatExpressionsTests.lean b/StrataTest/Languages/B3/DDMFormatExpressionsTests.lean index aa0f574e22..7bfdfb1282 100644 --- a/StrataTest/Languages/B3/DDMFormatExpressionsTests.lean +++ b/StrataTest/Languages/B3/DDMFormatExpressionsTests.lean @@ -3,9 +3,10 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Languages.B3.DDMFormatTests -import Strata.Languages.B3.DDMTransform.Conversion +meta import all StrataTest.Languages.B3.DDMFormatTests +meta import Strata.Languages.B3.DDMTransform.Conversion /-! # B3 Expression Formatting Tests @@ -22,6 +23,7 @@ Expressions are wrapped in `check` statements (e.g., `check 5 + 3`) because: - The `check` wrapper itself is not part of the tested AST - only the expression `5 + 3` is tested -/ +meta section namespace B3 open Std (Format) @@ -826,3 +828,4 @@ info: 1 + (if true 2 else 3) end AssociativityAndPrecedenceTests end B3 +end diff --git a/StrataTest/Languages/B3/DDMFormatProgramsTests.lean b/StrataTest/Languages/B3/DDMFormatProgramsTests.lean index 7cda00af13..619f038de9 100644 --- a/StrataTest/Languages/B3/DDMFormatProgramsTests.lean +++ b/StrataTest/Languages/B3/DDMFormatProgramsTests.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Languages.B3.DDMFormatDeclarationsTests -import Strata.Languages.B3.DDMTransform.Conversion +meta import all StrataTest.Languages.B3.DDMFormatDeclarationsTests +meta import Strata.Languages.B3.DDMTransform.Conversion +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # B3 Program Formatting Tests @@ -383,3 +387,4 @@ procedure Print(a: string, b: string, c: string) end ProgramRoundtripTests end B3 +end diff --git a/StrataTest/Languages/B3/DDMFormatStatementsTests.lean b/StrataTest/Languages/B3/DDMFormatStatementsTests.lean index 3286fb100f..03ce0d8f01 100644 --- a/StrataTest/Languages/B3/DDMFormatStatementsTests.lean +++ b/StrataTest/Languages/B3/DDMFormatStatementsTests.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Languages.B3.DDMFormatTests -import Strata.Languages.B3.DDMTransform.Conversion +meta import all StrataTest.Languages.B3.DDMFormatTests +meta import Strata.Languages.B3.DDMTransform.Conversion + +meta section /-! # B3 Statement Formatting Tests @@ -624,3 +627,4 @@ info: end StatementRoundtripTests end B3 +end diff --git a/StrataTest/Languages/B3/DDMFormatTests.lean b/StrataTest/Languages/B3/DDMFormatTests.lean index a9c337435f..3aeed71384 100644 --- a/StrataTest/Languages/B3/DDMFormatTests.lean +++ b/StrataTest/Languages/B3/DDMFormatTests.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.B3.DDMTransform.ParseCST -import Strata.Languages.B3.DDMTransform.DefinitionAST -import Strata.Languages.B3.DDMTransform.Conversion +meta import Strata.Languages.B3.DDMTransform.ParseCST +meta import Strata.Languages.B3.DDMTransform.DefinitionAST +meta import Strata.Languages.B3.DDMTransform.Conversion + +meta section /-! # B3 DDM Formatting Test Utilities @@ -260,3 +263,4 @@ def cleanupDeclRepr (s : String) : String := s end B3 +end diff --git a/StrataTest/Languages/B3/Verifier/TranslationTests.lean b/StrataTest/Languages/B3/Verifier/TranslationTests.lean index 9253f0f39b..f1f9322eed 100644 --- a/StrataTest/Languages/B3/Verifier/TranslationTests.lean +++ b/StrataTest/Languages/B3/Verifier/TranslationTests.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.B3.Verifier -import Strata.Languages.B3.DDMTransform.ParseCST -import Strata.Languages.B3.DDMTransform.Conversion +meta import Strata.Languages.B3.Verifier +meta import Strata.Languages.B3.DDMTransform.ParseCST +meta import Strata.Languages.B3.DDMTransform.Conversion + +meta section /-! # B3 to SMT Translation Tests @@ -183,3 +186,4 @@ procedure test_invalid_pattern() { #end end B3.Verifier.TranslationTests +end diff --git a/StrataTest/Languages/B3/Verifier/VerifierTests.lean b/StrataTest/Languages/B3/Verifier/VerifierTests.lean index a07c8e27f9..6a12863d46 100644 --- a/StrataTest/Languages/B3/Verifier/VerifierTests.lean +++ b/StrataTest/Languages/B3/Verifier/VerifierTests.lean @@ -3,11 +3,14 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.B3.Verifier -import Strata.Languages.B3.DDMTransform.ParseCST -import Strata.Languages.B3.DDMTransform.Conversion -import Strata.DL.SMT.Solver +meta import Strata.Languages.B3.Verifier +meta import Strata.Languages.B3.DDMTransform.ParseCST +meta import Strata.Languages.B3.DDMTransform.Conversion +meta import Strata.DL.SMT.Solver + +meta section /-! # B3 Verifier Integration Tests @@ -542,3 +545,4 @@ procedure test_all_expressions() { } #end end B3.Verifier.Tests +end diff --git a/StrataTest/Languages/C_Simp/Examples/Coprime.lean b/StrataTest/Languages/C_Simp/Examples/Coprime.lean index 81c2179120..b5918a4340 100644 --- a/StrataTest/Languages/C_Simp/Examples/Coprime.lean +++ b/StrataTest/Languages/C_Simp/Examples/Coprime.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.C_Simp.C_Simp -import Strata.Languages.C_Simp.Verify +meta import all Strata.Languages.C_Simp.C_Simp +meta import all Strata.Languages.C_Simp.Verify +import Strata.DDM.Integration.Lean.HashCommands + +meta section def CoprimePgm := #strata @@ -75,7 +79,7 @@ info: function coprime { while (~Int.Gt i #1) (some i) - [[coprime_invariant_388_405]: #true] + [[coprime_invariant_475_492]: #true] { if (~Bool.And ((~Int.Mod b i) == #0) ((~Int.Mod a i) == #0)) { return := #false @@ -141,3 +145,5 @@ spec { -/ #guard_msgs in #eval Strata.to_core (Strata.C_Simp.get_program CoprimePgm) + +end diff --git a/StrataTest/Languages/C_Simp/Examples/LinearSearch.lean b/StrataTest/Languages/C_Simp/Examples/LinearSearch.lean index ab9a3c9c62..4b1dcac277 100644 --- a/StrataTest/Languages/C_Simp/Examples/LinearSearch.lean +++ b/StrataTest/Languages/C_Simp/Examples/LinearSearch.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.C_Simp.C_Simp -import Strata.Languages.C_Simp.Verify +meta import all Strata.Languages.C_Simp.C_Simp +meta import all Strata.Languages.C_Simp.Verify +import Strata.DDM.Integration.Lean.HashCommands + +meta section def LinearSearchEnv := #strata @@ -66,7 +70,7 @@ info: function linearSearch { while (~Int.Lt idx (~Array.Len arr)) (some (~Int.Sub (~Array.Len arr) idx)) - [[linearSearch_invariant_381_398]: #true] + [[linearSearch_invariant_468_485]: #true] { if (e == (~Array.Get arr idx)) { return := #true @@ -131,3 +135,5 @@ spec { #eval Strata.Core.formatProgram (Strata.to_core (Strata.C_Simp.get_program LinearSearchEnv)) (extraFreeVars := #["intArr", "boolArr", "Array.Len", "Array.Get"]) + +end diff --git a/StrataTest/Languages/C_Simp/Examples/LoopElimTests.lean b/StrataTest/Languages/C_Simp/Examples/LoopElimTests.lean index 61cc0f3a28..8c204a6ee5 100644 --- a/StrataTest/Languages/C_Simp/Examples/LoopElimTests.lean +++ b/StrataTest/Languages/C_Simp/Examples/LoopElimTests.lean @@ -3,10 +3,14 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.C_Simp.C_Simp -import Strata.Languages.C_Simp.Verify -import Strata.Languages.Core.CoreOp +meta import all Strata.Languages.C_Simp.C_Simp +meta import all Strata.Languages.C_Simp.Verify +meta import all Strata.Languages.Core.CoreOp +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! ## Loop elimination: deterministic guard without measure @@ -145,3 +149,5 @@ spec { -/ #guard_msgs in #eval Strata.to_core nondetLoopProgram + +end diff --git a/StrataTest/Languages/C_Simp/Examples/LoopSimple.lean b/StrataTest/Languages/C_Simp/Examples/LoopSimple.lean index 32a94f00f9..3354d8e227 100644 --- a/StrataTest/Languages/C_Simp/Examples/LoopSimple.lean +++ b/StrataTest/Languages/C_Simp/Examples/LoopSimple.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.C_Simp.C_Simp -import Strata.Languages.C_Simp.Verify +meta import all Strata.Languages.C_Simp.C_Simp +meta import all Strata.Languages.C_Simp.Verify +import Strata.DDM.Integration.Lean.HashCommands + +meta section def LoopSimplePgm := #strata @@ -68,7 +72,7 @@ info: function loopSimple { while (~Int.Lt i n) (some (~Int.Sub n i)) - [[loopSimple_invariant_370_417]: (~Bool.And (~Int.Le i n) ((~Int.Div (~Int.Mul i (~Int.Sub i #1)) #2) == sum))] + [[loopSimple_invariant_457_504]: (~Bool.And (~Int.Le i n) ((~Int.Div (~Int.Mul i (~Int.Sub i #1)) #2) == sum))] { sum := (~Int.Add sum i) i := (~Int.Add i #1) @@ -243,3 +247,5 @@ Result: ✅ pass -/ #guard_msgs in #eval Strata.C_Simp.verify LoopSimplePgm + +end diff --git a/StrataTest/Languages/C_Simp/Examples/LoopTrivial.lean b/StrataTest/Languages/C_Simp/Examples/LoopTrivial.lean index c27662e50f..25d0a90610 100644 --- a/StrataTest/Languages/C_Simp/Examples/LoopTrivial.lean +++ b/StrataTest/Languages/C_Simp/Examples/LoopTrivial.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.C_Simp.C_Simp -import Strata.Languages.C_Simp.Verify +meta import all Strata.Languages.C_Simp.C_Simp +meta import all Strata.Languages.C_Simp.Verify +import Strata.DDM.Integration.Lean.HashCommands + +meta section def LoopTrivialPgm := #strata @@ -62,7 +66,7 @@ info: function loopTrivial { while (~Int.Lt i n) (some (~Int.Sub n i)) - [[loopTrivial_invariant_347_368]: (~Int.Le i n)] + [[loopTrivial_invariant_434_455]: (~Int.Le i n)] { i := (~Int.Add i #1) } @@ -233,3 +237,5 @@ Result: ✅ pass -/ #guard_msgs in #eval Strata.C_Simp.verify LoopTrivialPgm + +end diff --git a/StrataTest/Languages/C_Simp/Examples/Min.lean b/StrataTest/Languages/C_Simp/Examples/Min.lean index 6ceb1da6ad..bb0c67a4c4 100644 --- a/StrataTest/Languages/C_Simp/Examples/Min.lean +++ b/StrataTest/Languages/C_Simp/Examples/Min.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.C_Simp.C_Simp -import Strata.Languages.C_Simp.Verify +meta import all Strata.Languages.C_Simp.C_Simp +meta import all Strata.Languages.C_Simp.Verify +import Strata.DDM.Integration.Lean.HashCommands + +meta section def MinPgm := #strata @@ -82,3 +86,5 @@ Result: ✅ pass -/ #guard_msgs in #eval Strata.C_Simp.verify MinPgm + +end diff --git a/StrataTest/Languages/C_Simp/Examples/SimpleTest.lean b/StrataTest/Languages/C_Simp/Examples/SimpleTest.lean index 1861b231df..a2367777b4 100644 --- a/StrataTest/Languages/C_Simp/Examples/SimpleTest.lean +++ b/StrataTest/Languages/C_Simp/Examples/SimpleTest.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.C_Simp.C_Simp -import Strata.Languages.C_Simp.Verify +meta import all Strata.Languages.C_Simp.C_Simp +meta import all Strata.Languages.C_Simp.Verify +import Strata.DDM.Integration.Lean.HashCommands + +meta section def SimpleTestEnv := #strata @@ -111,3 +115,5 @@ Result: ✅ pass -/ #guard_msgs in #eval Strata.C_Simp.verify SimpleTestEnv + +end diff --git a/StrataTest/Languages/C_Simp/Examples/Trivial.lean b/StrataTest/Languages/C_Simp/Examples/Trivial.lean index b757698be7..5791672499 100644 --- a/StrataTest/Languages/C_Simp/Examples/Trivial.lean +++ b/StrataTest/Languages/C_Simp/Examples/Trivial.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.C_Simp.C_Simp -import Strata.Languages.C_Simp.Verify +meta import all Strata.Languages.C_Simp.C_Simp +meta import all Strata.Languages.C_Simp.Verify +import Strata.DDM.Integration.Lean.HashCommands + +meta section def TrivialPgm := #strata @@ -64,3 +68,5 @@ Result: ✅ pass -/ #guard_msgs in #eval Strata.C_Simp.verify TrivialPgm + +end diff --git a/StrataTest/Languages/Core/Examples/AdvancedMaps.lean b/StrataTest/Languages/Core/Examples/AdvancedMaps.lean index 1af27aa0fc..34472b0c0d 100644 --- a/StrataTest/Languages/Core/Examples/AdvancedMaps.lean +++ b/StrataTest/Languages/Core/Examples/AdvancedMaps.lean @@ -3,10 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands -import Strata.Languages.Core.Verifier - +meta section --------------------------------------------------------------------- open Strata @@ -287,4 +289,5 @@ Result: ✅ pass #guard_msgs in #eval verify mapPgm (options := { Core.VerifyOptions.default with useArrayTheory := true }) +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/AdvancedQuantifiers.lean b/StrataTest/Languages/Core/Examples/AdvancedQuantifiers.lean index aac3dcd880..d39a1459cd 100644 --- a/StrataTest/Languages/Core/Examples/AdvancedQuantifiers.lean +++ b/StrataTest/Languages/Core/Examples/AdvancedQuantifiers.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -55,3 +58,6 @@ Result: ✅ pass -/ #guard_msgs in #eval verify advQuantPgm + +end Strata +end diff --git a/StrataTest/Languages/Core/Examples/AlwaysRunSMT.lean b/StrataTest/Languages/Core/Examples/AlwaysRunSMT.lean index 64d57e69a6..2735213cde 100644 --- a/StrataTest/Languages/Core/Examples/AlwaysRunSMT.lean +++ b/StrataTest/Languages/Core/Examples/AlwaysRunSMT.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -54,4 +57,6 @@ Number of `.smt2` files: 1 #guard_msgs in #eval runAndCheckForSMTFiles +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/Axioms.lean b/StrataTest/Languages/Core/Examples/Axioms.lean index 6ed5ff4f5c..14d9c506e8 100644 --- a/StrataTest/Languages/Core/Examples/Axioms.lean +++ b/StrataTest/Languages/Core/Examples/Axioms.lean @@ -3,11 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module +meta import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.CallGraph +import Strata.DDM.Integration.Lean.HashCommands -import Strata.Languages.Core.Verifier -import Strata.Languages.Core.CallGraph - +meta section --------------------------------------------------------------------- namespace Strata @@ -155,4 +157,6 @@ Result: ✅ pass #guard_msgs in #eval verify axiomPgm2 +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/BinaryTreeSize.lean b/StrataTest/Languages/Core/Examples/BinaryTreeSize.lean index f1257d2d10..3c2c562a2a 100644 --- a/StrataTest/Languages/Core/Examples/BinaryTreeSize.lean +++ b/StrataTest/Languages/Core/Examples/BinaryTreeSize.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section /-! # Binary Tree Size Test @@ -173,3 +176,4 @@ Result: ✅ pass #eval verify sizeIsLenPgm (options := .quiet) end Strata.BinaryTreeSizeTest +end diff --git a/StrataTest/Languages/Core/Examples/BitVecParse.lean b/StrataTest/Languages/Core/Examples/BitVecParse.lean index 8cf2b92617..2da4e5f8b6 100644 --- a/StrataTest/Languages/Core/Examples/BitVecParse.lean +++ b/StrataTest/Languages/Core/Examples/BitVecParse.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -50,4 +53,6 @@ Result: ❌ fail #guard_msgs in #eval verify pgm +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/CallElim.lean b/StrataTest/Languages/Core/Examples/CallElim.lean index ea1ce3d1ec..7faac0eff8 100644 --- a/StrataTest/Languages/Core/Examples/CallElim.lean +++ b/StrataTest/Languages/Core/Examples/CallElim.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier -import Strata.Transform.CallElim +meta import Strata.Languages.Core.Verifier +meta import Strata.Transform.CallElim +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -96,3 +99,4 @@ Result: ✅ pass --------------------------------------------------------------------- end Strata +end diff --git a/StrataTest/Languages/Core/Examples/Cover.lean b/StrataTest/Languages/Core/Examples/Cover.lean index a263fe539f..7c19ad75a5 100644 --- a/StrataTest/Languages/Core/Examples/Cover.lean +++ b/StrataTest/Languages/Core/Examples/Cover.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Options -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Options +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -350,3 +353,6 @@ Result: ✖️ always false if reached -/ #guard_msgs in #eval verify minimalVerbosePgm (options := {Core.VerifyOptions.quiet with checkLevel := .minimalVerbose, checkMode := .bugFinding}) + +end Strata +end diff --git a/StrataTest/Languages/Core/Examples/CoverDiagnostics.lean b/StrataTest/Languages/Core/Examples/CoverDiagnostics.lean index 65ca8c22ca..5f9390b5a1 100644 --- a/StrataTest/Languages/Core/Examples/CoverDiagnostics.lean +++ b/StrataTest/Languages/Core/Examples/CoverDiagnostics.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -82,4 +85,6 @@ info: #["assertion does not hold"] let diagnostics := results.filterMap toDiagnosticModel return diagnostics.map DiagnosticModel.message +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/DDMAxiomsExtraction.lean b/StrataTest/Languages/Core/Examples/DDMAxiomsExtraction.lean index d6ebf385b1..07d43d5b15 100644 --- a/StrataTest/Languages/Core/Examples/DDMAxiomsExtraction.lean +++ b/StrataTest/Languages/Core/Examples/DDMAxiomsExtraction.lean @@ -5,7 +5,11 @@ -/ -import Strata.Languages.Core.Verifier +module +meta import Strata.Languages.Core.Verifier + + +meta section --------------------------------------------------------------------- namespace Strata @@ -94,302 +98,302 @@ axiom [updatePreserves]: forall m : (Map v k), okk : k, kk : k, vv : v :: (m[kk: #eval IO.println examplePgm /-- -info: #[{ ann := { start := { byteIdx := 296 }, stop := { byteIdx := 303 } }, +info: #[{ ann := { start := { byteIdx := 323 }, stop := { byteIdx := 330 } }, name := { dialect := "Core", name := "command_typedecl" }, args := - ((Array.mkEmpty 2).push (ArgF.ident { start := { byteIdx := 301 }, stop := { byteIdx := 302 } } "k")).push - (ArgF.option { start := { byteIdx := 302 }, stop := { byteIdx := 302 } } none) }, - { ann := { start := { byteIdx := 304 }, stop := { byteIdx := 311 } }, + ((Array.mkEmpty 2).push (ArgF.ident { start := { byteIdx := 328 }, stop := { byteIdx := 329 } } "k")).push + (ArgF.option { start := { byteIdx := 329 }, stop := { byteIdx := 329 } } none) }, + { ann := { start := { byteIdx := 331 }, stop := { byteIdx := 338 } }, name := { dialect := "Core", name := "command_typedecl" }, args := - ((Array.mkEmpty 2).push (ArgF.ident { start := { byteIdx := 309 }, stop := { byteIdx := 310 } } "v")).push - (ArgF.option { start := { byteIdx := 310 }, stop := { byteIdx := 310 } } none) }, - { ann := { start := { byteIdx := 312 }, stop := { byteIdx := 391 } }, + ((Array.mkEmpty 2).push (ArgF.ident { start := { byteIdx := 336 }, stop := { byteIdx := 337 } } "v")).push + (ArgF.option { start := { byteIdx := 337 }, stop := { byteIdx := 337 } } none) }, + { ann := { start := { byteIdx := 339 }, stop := { byteIdx := 418 } }, name := { dialect := "Core", name := "command_axiom" }, args := ((Array.mkEmpty 2).push - (ArgF.option { start := { byteIdx := 318 }, stop := { byteIdx := 333 } } + (ArgF.option { start := { byteIdx := 345 }, stop := { byteIdx := 360 } } (some (ArgF.op - { ann := { start := { byteIdx := 318 }, stop := { byteIdx := 333 } }, + { ann := { start := { byteIdx := 345 }, stop := { byteIdx := 360 } }, name := { dialect := "Core", name := "label" }, args := (Array.mkEmpty 1).push - (ArgF.ident { start := { byteIdx := 319 }, stop := { byteIdx := 331 } } + (ArgF.ident { start := { byteIdx := 346 }, stop := { byteIdx := 358 } } "updateSelect") })))).push (ArgF.expr - (ExprF.app { start := { byteIdx := 334 }, stop := { byteIdx := 390 } } - (ExprF.app { start := { byteIdx := 334 }, stop := { byteIdx := 390 } } - (ExprF.fn { start := { byteIdx := 334 }, stop := { byteIdx := 390 } } + (ExprF.app { start := { byteIdx := 361 }, stop := { byteIdx := 417 } } + (ExprF.app { start := { byteIdx := 361 }, stop := { byteIdx := 417 } } + (ExprF.fn { start := { byteIdx := 361 }, stop := { byteIdx := 417 } } { dialect := "Core", name := "forall" }) (ArgF.op - { ann := { start := { byteIdx := 341 }, stop := { byteIdx := 365 } }, + { ann := { start := { byteIdx := 368 }, stop := { byteIdx := 392 } }, name := { dialect := "Core", name := "declPush" }, args := ((Array.mkEmpty 2).push (ArgF.op - { ann := { start := { byteIdx := 341 }, stop := { byteIdx := 358 } }, + { ann := { start := { byteIdx := 368 }, stop := { byteIdx := 385 } }, name := { dialect := "Core", name := "declPush" }, args := ((Array.mkEmpty 2).push (ArgF.op - { ann := { start := { byteIdx := 341 }, stop := { byteIdx := 351 } }, + { ann := { start := { byteIdx := 368 }, stop := { byteIdx := 378 } }, name := { dialect := "Core", name := "declAtom" }, args := (Array.mkEmpty 1).push (ArgF.op - { ann := { start := { byteIdx := 341 }, stop := { byteIdx := 351 } }, + { ann := { start := { byteIdx := 368 }, stop := { byteIdx := 378 } }, name := { dialect := "Core", name := "bind_mk" }, args := (((Array.mkEmpty 3).push (ArgF.ident - { start := { byteIdx := 341 }, - stop := { byteIdx := 342 } } + { start := { byteIdx := 368 }, + stop := { byteIdx := 369 } } "m")).push (ArgF.option - { start := { byteIdx := 344 }, stop := { byteIdx := 344 } } + { start := { byteIdx := 371 }, stop := { byteIdx := 371 } } none)).push (ArgF.type (TypeExprF.ident - { start := { byteIdx := 344 }, stop := { byteIdx := 347 } } + { start := { byteIdx := 371 }, stop := { byteIdx := 374 } } { dialect := "Core", name := "Map" } (((Array.mkEmpty 2).push (TypeExprF.fvar - { start := { byteIdx := 350 }, - stop := { byteIdx := 351 } } + { start := { byteIdx := 377 }, + stop := { byteIdx := 378 } } 1 (Array.mkEmpty 0))).push (TypeExprF.fvar - { start := { byteIdx := 348 }, - stop := { byteIdx := 349 } } + { start := { byteIdx := 375 }, + stop := { byteIdx := 376 } } 0 (Array.mkEmpty 0))))) }) })).push (ArgF.op - { ann := { start := { byteIdx := 353 }, stop := { byteIdx := 358 } }, + { ann := { start := { byteIdx := 380 }, stop := { byteIdx := 385 } }, name := { dialect := "Core", name := "bind_mk" }, args := (((Array.mkEmpty 3).push (ArgF.ident - { start := { byteIdx := 353 }, stop := { byteIdx := 355 } } + { start := { byteIdx := 380 }, stop := { byteIdx := 382 } } "kk")).push - (ArgF.option { start := { byteIdx := 357 }, stop := { byteIdx := 357 } } + (ArgF.option { start := { byteIdx := 384 }, stop := { byteIdx := 384 } } none)).push (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 357 }, stop := { byteIdx := 358 } } + (TypeExprF.fvar { start := { byteIdx := 384 }, stop := { byteIdx := 385 } } 0 (Array.mkEmpty 0))) }) })).push (ArgF.op - { ann := { start := { byteIdx := 360 }, stop := { byteIdx := 365 } }, + { ann := { start := { byteIdx := 387 }, stop := { byteIdx := 392 } }, name := { dialect := "Core", name := "bind_mk" }, args := (((Array.mkEmpty 3).push - (ArgF.ident { start := { byteIdx := 360 }, stop := { byteIdx := 362 } } + (ArgF.ident { start := { byteIdx := 387 }, stop := { byteIdx := 389 } } "vv")).push - (ArgF.option { start := { byteIdx := 364 }, stop := { byteIdx := 364 } } none)).push + (ArgF.option { start := { byteIdx := 391 }, stop := { byteIdx := 391 } } none)).push (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 364 }, stop := { byteIdx := 365 } } 1 + (TypeExprF.fvar { start := { byteIdx := 391 }, stop := { byteIdx := 392 } } 1 (Array.mkEmpty 0))) }) })) (ArgF.expr - (ExprF.app { start := { byteIdx := 369 }, stop := { byteIdx := 390 } } - (ExprF.app { start := { byteIdx := 369 }, stop := { byteIdx := 390 } } - (ExprF.app { start := { byteIdx := 369 }, stop := { byteIdx := 390 } } - (ExprF.fn { start := { byteIdx := 369 }, stop := { byteIdx := 390 } } + (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 417 } } + (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 417 } } + (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 417 } } + (ExprF.fn { start := { byteIdx := 396 }, stop := { byteIdx := 417 } } { dialect := "Core", name := "equal" }) (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 350 }, stop := { byteIdx := 351 } } 1 (Array.mkEmpty 0)))) + (TypeExprF.fvar { start := { byteIdx := 377 }, stop := { byteIdx := 378 } } 1 (Array.mkEmpty 0)))) (ArgF.expr - (ExprF.app { start := { byteIdx := 369 }, stop := { byteIdx := 384 } } - (ExprF.app { start := { byteIdx := 369 }, stop := { byteIdx := 384 } } - (ExprF.app { start := { byteIdx := 369 }, stop := { byteIdx := 384 } } - (ExprF.app { start := { byteIdx := 369 }, stop := { byteIdx := 384 } } - (ExprF.fn { start := { byteIdx := 369 }, stop := { byteIdx := 384 } } + (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 411 } } + (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 411 } } + (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 411 } } + (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 411 } } + (ExprF.fn { start := { byteIdx := 396 }, stop := { byteIdx := 411 } } { dialect := "Core", name := "map_get" }) (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 348 }, stop := { byteIdx := 349 } } 0 + (TypeExprF.fvar { start := { byteIdx := 375 }, stop := { byteIdx := 376 } } 0 (Array.mkEmpty 0)))) (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 350 }, stop := { byteIdx := 351 } } 1 + (TypeExprF.fvar { start := { byteIdx := 377 }, stop := { byteIdx := 378 } } 1 (Array.mkEmpty 0)))) (ArgF.expr - (ExprF.app { start := { byteIdx := 369 }, stop := { byteIdx := 380 } } - (ExprF.app { start := { byteIdx := 369 }, stop := { byteIdx := 380 } } - (ExprF.app { start := { byteIdx := 369 }, stop := { byteIdx := 380 } } - (ExprF.app { start := { byteIdx := 369 }, stop := { byteIdx := 380 } } - (ExprF.app { start := { byteIdx := 369 }, stop := { byteIdx := 380 } } - (ExprF.fn { start := { byteIdx := 369 }, stop := { byteIdx := 380 } } + (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 407 } } + (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 407 } } + (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 407 } } + (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 407 } } + (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 407 } } + (ExprF.fn { start := { byteIdx := 396 }, stop := { byteIdx := 407 } } { dialect := "Core", name := "map_set" }) (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 348 }, stop := { byteIdx := 349 } } 0 + (TypeExprF.fvar { start := { byteIdx := 375 }, stop := { byteIdx := 376 } } 0 (Array.mkEmpty 0)))) (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 350 }, stop := { byteIdx := 351 } } 1 + (TypeExprF.fvar { start := { byteIdx := 377 }, stop := { byteIdx := 378 } } 1 (Array.mkEmpty 0)))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 369 }, stop := { byteIdx := 370 } } 2))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 371 }, stop := { byteIdx := 373 } } 1))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 377 }, stop := { byteIdx := 379 } } 0))))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 381 }, stop := { byteIdx := 383 } } 1))))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 388 }, stop := { byteIdx := 390 } } 0)))))) }, - { ann := { start := { byteIdx := 392 }, stop := { byteIdx := 487 } }, + (ArgF.expr (ExprF.bvar { start := { byteIdx := 396 }, stop := { byteIdx := 397 } } 2))) + (ArgF.expr (ExprF.bvar { start := { byteIdx := 398 }, stop := { byteIdx := 400 } } 1))) + (ArgF.expr (ExprF.bvar { start := { byteIdx := 404 }, stop := { byteIdx := 406 } } 0))))) + (ArgF.expr (ExprF.bvar { start := { byteIdx := 408 }, stop := { byteIdx := 410 } } 1))))) + (ArgF.expr (ExprF.bvar { start := { byteIdx := 415 }, stop := { byteIdx := 417 } } 0)))))) }, + { ann := { start := { byteIdx := 419 }, stop := { byteIdx := 514 } }, name := { dialect := "Core", name := "command_axiom" }, args := ((Array.mkEmpty 2).push - (ArgF.option { start := { byteIdx := 398 }, stop := { byteIdx := 416 } } + (ArgF.option { start := { byteIdx := 425 }, stop := { byteIdx := 443 } } (some (ArgF.op - { ann := { start := { byteIdx := 398 }, stop := { byteIdx := 416 } }, + { ann := { start := { byteIdx := 425 }, stop := { byteIdx := 443 } }, name := { dialect := "Core", name := "label" }, args := (Array.mkEmpty 1).push - (ArgF.ident { start := { byteIdx := 399 }, stop := { byteIdx := 414 } } + (ArgF.ident { start := { byteIdx := 426 }, stop := { byteIdx := 441 } } "updatePreserves") })))).push (ArgF.expr - (ExprF.app { start := { byteIdx := 417 }, stop := { byteIdx := 486 } } - (ExprF.app { start := { byteIdx := 417 }, stop := { byteIdx := 486 } } - (ExprF.fn { start := { byteIdx := 417 }, stop := { byteIdx := 486 } } + (ExprF.app { start := { byteIdx := 444 }, stop := { byteIdx := 513 } } + (ExprF.app { start := { byteIdx := 444 }, stop := { byteIdx := 513 } } + (ExprF.fn { start := { byteIdx := 444 }, stop := { byteIdx := 513 } } { dialect := "Core", name := "forall" }) (ArgF.op - { ann := { start := { byteIdx := 424 }, stop := { byteIdx := 456 } }, + { ann := { start := { byteIdx := 451 }, stop := { byteIdx := 483 } }, name := { dialect := "Core", name := "declPush" }, args := ((Array.mkEmpty 2).push (ArgF.op - { ann := { start := { byteIdx := 424 }, stop := { byteIdx := 449 } }, + { ann := { start := { byteIdx := 451 }, stop := { byteIdx := 476 } }, name := { dialect := "Core", name := "declPush" }, args := ((Array.mkEmpty 2).push (ArgF.op - { ann := { start := { byteIdx := 424 }, stop := { byteIdx := 442 } }, + { ann := { start := { byteIdx := 451 }, stop := { byteIdx := 469 } }, name := { dialect := "Core", name := "declPush" }, args := ((Array.mkEmpty 2).push (ArgF.op { ann := - { start := { byteIdx := 424 }, stop := { byteIdx := 434 } }, + { start := { byteIdx := 451 }, stop := { byteIdx := 461 } }, name := { dialect := "Core", name := "declAtom" }, args := (Array.mkEmpty 1).push (ArgF.op { ann := - { start := { byteIdx := 424 }, - stop := { byteIdx := 434 } }, + { start := { byteIdx := 451 }, + stop := { byteIdx := 461 } }, name := { dialect := "Core", name := "bind_mk" }, args := (((Array.mkEmpty 3).push (ArgF.ident - { start := { byteIdx := 424 }, - stop := { byteIdx := 425 } } + { start := { byteIdx := 451 }, + stop := { byteIdx := 452 } } "m")).push (ArgF.option - { start := { byteIdx := 427 }, - stop := { byteIdx := 427 } } + { start := { byteIdx := 454 }, + stop := { byteIdx := 454 } } none)).push (ArgF.type (TypeExprF.ident - { start := { byteIdx := 427 }, - stop := { byteIdx := 430 } } + { start := { byteIdx := 454 }, + stop := { byteIdx := 457 } } { dialect := "Core", name := "Map" } (((Array.mkEmpty 2).push (TypeExprF.fvar - { start := { byteIdx := 433 }, - stop := { byteIdx := 434 } } + { start := { byteIdx := 460 }, + stop := { byteIdx := 461 } } 1 (Array.mkEmpty 0))).push (TypeExprF.fvar - { start := { byteIdx := 431 }, - stop := { byteIdx := 432 } } + { start := { byteIdx := 458 }, + stop := { byteIdx := 459 } } 0 (Array.mkEmpty 0))))) }) })).push (ArgF.op - { ann := { start := { byteIdx := 436 }, stop := { byteIdx := 442 } }, + { ann := { start := { byteIdx := 463 }, stop := { byteIdx := 469 } }, name := { dialect := "Core", name := "bind_mk" }, args := (((Array.mkEmpty 3).push (ArgF.ident - { start := { byteIdx := 436 }, - stop := { byteIdx := 439 } } + { start := { byteIdx := 463 }, + stop := { byteIdx := 466 } } "okk")).push (ArgF.option - { start := { byteIdx := 441 }, stop := { byteIdx := 441 } } + { start := { byteIdx := 468 }, stop := { byteIdx := 468 } } none)).push (ArgF.type (TypeExprF.fvar - { start := { byteIdx := 441 }, stop := { byteIdx := 442 } } 0 + { start := { byteIdx := 468 }, stop := { byteIdx := 469 } } 0 (Array.mkEmpty 0))) }) })).push (ArgF.op - { ann := { start := { byteIdx := 444 }, stop := { byteIdx := 449 } }, + { ann := { start := { byteIdx := 471 }, stop := { byteIdx := 476 } }, name := { dialect := "Core", name := "bind_mk" }, args := (((Array.mkEmpty 3).push (ArgF.ident - { start := { byteIdx := 444 }, stop := { byteIdx := 446 } } + { start := { byteIdx := 471 }, stop := { byteIdx := 473 } } "kk")).push - (ArgF.option { start := { byteIdx := 448 }, stop := { byteIdx := 448 } } + (ArgF.option { start := { byteIdx := 475 }, stop := { byteIdx := 475 } } none)).push (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 448 }, stop := { byteIdx := 449 } } + (TypeExprF.fvar { start := { byteIdx := 475 }, stop := { byteIdx := 476 } } 0 (Array.mkEmpty 0))) }) })).push (ArgF.op - { ann := { start := { byteIdx := 451 }, stop := { byteIdx := 456 } }, + { ann := { start := { byteIdx := 478 }, stop := { byteIdx := 483 } }, name := { dialect := "Core", name := "bind_mk" }, args := (((Array.mkEmpty 3).push - (ArgF.ident { start := { byteIdx := 451 }, stop := { byteIdx := 453 } } + (ArgF.ident { start := { byteIdx := 478 }, stop := { byteIdx := 480 } } "vv")).push - (ArgF.option { start := { byteIdx := 455 }, stop := { byteIdx := 455 } } none)).push + (ArgF.option { start := { byteIdx := 482 }, stop := { byteIdx := 482 } } none)).push (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 455 }, stop := { byteIdx := 456 } } 1 + (TypeExprF.fvar { start := { byteIdx := 482 }, stop := { byteIdx := 483 } } 1 (Array.mkEmpty 0))) }) })) (ArgF.expr - (ExprF.app { start := { byteIdx := 460 }, stop := { byteIdx := 486 } } - (ExprF.app { start := { byteIdx := 460 }, stop := { byteIdx := 486 } } - (ExprF.app { start := { byteIdx := 460 }, stop := { byteIdx := 486 } } - (ExprF.fn { start := { byteIdx := 460 }, stop := { byteIdx := 486 } } + (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 513 } } + (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 513 } } + (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 513 } } + (ExprF.fn { start := { byteIdx := 487 }, stop := { byteIdx := 513 } } { dialect := "Core", name := "equal" }) (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 433 }, stop := { byteIdx := 434 } } 1 (Array.mkEmpty 0)))) + (TypeExprF.fvar { start := { byteIdx := 460 }, stop := { byteIdx := 461 } } 1 (Array.mkEmpty 0)))) (ArgF.expr - (ExprF.app { start := { byteIdx := 460 }, stop := { byteIdx := 476 } } - (ExprF.app { start := { byteIdx := 460 }, stop := { byteIdx := 476 } } - (ExprF.app { start := { byteIdx := 460 }, stop := { byteIdx := 476 } } - (ExprF.app { start := { byteIdx := 460 }, stop := { byteIdx := 476 } } - (ExprF.fn { start := { byteIdx := 460 }, stop := { byteIdx := 476 } } + (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 503 } } + (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 503 } } + (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 503 } } + (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 503 } } + (ExprF.fn { start := { byteIdx := 487 }, stop := { byteIdx := 503 } } { dialect := "Core", name := "map_get" }) (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 431 }, stop := { byteIdx := 432 } } 0 + (TypeExprF.fvar { start := { byteIdx := 458 }, stop := { byteIdx := 459 } } 0 (Array.mkEmpty 0)))) (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 433 }, stop := { byteIdx := 434 } } 1 + (TypeExprF.fvar { start := { byteIdx := 460 }, stop := { byteIdx := 461 } } 1 (Array.mkEmpty 0)))) (ArgF.expr - (ExprF.app { start := { byteIdx := 460 }, stop := { byteIdx := 471 } } - (ExprF.app { start := { byteIdx := 460 }, stop := { byteIdx := 471 } } - (ExprF.app { start := { byteIdx := 460 }, stop := { byteIdx := 471 } } - (ExprF.app { start := { byteIdx := 460 }, stop := { byteIdx := 471 } } - (ExprF.app { start := { byteIdx := 460 }, stop := { byteIdx := 471 } } - (ExprF.fn { start := { byteIdx := 460 }, stop := { byteIdx := 471 } } + (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 498 } } + (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 498 } } + (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 498 } } + (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 498 } } + (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 498 } } + (ExprF.fn { start := { byteIdx := 487 }, stop := { byteIdx := 498 } } { dialect := "Core", name := "map_set" }) (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 431 }, stop := { byteIdx := 432 } } 0 + (TypeExprF.fvar { start := { byteIdx := 458 }, stop := { byteIdx := 459 } } 0 (Array.mkEmpty 0)))) (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 433 }, stop := { byteIdx := 434 } } 1 + (TypeExprF.fvar { start := { byteIdx := 460 }, stop := { byteIdx := 461 } } 1 (Array.mkEmpty 0)))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 460 }, stop := { byteIdx := 461 } } 3))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 462 }, stop := { byteIdx := 464 } } 1))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 468 }, stop := { byteIdx := 470 } } 0))))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 472 }, stop := { byteIdx := 475 } } 2))))) + (ArgF.expr (ExprF.bvar { start := { byteIdx := 487 }, stop := { byteIdx := 488 } } 3))) + (ArgF.expr (ExprF.bvar { start := { byteIdx := 489 }, stop := { byteIdx := 491 } } 1))) + (ArgF.expr (ExprF.bvar { start := { byteIdx := 495 }, stop := { byteIdx := 497 } } 0))))) + (ArgF.expr (ExprF.bvar { start := { byteIdx := 499 }, stop := { byteIdx := 502 } } 2))))) (ArgF.expr - (ExprF.app { start := { byteIdx := 480 }, stop := { byteIdx := 486 } } - (ExprF.app { start := { byteIdx := 480 }, stop := { byteIdx := 486 } } - (ExprF.app { start := { byteIdx := 480 }, stop := { byteIdx := 486 } } - (ExprF.app { start := { byteIdx := 480 }, stop := { byteIdx := 486 } } - (ExprF.fn { start := { byteIdx := 480 }, stop := { byteIdx := 486 } } + (ExprF.app { start := { byteIdx := 507 }, stop := { byteIdx := 513 } } + (ExprF.app { start := { byteIdx := 507 }, stop := { byteIdx := 513 } } + (ExprF.app { start := { byteIdx := 507 }, stop := { byteIdx := 513 } } + (ExprF.app { start := { byteIdx := 507 }, stop := { byteIdx := 513 } } + (ExprF.fn { start := { byteIdx := 507 }, stop := { byteIdx := 513 } } { dialect := "Core", name := "map_get" }) (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 431 }, stop := { byteIdx := 432 } } 0 + (TypeExprF.fvar { start := { byteIdx := 458 }, stop := { byteIdx := 459 } } 0 (Array.mkEmpty 0)))) (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 433 }, stop := { byteIdx := 434 } } 1 + (TypeExprF.fvar { start := { byteIdx := 460 }, stop := { byteIdx := 461 } } 1 (Array.mkEmpty 0)))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 480 }, stop := { byteIdx := 481 } } 3))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 482 }, stop := { byteIdx := 485 } } 2)))))))) }] + (ArgF.expr (ExprF.bvar { start := { byteIdx := 507 }, stop := { byteIdx := 508 } } 3))) + (ArgF.expr (ExprF.bvar { start := { byteIdx := 509 }, stop := { byteIdx := 512 } } 2)))))))) }] -/ #guard_msgs in #eval examplePgm.commands @@ -464,3 +468,6 @@ info: [LExpr.quant () QuantifierKind.all "m" (some Lambda.LMonoTy.tcons #guard_msgs in #eval extractAxiomsWithFreeTypeVars examplePgm ["k", "v"] + +end Strata +end diff --git a/StrataTest/Languages/Core/Examples/DDMTransform.lean b/StrataTest/Languages/Core/Examples/DDMTransform.lean index e17b1b8d17..10d6de67bd 100644 --- a/StrataTest/Languages/Core/Examples/DDMTransform.lean +++ b/StrataTest/Languages/Core/Examples/DDMTransform.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -99,4 +102,5 @@ procedure MS_check (x1: int, x2: int, g: int, out r1: int, out r2: int, out g': end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/DatatypeAlias.lean b/StrataTest/Languages/Core/Examples/DatatypeAlias.lean index e2419e2f0d..cec43749fa 100644 --- a/StrataTest/Languages/Core/Examples/DatatypeAlias.lean +++ b/StrataTest/Languages/Core/Examples/DatatypeAlias.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section /-! # Datatype with Type Alias Test @@ -63,3 +66,4 @@ Result: ✅ pass #eval verify datatypeAliasPgm (options := .quiet) end Strata.DatatypeAliasTest +end diff --git a/StrataTest/Languages/Core/Examples/DatatypeEnum.lean b/StrataTest/Languages/Core/Examples/DatatypeEnum.lean index dc7142de36..731779771b 100644 --- a/StrataTest/Languages/Core/Examples/DatatypeEnum.lean +++ b/StrataTest/Languages/Core/Examples/DatatypeEnum.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section /-! # Datatype Enum Integration Test @@ -176,3 +179,4 @@ Result: ✅ pass #eval verify enumExhaustivePgm (options := .quiet) end Strata.DatatypeEnumTest +end diff --git a/StrataTest/Languages/Core/Examples/DatatypeList.lean b/StrataTest/Languages/Core/Examples/DatatypeList.lean index 8de9b63250..a800d87d40 100644 --- a/StrataTest/Languages/Core/Examples/DatatypeList.lean +++ b/StrataTest/Languages/Core/Examples/DatatypeList.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section /-! # Datatype List Integration Test @@ -569,3 +572,4 @@ Result: ✅ pass #eval verify listDifferentValuesPgm (options := .quiet) end Strata.DatatypeListTest +end diff --git a/StrataTest/Languages/Core/Examples/DatatypeOption.lean b/StrataTest/Languages/Core/Examples/DatatypeOption.lean index 1404c36b89..ca1f7363db 100644 --- a/StrataTest/Languages/Core/Examples/DatatypeOption.lean +++ b/StrataTest/Languages/Core/Examples/DatatypeOption.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section /-! # Datatype Option Integration Test @@ -391,3 +394,4 @@ Result: ✅ pass #eval verify optionDestructorPgm (options := .quiet) end Strata.DatatypeOptionTest +end diff --git a/StrataTest/Languages/Core/Examples/DatatypeTree.lean b/StrataTest/Languages/Core/Examples/DatatypeTree.lean index a5612c4686..8d983e6730 100644 --- a/StrataTest/Languages/Core/Examples/DatatypeTree.lean +++ b/StrataTest/Languages/Core/Examples/DatatypeTree.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section /-! # Datatype Tree Integration Test @@ -626,3 +629,4 @@ Result: ✅ pass #eval verify treeDifferentValuesPgm (options := .quiet) end Strata.DatatypeTreeTest +end diff --git a/StrataTest/Languages/Core/Examples/Exit.lean b/StrataTest/Languages/Core/Examples/Exit.lean index 53dedb039d..492e91b63f 100644 --- a/StrataTest/Languages/Core/Examples/Exit.lean +++ b/StrataTest/Languages/Core/Examples/Exit.lean @@ -3,11 +3,14 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Core -import Strata.Languages.Core.Verifier -import StrataTest.Languages.Core.Examples.Loops +meta import Strata.Languages.Core.Core +meta import Strata.Languages.Core.Verifier +meta import StrataTest.Languages.Core.Examples.Loops +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -161,3 +164,6 @@ end$_0: -/ #guard_msgs in #eval (Std.format (singleCFG exitPgm 1)) + +end Strata +end diff --git a/StrataTest/Languages/Core/Examples/FailingAssertion.lean b/StrataTest/Languages/Core/Examples/FailingAssertion.lean index 8f07e1b2ad..d0526a6b69 100644 --- a/StrataTest/Languages/Core/Examples/FailingAssertion.lean +++ b/StrataTest/Languages/Core/Examples/FailingAssertion.lean @@ -3,10 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands -import Strata.Languages.Core.Verifier - +meta section --------------------------------------------------------------------- open Strata @@ -89,3 +91,5 @@ Result: ❌ fail -/ #guard_msgs in #eval verify failingThrice (options := .quiet) + +end diff --git a/StrataTest/Languages/Core/Examples/FreeRequireEnsure.lean b/StrataTest/Languages/Core/Examples/FreeRequireEnsure.lean index 43b4c86f13..c234c8524c 100644 --- a/StrataTest/Languages/Core/Examples/FreeRequireEnsure.lean +++ b/StrataTest/Languages/Core/Examples/FreeRequireEnsure.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -75,4 +78,6 @@ Model: #guard_msgs in #eval verify freeReqEnsPgm +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/FunctionPreconditions.lean b/StrataTest/Languages/Core/Examples/FunctionPreconditions.lean index 04f09ead9b..96fd627bc5 100644 --- a/StrataTest/Languages/Core/Examples/FunctionPreconditions.lean +++ b/StrataTest/Languages/Core/Examples/FunctionPreconditions.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section /-! # Function Preconditions Tests -/ namespace Strata @@ -556,3 +559,4 @@ Result: ✅ pass #eval verify loopGuardPrecondPgm end Strata +end diff --git a/StrataTest/Languages/Core/Examples/Functions.lean b/StrataTest/Languages/Core/Examples/Functions.lean index 6ef76c128f..021beb48ad 100644 --- a/StrataTest/Languages/Core/Examples/Functions.lean +++ b/StrataTest/Languages/Core/Examples/Functions.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier -import Strata.Languages.Core.CallGraph +meta import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.CallGraph +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -151,4 +154,6 @@ Result: ✅ pass #guard_msgs in #eval verify quantBodyFuncPgm +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/Havoc.lean b/StrataTest/Languages/Core/Examples/Havoc.lean index c93468c739..590df27d98 100644 --- a/StrataTest/Languages/Core/Examples/Havoc.lean +++ b/StrataTest/Languages/Core/Examples/Havoc.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -62,4 +65,6 @@ Model: #guard_msgs in #eval verify havocPgm +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/Loops.lean b/StrataTest/Languages/Core/Examples/Loops.lean index ddcddd7c62..108bbc6fe1 100644 --- a/StrataTest/Languages/Core/Examples/Loops.lean +++ b/StrataTest/Languages/Core/Examples/Loops.lean @@ -3,11 +3,21 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ - -import Strata.Languages.Core.Program +module import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier import Strata.Transform.StructuredToUnstructured - +import Lean.Parser.Types +meta import Strata.Languages.Core.DDMTransform.Grammar +meta import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Languages.Core.Options +public import Strata.DDM.AST +public import Strata.DL.Imperative.BasicBlock +public import Strata.Languages.Core.Statement +public import Strata.Languages.Core.Expressions +import Strata.DDM.Integration.Lean.HashCommands + +public section namespace Strata def singleCFG (p : Program) (n : Nat) : Imperative.CFG String @@ -669,3 +679,6 @@ Result: ✅ pass -/ #guard_msgs in #eval verify precondElimMeasureBodyMutatesPgm (options := .quiet) + +end Strata +end diff --git a/StrataTest/Languages/Core/Examples/Map.lean b/StrataTest/Languages/Core/Examples/Map.lean index e4510f2af9..93bd2e535e 100644 --- a/StrataTest/Languages/Core/Examples/Map.lean +++ b/StrataTest/Languages/Core/Examples/Map.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section open Strata --------------------------------------------------------------------- @@ -74,4 +77,5 @@ Result: ❌ fail #guard_msgs in #eval verify mapPgm +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/MapBranching.lean b/StrataTest/Languages/Core/Examples/MapBranching.lean index 8e9712113e..cd0f3acb10 100644 --- a/StrataTest/Languages/Core/Examples/MapBranching.lean +++ b/StrataTest/Languages/Core/Examples/MapBranching.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -55,3 +58,4 @@ Result: ✅ pass end Strata +end diff --git a/StrataTest/Languages/Core/Examples/Min.lean b/StrataTest/Languages/Core/Examples/Min.lean index db27abaf82..fde8c60845 100644 --- a/StrataTest/Languages/Core/Examples/Min.lean +++ b/StrataTest/Languages/Core/Examples/Min.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -43,4 +46,6 @@ Result: ✅ pass #guard_msgs in #eval verify testPgm +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/MutualDatatypes.lean b/StrataTest/Languages/Core/Examples/MutualDatatypes.lean index e0c943f2b5..5999214446 100644 --- a/StrataTest/Languages/Core/Examples/MutualDatatypes.lean +++ b/StrataTest/Languages/Core/Examples/MutualDatatypes.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section /-! # Mutual Datatype Integration Tests @@ -417,3 +420,4 @@ Result: ✅ pass (options := .quiet) end Strata.MutualDatatypeTest +end diff --git a/StrataTest/Languages/Core/Examples/NoFilterWFProc.lean b/StrataTest/Languages/Core/Examples/NoFilterWFProc.lean index d0c2a76cf9..d65978d89a 100644 --- a/StrataTest/Languages/Core/Examples/NoFilterWFProc.lean +++ b/StrataTest/Languages/Core/Examples/NoFilterWFProc.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section /-! # Test: WF procedures survive FilterProcedures under selective verification Ensures that the wf procedures generated by `PrecondElim` are not @@ -59,3 +62,4 @@ info: (proceduresToVerify := some []) end Strata +end diff --git a/StrataTest/Languages/Core/Examples/OldExpressions.lean b/StrataTest/Languages/Core/Examples/OldExpressions.lean index 2a4808537b..4f692fe5f0 100644 --- a/StrataTest/Languages/Core/Examples/OldExpressions.lean +++ b/StrataTest/Languages/Core/Examples/OldExpressions.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -153,4 +156,6 @@ Result: ✅ pass #guard_msgs in #eval verify oldExprPgm +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/ProcedureCall.lean b/StrataTest/Languages/Core/Examples/ProcedureCall.lean index afca8cdb93..2d1230c869 100644 --- a/StrataTest/Languages/Core/Examples/ProcedureCall.lean +++ b/StrataTest/Languages/Core/Examples/ProcedureCall.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier -import Strata.Languages.Core.CallGraph +meta import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.CallGraph +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -177,4 +180,6 @@ Result: ✅ pass #eval TransM.run (translateProgram (globalCounterEnv.commands)) -/ +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/Quantifiers.lean b/StrataTest/Languages/Core/Examples/Quantifiers.lean index 825a5dd4d4..847b312845 100644 --- a/StrataTest/Languages/Core/Examples/Quantifiers.lean +++ b/StrataTest/Languages/Core/Examples/Quantifiers.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -148,3 +151,6 @@ Result: ✅ pass -/ #guard_msgs in #eval verify triggerPgm + +end Strata +end diff --git a/StrataTest/Languages/Core/Examples/QuantifiersWithTypeAliases.lean b/StrataTest/Languages/Core/Examples/QuantifiersWithTypeAliases.lean index ac60917729..f61284f1c5 100644 --- a/StrataTest/Languages/Core/Examples/QuantifiersWithTypeAliases.lean +++ b/StrataTest/Languages/Core/Examples/QuantifiersWithTypeAliases.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -79,3 +82,6 @@ Result: ✅ pass -/ #guard_msgs in #eval verify QuantTypeAliases + +end Strata +end diff --git a/StrataTest/Languages/Core/Examples/RealBitVector.lean b/StrataTest/Languages/Core/Examples/RealBitVector.lean index 0abbb1b931..21b35009a9 100644 --- a/StrataTest/Languages/Core/Examples/RealBitVector.lean +++ b/StrataTest/Languages/Core/Examples/RealBitVector.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -216,3 +219,6 @@ Result: ❌ fail -/ #guard_msgs in #eval verify bvMoreOpsPgm (options := .quiet) + +end Strata +end diff --git a/StrataTest/Languages/Core/Examples/RecursiveProcIte.lean b/StrataTest/Languages/Core/Examples/RecursiveProcIte.lean index 179242057a..6903686829 100644 --- a/StrataTest/Languages/Core/Examples/RecursiveProcIte.lean +++ b/StrataTest/Languages/Core/Examples/RecursiveProcIte.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -88,3 +91,6 @@ if (cond) { } cond, cond => PCt, !cond => !cond, !cond => PCf]> -/ + +end Strata +end diff --git a/StrataTest/Languages/Core/Examples/Regex.lean b/StrataTest/Languages/Core/Examples/Regex.lean index 29bbd75b17..eae94e058f 100644 --- a/StrataTest/Languages/Core/Examples/Regex.lean +++ b/StrataTest/Languages/Core/Examples/Regex.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -230,4 +233,6 @@ Result: ✅ pass #guard_msgs in #eval verify regexPgm3 +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/RemoveIrrelevantAxioms.lean b/StrataTest/Languages/Core/Examples/RemoveIrrelevantAxioms.lean index ecc3b01b1a..58abc53673 100644 --- a/StrataTest/Languages/Core/Examples/RemoveIrrelevantAxioms.lean +++ b/StrataTest/Languages/Core/Examples/RemoveIrrelevantAxioms.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -234,4 +237,6 @@ Result: ❓ unknown #eval verify irrelevantAxiomsTestPgm (options := {Core.VerifyOptions.models with removeIrrelevantAxioms := .Off}) +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/SafeMap.lean b/StrataTest/Languages/Core/Examples/SafeMap.lean index 12792604db..64fa28c2c8 100644 --- a/StrataTest/Languages/Core/Examples/SafeMap.lean +++ b/StrataTest/Languages/Core/Examples/SafeMap.lean @@ -3,11 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands -import Strata.Languages.Core.Verifier - - +meta section --------------------------------------------------------------------- namespace Strata @@ -107,3 +108,6 @@ Result: ✅ pass -/ #guard_msgs in #eval verify safeMapPgm (options := .quiet) + +end Strata +end diff --git a/StrataTest/Languages/Core/Examples/SelectiveVerification.lean b/StrataTest/Languages/Core/Examples/SelectiveVerification.lean index 89f2905af9..210a11259b 100644 --- a/StrataTest/Languages/Core/Examples/SelectiveVerification.lean +++ b/StrataTest/Languages/Core/Examples/SelectiveVerification.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier -import Strata.Languages.Core.CallGraph +meta import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.CallGraph +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -136,3 +139,4 @@ Result: ✅ pass --------------------------------------------------------------------- end Strata +end diff --git a/StrataTest/Languages/Core/Examples/Seq.lean b/StrataTest/Languages/Core/Examples/Seq.lean index d124c1d619..363b73ac57 100644 --- a/StrataTest/Languages/Core/Examples/Seq.lean +++ b/StrataTest/Languages/Core/Examples/Seq.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section open Strata --------------------------------------------------------------------- @@ -611,4 +614,5 @@ Result: ✅ pass #guard_msgs in #eval verify seqEmptyTypesPgm +end ---------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/SimpleProc.lean b/StrataTest/Languages/Core/Examples/SimpleProc.lean index 4df7606920..e3bbc1fcb4 100644 --- a/StrataTest/Languages/Core/Examples/SimpleProc.lean +++ b/StrataTest/Languages/Core/Examples/SimpleProc.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -73,4 +76,6 @@ Result: ✅ pass #guard_msgs in #eval verify simpleProcPgm +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/String.lean b/StrataTest/Languages/Core/Examples/String.lean index 1baa1e212c..460d648f06 100644 --- a/StrataTest/Languages/Core/Examples/String.lean +++ b/StrataTest/Languages/Core/Examples/String.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -151,4 +154,6 @@ Result: ✅ pass #guard_msgs in #eval verify strPgm +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/SubstFvarsCaptureTests.lean b/StrataTest/Languages/Core/Examples/SubstFvarsCaptureTests.lean index 03e9b3e795..cfa0c3b8cc 100644 --- a/StrataTest/Languages/Core/Examples/SubstFvarsCaptureTests.lean +++ b/StrataTest/Languages/Core/Examples/SubstFvarsCaptureTests.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +meta import Strata.DL.Lambda.Preconditions +import Strata.DDM.Integration.Lean.HashCommands +meta section /-! # Simultaneous substitution tests (Issue 653) Tests verifying that simultaneous substitution (`substFvars` / @@ -150,3 +154,4 @@ private def testEnv : Env := #eval Std.ToFormat.format (captureFreevars testEnv [] (mkAdd (mkFv "x") (mkFv "y"))) end Core.Statement +end diff --git a/StrataTest/Languages/Core/Examples/TermFormula.lean b/StrataTest/Languages/Core/Examples/TermFormula.lean index 5c44bf51f3..f91a0df059 100644 --- a/StrataTest/Languages/Core/Examples/TermFormula.lean +++ b/StrataTest/Languages/Core/Examples/TermFormula.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section /-! # Term/Formula Deep Embedding @@ -411,3 +414,4 @@ Result: ✅ pass #eval verify termFormulaPgm (options := .quiet) end Strata.TermFormulaTest +end diff --git a/StrataTest/Languages/Core/Examples/TypeAlias.lean b/StrataTest/Languages/Core/Examples/TypeAlias.lean index 5216d5eb01..f0c81fee3d 100644 --- a/StrataTest/Languages/Core/Examples/TypeAlias.lean +++ b/StrataTest/Languages/Core/Examples/TypeAlias.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -141,4 +144,6 @@ Result: ✅ pass #guard_msgs in #eval verify funcAndTypeAliasesPgm +end Strata +end -------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/TypeDecl.lean b/StrataTest/Languages/Core/Examples/TypeDecl.lean index 3903c29331..74cd11640e 100644 --- a/StrataTest/Languages/Core/Examples/TypeDecl.lean +++ b/StrataTest/Languages/Core/Examples/TypeDecl.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -132,4 +135,6 @@ KnownTypes' names: #guard_msgs in #eval verify typeDeclPgm4 +end Strata +end -------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Examples/TypeDeclStmt.lean b/StrataTest/Languages/Core/Examples/TypeDeclStmt.lean index dc17ba6ec3..6b7254dcc8 100644 --- a/StrataTest/Languages/Core/Examples/TypeDeclStmt.lean +++ b/StrataTest/Languages/Core/Examples/TypeDeclStmt.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section namespace Strata /-- Basic uninterpreted type declaration with equality reasoning -/ @@ -211,3 +214,4 @@ procedure P () { #end end Strata +end diff --git a/StrataTest/Languages/Core/Examples/TypeVarImplicitlyQuantified.lean b/StrataTest/Languages/Core/Examples/TypeVarImplicitlyQuantified.lean index 1c580bbf23..22e9484f06 100644 --- a/StrataTest/Languages/Core/Examples/TypeVarImplicitlyQuantified.lean +++ b/StrataTest/Languages/Core/Examples/TypeVarImplicitlyQuantified.lean @@ -3,11 +3,14 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -- Fix for https://github.com/strata-org/Strata/issues/105. -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section namespace Strata private def pgm := @@ -52,3 +55,6 @@ axiom [a2]: forall l_0 : bool :: forall l_1 : int :: forall l_2 : int :: forall -/ #guard_msgs in #eval Core.typeCheck .default core_pgm.fst + +end Strata +end diff --git a/StrataTest/Languages/Core/Examples/UnreachableAssert.lean b/StrataTest/Languages/Core/Examples/UnreachableAssert.lean index 2ce8df026e..cef5c03ae1 100644 --- a/StrataTest/Languages/Core/Examples/UnreachableAssert.lean +++ b/StrataTest/Languages/Core/Examples/UnreachableAssert.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands +meta section --------------------------------------------------------------------- namespace Strata @@ -74,4 +77,6 @@ Result: ✅ pass #guard_msgs in #eval verify unreachableAssertPgm +end Strata +end --------------------------------------------------------------------- diff --git a/StrataTest/Languages/Core/Tests/AssertionDefaultNames.lean b/StrataTest/Languages/Core/Tests/AssertionDefaultNames.lean index 1de1e59049..59ead3170a 100644 --- a/StrataTest/Languages/Core/Tests/AssertionDefaultNames.lean +++ b/StrataTest/Languages/Core/Tests/AssertionDefaultNames.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section --------------------------------------------------------------------- namespace Strata @@ -65,3 +69,7 @@ Result: ✅ pass #eval verify assertionNames --------------------------------------------------------------------- + +end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/AtSignDisambiguationTest.lean b/StrataTest/Languages/Core/Tests/AtSignDisambiguationTest.lean index f195c0fd40..98f4fbc265 100644 --- a/StrataTest/Languages/Core/Tests/AtSignDisambiguationTest.lean +++ b/StrataTest/Languages/Core/Tests/AtSignDisambiguationTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! ## Test: parameter names containing `@` are disambiguated from `@N` suffixes @@ -50,3 +54,7 @@ Model: #eval verify atSignDisambiguation --------------------------------------------------------------------- + +end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/CallElimWithOldGlobals.lean b/StrataTest/Languages/Core/Tests/CallElimWithOldGlobals.lean index 7901016e4d..d1ed29e8f2 100644 --- a/StrataTest/Languages/Core/Tests/CallElimWithOldGlobals.lean +++ b/StrataTest/Languages/Core/Tests/CallElimWithOldGlobals.lean @@ -3,10 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands -import Strata.Languages.Core.Verifier - +meta section --------------------------------------------------------------------- namespace Strata @@ -75,3 +77,7 @@ Result: ❓ unknown -/ #guard_msgs in #eval verify oldModifiesPgm (options := .quiet) (proceduresToVerify := ["h_correct", "h_incorrect"]) + +end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/CallGraphTest.lean b/StrataTest/Languages/Core/Tests/CallGraphTest.lean index 57e2a53771..998ea3b5a6 100644 --- a/StrataTest/Languages/Core/Tests/CallGraphTest.lean +++ b/StrataTest/Languages/Core/Tests/CallGraphTest.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.CallGraph +meta import Strata.Languages.Core.CallGraph + +meta section /-! # CallGraph.isRecursive Tests @@ -133,3 +136,5 @@ private def preludePlusUserGraph : CallGraph := #guard mutualGraph.computeRoots (preferredRoots := ["z"]) == ["a"] end Core.CallGraph.Tests + +end diff --git a/StrataTest/Languages/Core/Tests/CmdEvalTests.lean b/StrataTest/Languages/Core/Tests/CmdEvalTests.lean index 0d2d85be3a..58440d69ec 100644 --- a/StrataTest/Languages/Core/Tests/CmdEvalTests.lean +++ b/StrataTest/Languages/Core/Tests/CmdEvalTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.CmdEval +meta import Strata.Languages.Core.CmdEval + +meta section /-! ## Tests for CmdEval -/ @@ -99,3 +102,5 @@ y == 12 #eval format $ Imperative.Cmds.eval (Env.init (empty_factory := true)) testProgram2 end Core + +end diff --git a/StrataTest/Languages/Core/Tests/CoreOpTests.lean b/StrataTest/Languages/Core/Tests/CoreOpTests.lean index 6572e0ba4f..30202f74e6 100644 --- a/StrataTest/Languages/Core/Tests/CoreOpTests.lean +++ b/StrataTest/Languages/Core/Tests/CoreOpTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.CoreOp +meta import Strata.Languages.Core.CoreOp + +meta section /-! ## Tests for CoreOp structured operator types -/ @@ -120,3 +123,5 @@ end RoundTrip | .bvExtract 16 15 15 => true | _ => false end Core + +end diff --git a/StrataTest/Languages/Core/Tests/DatatypeEval.lean b/StrataTest/Languages/Core/Tests/DatatypeEval.lean index 7e61ea657b..c06a4f4392 100644 --- a/StrataTest/Languages/Core/Tests/DatatypeEval.lean +++ b/StrataTest/Languages/Core/Tests/DatatypeEval.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section --------------------------------------------------------------------- namespace Strata @@ -97,3 +101,5 @@ Result: ✅ pass #eval verify destrEx end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/DatatypeTests.lean b/StrataTest/Languages/Core/Tests/DatatypeTests.lean index 91199206bb..2e35529970 100644 --- a/StrataTest/Languages/Core/Tests/DatatypeTests.lean +++ b/StrataTest/Languages/Core/Tests/DatatypeTests.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Datatype Verification Tests @@ -136,3 +140,5 @@ Result: ✅ pass #eval verify hiddenTypeRecursionPgm (options := .quiet) end Strata.DatatypeTests + +end diff --git a/StrataTest/Languages/Core/Tests/DatatypeTypingTests.lean b/StrataTest/Languages/Core/Tests/DatatypeTypingTests.lean index 6b29311c34..dd488ae2e7 100644 --- a/StrataTest/Languages/Core/Tests/DatatypeTypingTests.lean +++ b/StrataTest/Languages/Core/Tests/DatatypeTypingTests.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Datatype Typing Tests @@ -277,3 +281,5 @@ info: error: Error: datatype Cycle1 not inhabited #eval Core.typeCheck .default (TransM.run Inhabited.default (translateProgram threeWayCyclePgm) |>.fst).stripMetaData end Strata.DatatypeTypingTests + +end diff --git a/StrataTest/Languages/Core/Tests/DuplicateAssumeLabels.lean b/StrataTest/Languages/Core/Tests/DuplicateAssumeLabels.lean index e84ff5ec13..e76e5ccbdd 100644 --- a/StrataTest/Languages/Core/Tests/DuplicateAssumeLabels.lean +++ b/StrataTest/Languages/Core/Tests/DuplicateAssumeLabels.lean @@ -3,11 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module +meta import Strata.Languages.Core.Verifier +meta import Strata.Transform.CallElim +import Strata.DDM.Integration.Lean.HashCommands -import Strata.Languages.Core.Verifier -import Strata.Transform.CallElim - +meta section --------------------------------------------------------------------- namespace Strata @@ -67,3 +69,7 @@ Result: ✅ pass #eval verify duplicateAssumes (options := .default) --------------------------------------------------------------------- + +end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/DuplicateBlockLabels.lean b/StrataTest/Languages/Core/Tests/DuplicateBlockLabels.lean index 76f8d3d06e..266c03b044 100644 --- a/StrataTest/Languages/Core/Tests/DuplicateBlockLabels.lean +++ b/StrataTest/Languages/Core/Tests/DuplicateBlockLabels.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section --------------------------------------------------------------------- namespace Strata @@ -55,3 +59,7 @@ info: -/ #guard_msgs in #eval verify blockLabelUniqueTestPgm2 + +end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/DuplicateDDMBindings.lean b/StrataTest/Languages/Core/Tests/DuplicateDDMBindings.lean index faf72fbeda..6fd1caffa3 100644 --- a/StrataTest/Languages/Core/Tests/DuplicateDDMBindings.lean +++ b/StrataTest/Languages/Core/Tests/DuplicateDDMBindings.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section --------------------------------------------------------------------- namespace Strata @@ -24,3 +28,7 @@ function f1(x : T1) : Map T1 T2; #end --------------------------------------------------------------------- + +end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/ExprEvalTest.lean b/StrataTest/Languages/Core/Tests/ExprEvalTest.lean index 7bdd7092c0..b98556ebc0 100644 --- a/StrataTest/Languages/Core/Tests/ExprEvalTest.lean +++ b/StrataTest/Languages/Core/Tests/ExprEvalTest.lean @@ -3,22 +3,26 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ - -import Strata.DL.Lambda.Lambda -import Strata.DL.Lambda.LExpr -import Strata.DL.Lambda.LState -import Strata.DL.Lambda.LTy -import Strata.DL.SMT.Term -import Strata.DL.SMT.Encoder -import Strata.Languages.Core.Env -import Strata.Languages.Core.Factory -import Strata.Languages.Core.Identifiers -import Strata.Languages.Core.Options -import Strata.Languages.Core.SMTEncoder -import Strata.Languages.Core.Verifier -import StrataTest.DL.Lambda.TestGen -import StrataTest.DL.Lambda.PlausibleHelpers -import Plausible.Gen +module + +meta import Strata.DL.Lambda.Lambda +meta import Strata.DL.Lambda.LExpr +meta import Strata.DL.Lambda.LState +meta import Strata.DL.Lambda.LTy +meta import Strata.DL.SMT.Term +meta import Strata.DL.SMT.Encoder +meta import Strata.Languages.Core.Env +meta import Strata.Languages.Core.Factory +meta import Strata.Languages.Core.Identifiers +meta import Strata.Languages.Core.Options +meta import Strata.Languages.Core.SMTEncoder +meta import Strata.Languages.Core.Verifier +meta import all StrataTest.DL.Lambda.TestGen +meta import all StrataTest.DL.Lambda.PlausibleHelpers +public meta import Plausible.Arbitrary +meta import Plausible + +meta section /-! This file does random testing of Strata Core operations registered in factory, by (1) choosing random constant inputs to the operations @@ -223,3 +227,5 @@ abbrev test_ty : LTy := .forAll [] <| .tcons "bool" [] end Tests end Core + +end diff --git a/StrataTest/Languages/Core/Tests/FuncDeclStmtTest.lean b/StrataTest/Languages/Core/Tests/FuncDeclStmtTest.lean index 4263033a68..f0b30c8a3e 100644 --- a/StrataTest/Languages/Core/Tests/FuncDeclStmtTest.lean +++ b/StrataTest/Languages/Core/Tests/FuncDeclStmtTest.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Core -import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Languages.Core.Core +meta import Strata.Languages.Core.DDMTransform.Translate +import Strata.DDM.Integration.Lean.HashCommands +meta section open Core open Strata @@ -42,3 +45,5 @@ procedure test () -/ #guard_msgs in #eval (Std.format ((Core.typeCheck .default (translate simpleFuncDeclPgm).stripMetaData))) + +end diff --git a/StrataTest/Languages/Core/Tests/FuncTypeCheckBody.lean b/StrataTest/Languages/Core/Tests/FuncTypeCheckBody.lean index 478c2a4ab9..c6b31920f7 100644 --- a/StrataTest/Languages/Core/Tests/FuncTypeCheckBody.lean +++ b/StrataTest/Languages/Core/Tests/FuncTypeCheckBody.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier -import Strata.Languages.Core.CallGraph +meta import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.CallGraph +import Strata.DDM.Integration.Lean.HashCommands + +meta section --------------------------------------------------------------------- namespace Strata @@ -39,3 +43,5 @@ info: --------------------------------------------------------------------- end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/FunctionDeclDDMTest.lean b/StrataTest/Languages/Core/Tests/FunctionDeclDDMTest.lean index 3f305a6fca..35afd4a272 100644 --- a/StrataTest/Languages/Core/Tests/FunctionDeclDDMTest.lean +++ b/StrataTest/Languages/Core/Tests/FunctionDeclDDMTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section --------------------------------------------------------------------- namespace Strata @@ -76,3 +80,7 @@ info: program Core; #eval IO.println funcDeclBlockPgm --------------------------------------------------------------------- + +end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/FunctionTests.lean b/StrataTest/Languages/Core/Tests/FunctionTests.lean index 11a51e21f8..ae4843d26a 100644 --- a/StrataTest/Languages/Core/Tests/FunctionTests.lean +++ b/StrataTest/Languages/Core/Tests/FunctionTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Function +meta import Strata.Languages.Core.Function + +meta section /-! ## Tests for Core Function -/ @@ -24,3 +27,5 @@ open LTy.Syntax LExpr.SyntaxMono return format type end Core + +end diff --git a/StrataTest/Languages/Core/Tests/GeneratedLabels.lean b/StrataTest/Languages/Core/Tests/GeneratedLabels.lean index b97363ab5b..a0ca8d9b23 100644 --- a/StrataTest/Languages/Core/Tests/GeneratedLabels.lean +++ b/StrataTest/Languages/Core/Tests/GeneratedLabels.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section --------------------------------------------------------------------- namespace Strata @@ -76,3 +80,7 @@ Result: ✅ pass -/ #guard_msgs in #eval verify genLabelsPgm + +end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/GenericCallFallbackTest.lean b/StrataTest/Languages/Core/Tests/GenericCallFallbackTest.lean index c3491396f7..d8ecc08f52 100644 --- a/StrataTest/Languages/Core/Tests/GenericCallFallbackTest.lean +++ b/StrataTest/Languages/Core/Tests/GenericCallFallbackTest.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.DDMTransform.ASTtoCST +meta import Strata.Languages.Core.DDMTransform.ASTtoCST + +meta section /-! Tests for the generic call fallback in ASTtoCST. @@ -135,3 +138,5 @@ info: "assert [known_not]: !x;" IO.println (repr (fmtStmt (mkAssert "known_not" e) #["x"])) end Strata.Test.GenericCallFallback + +end diff --git a/StrataTest/Languages/Core/Tests/IfElsePrecedenceTest.lean b/StrataTest/Languages/Core/Tests/IfElsePrecedenceTest.lean index 59d5c167e3..60e99a1ed0 100644 --- a/StrataTest/Languages/Core/Tests/IfElsePrecedenceTest.lean +++ b/StrataTest/Languages/Core/Tests/IfElsePrecedenceTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # If-Then-Else Precedence Regression Test (Issue #491) @@ -52,3 +56,5 @@ Result: ✅ pass #eval verify ifElsePlusPgm (options := .quiet) end Strata.IfElsePrecedenceTest + +end diff --git a/StrataTest/Languages/Core/Tests/InlineAssertionMetadataTest.lean b/StrataTest/Languages/Core/Tests/InlineAssertionMetadataTest.lean index 6010d25a61..4f11fe2af6 100644 --- a/StrataTest/Languages/Core/Tests/InlineAssertionMetadataTest.lean +++ b/StrataTest/Languages/Core/Tests/InlineAssertionMetadataTest.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier -import Strata.SimpleAPI +meta import Strata.Languages.Core.Verifier +meta import Strata.SimpleAPI +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Inline Assertion Metadata Test @@ -55,3 +59,5 @@ procedure caller() { return output end Core.InlineAssertionMetadata.Tests + +end diff --git a/StrataTest/Languages/Core/Tests/Issue1146Test.lean b/StrataTest/Languages/Core/Tests/Issue1146Test.lean index 86e7fc5370..f05d951344 100644 --- a/StrataTest/Languages/Core/Tests/Issue1146Test.lean +++ b/StrataTest/Languages/Core/Tests/Issue1146Test.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Languages.Core.DDMTransform.Translate +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Regression test for https://github.com/strata-org/Strata/issues/1146 @@ -54,3 +58,5 @@ function Len (xs : List) : int #end end Strata.Issue1146Test + +end diff --git a/StrataTest/Languages/Core/Tests/LambdaHigherOrderTests.lean b/StrataTest/Languages/Core/Tests/LambdaHigherOrderTests.lean index fe93e8e0e8..91b7b140f3 100644 --- a/StrataTest/Languages/Core/Tests/LambdaHigherOrderTests.lean +++ b/StrataTest/Languages/Core/Tests/LambdaHigherOrderTests.lean @@ -3,10 +3,14 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Core -import Strata.Languages.Core.DDMTransform.Translate -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Core +meta import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Lambda, Higher-Order Function, and Function Type Tests @@ -706,3 +710,5 @@ Property: assert Result: ✅ pass-/ #guard_msgs in #eval verify polyDatatypeFnInstPgm (options := .quiet) + +end diff --git a/StrataTest/Languages/Core/Tests/LoopElimEntryInvariantTest.lean b/StrataTest/Languages/Core/Tests/LoopElimEntryInvariantTest.lean index f86dbab4fb..40cbb51d03 100644 --- a/StrataTest/Languages/Core/Tests/LoopElimEntryInvariantTest.lean +++ b/StrataTest/Languages/Core/Tests/LoopElimEntryInvariantTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section -- Regression tests for LoopElim entry invariant soundness: @@ -65,3 +69,5 @@ Result: ❌ always false and is reachable from declaration entry (options := { Core.VerifyOptions.default with checkLevel := .full }) end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/ModelLiftTest.lean b/StrataTest/Languages/Core/Tests/ModelLiftTest.lean index ed718484db..d8d50e6853 100644 --- a/StrataTest/Languages/Core/Tests/ModelLiftTest.lean +++ b/StrataTest/Languages/Core/Tests/ModelLiftTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Model Lifting Tests (SMT → LExpr) @@ -192,3 +196,5 @@ Model: #eval verify quantModelPgm (options := .models) end Strata.ModelLiftTest + +end diff --git a/StrataTest/Languages/Core/Tests/MutualRecursiveFunctionErrorTest.lean b/StrataTest/Languages/Core/Tests/MutualRecursiveFunctionErrorTest.lean index 3ebf8897a3..37595fbe7b 100644 --- a/StrataTest/Languages/Core/Tests/MutualRecursiveFunctionErrorTest.lean +++ b/StrataTest/Languages/Core/Tests/MutualRecursiveFunctionErrorTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Mutual Recursive Function Error Tests @@ -78,3 +82,5 @@ Recursive function 'isEven' requires a @[cases] parameter #eval verify noCasesMutualPgm (options := .quiet) end Strata.MutualRecursiveFunctionErrorTest + +end diff --git a/StrataTest/Languages/Core/Tests/MutualRecursiveFunctionTests.lean b/StrataTest/Languages/Core/Tests/MutualRecursiveFunctionTests.lean index 9de26a834c..9b916df8ce 100644 --- a/StrataTest/Languages/Core/Tests/MutualRecursiveFunctionTests.lean +++ b/StrataTest/Languages/Core/Tests/MutualRecursiveFunctionTests.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Mutual Recursive Function Verification Tests @@ -425,3 +429,5 @@ Result: ✅ pass #eval verify mutualPrecondPgm (options := .quiet) end Strata.MutualRecursivePrecondTest + +end diff --git a/StrataTest/Languages/Core/Tests/NestedVarScopingTest.lean b/StrataTest/Languages/Core/Tests/NestedVarScopingTest.lean index ec182ede22..f6445ec5e0 100644 --- a/StrataTest/Languages/Core/Tests/NestedVarScopingTest.lean +++ b/StrataTest/Languages/Core/Tests/NestedVarScopingTest.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Core -import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Languages.Core.Core +meta import Strata.Languages.Core.DDMTransform.Translate +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace Strata @@ -139,3 +143,7 @@ procedure test () -/ #guard_msgs in #eval (Std.format (Core.typeCheck .default (translatePgm issue445Pgm).stripMetaData)) + +end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/OverflowCheckTest.lean b/StrataTest/Languages/Core/Tests/OverflowCheckTest.lean index 8beb89023d..71c5f9db00 100644 --- a/StrataTest/Languages/Core/Tests/OverflowCheckTest.lean +++ b/StrataTest/Languages/Core/Tests/OverflowCheckTest.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Factory -import Strata.DL.Lambda.Preconditions -import Strata.Transform.PrecondElim +meta import all Strata.Languages.Core.Factory +meta import all Strata.DL.Lambda.Preconditions +meta import all Strata.Transform.PrecondElim + +meta section /-! # Tests: overflow safe operators @@ -110,3 +113,5 @@ open Strata Core Lambda Core.PrecondElim Imperative in assert! md2.getPropertyType == some MetaData.divisionByZero let md3 : MetaData Core.Expression := match stmts[3]! with | Statement.assert _ _ md => md | _ => #[] assert! md3.getPropertyType == some MetaData.arithmeticOverflow + +end diff --git a/StrataTest/Languages/Core/Tests/PolyUnifTest.lean b/StrataTest/Languages/Core/Tests/PolyUnifTest.lean index 04900a6bf9..4162ae676b 100644 --- a/StrataTest/Languages/Core/Tests/PolyUnifTest.lean +++ b/StrataTest/Languages/Core/Tests/PolyUnifTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Polymorphic Unification Test @@ -62,10 +66,12 @@ function BadFunc (o: Option(int)) : int { #end /-- -info: error: (1284-1357) Impossible to unify (arrow string int) with (arrow int $__ty4). +info: error: (1358-1431) Impossible to unify (arrow string int) with (arrow int $__ty4). First mismatch: string with int. -/ #guard_msgs in #eval Core.typeCheck .quiet (TransM.run Inhabited.default (translateProgram polyUnifBadPgm)).fst end Strata.PolyUnifTest + +end diff --git a/StrataTest/Languages/Core/Tests/PolymorphicDatatypeTest.lean b/StrataTest/Languages/Core/Tests/PolymorphicDatatypeTest.lean index 435d1dee39..4f83070a43 100644 --- a/StrataTest/Languages/Core/Tests/PolymorphicDatatypeTest.lean +++ b/StrataTest/Languages/Core/Tests/PolymorphicDatatypeTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Polymorphic Datatype Integration Tests @@ -611,3 +615,5 @@ procedure Check() #end end Strata.InferTypePanicTest + +end diff --git a/StrataTest/Languages/Core/Tests/PolymorphicFunctionTest.lean b/StrataTest/Languages/Core/Tests/PolymorphicFunctionTest.lean index 8324eeacc2..b71e8f98a4 100644 --- a/StrataTest/Languages/Core/Tests/PolymorphicFunctionTest.lean +++ b/StrataTest/Languages/Core/Tests/PolymorphicFunctionTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Polymorphic Function Integration Tests @@ -204,10 +208,12 @@ spec { #end /-- -info: error: (4619-4642) Impossible to unify (arrow int bool) with (arrow bool $__ty5). +info: error: (4693-4716) Impossible to unify (arrow int bool) with (arrow bool $__ty5). First mismatch: int with bool. -/ #guard_msgs in #eval (Core.typeCheck .quiet (TransM.run Inhabited.default (translateProgram eqTypeMismatchPgm)).fst) end Strata.PolymorphicFunctionTest + +end diff --git a/StrataTest/Languages/Core/Tests/PolymorphicProcedureTest.lean b/StrataTest/Languages/Core/Tests/PolymorphicProcedureTest.lean index 4ac4de001b..e9cbabc508 100644 --- a/StrataTest/Languages/Core/Tests/PolymorphicProcedureTest.lean +++ b/StrataTest/Languages/Core/Tests/PolymorphicProcedureTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Polymorphic Procedure Test @@ -129,3 +133,5 @@ Result: ✅ pass #eval verify polyPostPgm end Strata.PolymorphicPostconditionTest + +end diff --git a/StrataTest/Languages/Core/Tests/PrecedenceCheck.lean b/StrataTest/Languages/Core/Tests/PrecedenceCheck.lean index e5a884879c..2492a4f806 100644 --- a/StrataTest/Languages/Core/Tests/PrecedenceCheck.lean +++ b/StrataTest/Languages/Core/Tests/PrecedenceCheck.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section --------------------------------------------------------------------- namespace Strata @@ -91,3 +95,5 @@ Result: ✅ pass end Strata --------------------------------------------------------------------- + +end diff --git a/StrataTest/Languages/Core/Tests/ProcedureTypeTests.lean b/StrataTest/Languages/Core/Tests/ProcedureTypeTests.lean index f970ca1270..67444694a6 100644 --- a/StrataTest/Languages/Core/Tests/ProcedureTypeTests.lean +++ b/StrataTest/Languages/Core/Tests/ProcedureTypeTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.ProcedureType +meta import Strata.Languages.Core.ProcedureType + +meta section namespace Core @@ -47,3 +50,5 @@ info: ok: (procedure P (x : int, out y : int) --------------------------------------------------------------------- end Tests end Core + +end diff --git a/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean b/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean index a415360eeb..edff99d601 100644 --- a/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean +++ b/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier -import Strata.Languages.Core.StatementEval +meta import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.StatementEval +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace Core @@ -618,3 +622,5 @@ end ConcreteInterpretation --------------------------------------------------------------------- end Core + +end diff --git a/StrataTest/Languages/Core/Tests/ProgramTypeTests.lean b/StrataTest/Languages/Core/Tests/ProgramTypeTests.lean index ea9c591c50..5ac833498f 100644 --- a/StrataTest/Languages/Core/Tests/ProgramTypeTests.lean +++ b/StrataTest/Languages/Core/Tests/ProgramTypeTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Core +meta import Strata.Languages.Core.Core + +meta section namespace Core @@ -223,3 +226,5 @@ info: error: Decl.func does not allow recursive functions. Use recFuncBlock inst end Tests end Core + +end diff --git a/StrataTest/Languages/Core/Tests/QuantifierBvarIndexTest.lean b/StrataTest/Languages/Core/Tests/QuantifierBvarIndexTest.lean index 492b8a493b..b7c31ac2fc 100644 --- a/StrataTest/Languages/Core/Tests/QuantifierBvarIndexTest.lean +++ b/StrataTest/Languages/Core/Tests/QuantifierBvarIndexTest.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Core -import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Languages.Core.Core +meta import Strata.Languages.Core.DDMTransform.Translate +import Strata.DDM.Integration.Lean.HashCommands + +meta section open Core open Strata @@ -78,3 +82,5 @@ spec { -/ #guard_msgs in #eval (Std.format ((Core.typeCheck .default (translate quantifierApplyBoundVar).stripMetaData))) + +end diff --git a/StrataTest/Languages/Core/Tests/RecursiveFunctionDDMTest.lean b/StrataTest/Languages/Core/Tests/RecursiveFunctionDDMTest.lean index c4742e2f75..26744e00bc 100644 --- a/StrataTest/Languages/Core/Tests/RecursiveFunctionDDMTest.lean +++ b/StrataTest/Languages/Core/Tests/RecursiveFunctionDDMTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! ## DDM parsing tests for recursive functions @@ -116,3 +120,5 @@ function isOdd (@[cases] n : MyNat) : bool #eval IO.println mutualRecFuncPgm end Strata.MutualRecFuncTest + +end diff --git a/StrataTest/Languages/Core/Tests/RecursiveFunctionErrorTest.lean b/StrataTest/Languages/Core/Tests/RecursiveFunctionErrorTest.lean index 53cfc49c2d..1bd1bea449 100644 --- a/StrataTest/Languages/Core/Tests/RecursiveFunctionErrorTest.lean +++ b/StrataTest/Languages/Core/Tests/RecursiveFunctionErrorTest.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Recursive Function Error Tests @@ -71,3 +75,5 @@ Recursive function 'listLen' requires a @[cases] parameter #eval verify noCasesPgm (options := .quiet) end Strata.RecursiveFunctionErrorTest + +end diff --git a/StrataTest/Languages/Core/Tests/RecursiveFunctionTests.lean b/StrataTest/Languages/Core/Tests/RecursiveFunctionTests.lean index 43f6f1e761..6f31999584 100644 --- a/StrataTest/Languages/Core/Tests/RecursiveFunctionTests.lean +++ b/StrataTest/Languages/Core/Tests/RecursiveFunctionTests.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Recursive Function Integration Tests @@ -575,3 +579,5 @@ Result: ✅ pass #eval verify recPrecondPgm (options := .quiet) end Strata.RecursiveFunctionTest + +end diff --git a/StrataTest/Languages/Core/Tests/RoundtripTest.lean b/StrataTest/Languages/Core/Tests/RoundtripTest.lean index 4ff9c9d88a..d24f2ad19e 100644 --- a/StrataTest/Languages/Core/Tests/RoundtripTest.lean +++ b/StrataTest/Languages/Core/Tests/RoundtripTest.lean @@ -3,11 +3,15 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.DDMTransform.ASTtoCST -import Strata.Languages.Core.DDMTransform.Translate -import Strata.DDM.Elab -import Strata.DDM.BuiltinDialects.Init +meta import Strata.Languages.Core.DDMTransform.ASTtoCST +meta import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.DDM.Elab +meta import Strata.DDM.BuiltinDialects.Init +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Core Roundtrip Tests @@ -233,3 +237,5 @@ axiom [f_ax]: f(Sequence.empty()) == true; #eval roundtrip testSeqEmptyRoundtrip end Strata.Test.Roundtrip + +end diff --git a/StrataTest/Languages/Core/Tests/SMTEncoderDatatypeTest.lean b/StrataTest/Languages/Core/Tests/SMTEncoderDatatypeTest.lean index 0f1d023365..fbb43ad351 100644 --- a/StrataTest/Languages/Core/Tests/SMTEncoderDatatypeTest.lean +++ b/StrataTest/Languages/Core/Tests/SMTEncoderDatatypeTest.lean @@ -3,20 +3,23 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ - -import Strata.DL.Lambda.Lambda -import Strata.DL.Lambda.LExpr -import Strata.DL.Lambda.LState -import Strata.DL.Lambda.LTy -import Strata.DL.Lambda.TypeFactory -import Strata.DL.SMT.Term -import Strata.DL.SMT.Encoder -import Strata.Languages.Core.Env -import Strata.Languages.Core.Factory -import Strata.Languages.Core.Identifiers -import Strata.Languages.Core.Options -import Strata.Languages.Core.SMTEncoder -import Strata.Languages.Core.Verifier +module + +meta import Strata.DL.Lambda.Lambda +meta import Strata.DL.Lambda.LExpr +meta import Strata.DL.Lambda.LState +meta import Strata.DL.Lambda.LTy +meta import Strata.DL.Lambda.TypeFactory +meta import Strata.DL.SMT.Term +meta import Strata.DL.SMT.Encoder +meta import Strata.Languages.Core.Env +meta import Strata.Languages.Core.Factory +meta import Strata.Languages.Core.Identifiers +meta import Strata.Languages.Core.Options +meta import Strata.Languages.Core.SMTEncoder +meta import Strata.Languages.Core.Verifier + +meta section /-! This file contains unit tests for SMT datatype encoding. @@ -576,3 +579,5 @@ info: (declare-datatype Container ( end DatatypeTests end Core + +end diff --git a/StrataTest/Languages/Core/Tests/SMTEncoderTests.lean b/StrataTest/Languages/Core/Tests/SMTEncoderTests.lean index 5ce57a9ecc..0dad419867 100644 --- a/StrataTest/Languages/Core/Tests/SMTEncoderTests.lean +++ b/StrataTest/Languages/Core/Tests/SMTEncoderTests.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.SMTEncoder -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.SMTEncoder +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! ## Tests for SMTEncoder -/ @@ -548,3 +552,5 @@ Result: ✅ pass #eval! verify quotedStringProgram (options := Core.VerifyOptions.quiet) end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/SanitizeFilenameTest.lean b/StrataTest/Languages/Core/Tests/SanitizeFilenameTest.lean index 8851894eed..07b0af1a4c 100644 --- a/StrataTest/Languages/Core/Tests/SanitizeFilenameTest.lean +++ b/StrataTest/Languages/Core/Tests/SanitizeFilenameTest.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier + +meta section /-! # Tests: sanitizeFilename -/ @@ -14,3 +17,5 @@ import Strata.Languages.Core.Verifier #guard Core.SMT.sanitizeFilename "" == "" #guard Core.SMT.sanitizeFilename "" == "_dead_branch__foo_" #guard Core.SMT.sanitizeFilename "a:b|c?d*e" == "a_b_c_d_e" + +end diff --git a/StrataTest/Languages/Core/Tests/SarifOutputTests.lean b/StrataTest/Languages/Core/Tests/SarifOutputTests.lean index ad488d023c..01a877468b 100644 --- a/StrataTest/Languages/Core/Tests/SarifOutputTests.lean +++ b/StrataTest/Languages/Core/Tests/SarifOutputTests.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.SarifOutput -import Strata.Languages.Core.Verifier -import Lean.Data.Json +meta import Strata.Languages.Core.SarifOutput +meta import Strata.Languages.Core.Verifier +meta import Lean.Data.Json + +meta section /-! # SARIF Output Tests @@ -377,3 +380,5 @@ private def sarifPropertyType (vcr : VCResult) : String := #eval sarifPropertyType (makeVCResult "t" (mkOutcome (.sat []) .unsat) (property := .cover)) end Core.Sarif.Tests + +end diff --git a/StrataTest/Languages/Core/Tests/ShadowedVars.lean b/StrataTest/Languages/Core/Tests/ShadowedVars.lean index 70fd306de2..8eed650e10 100644 --- a/StrataTest/Languages/Core/Tests/ShadowedVars.lean +++ b/StrataTest/Languages/Core/Tests/ShadowedVars.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section --------------------------------------------------------------------- namespace Strata @@ -45,3 +49,7 @@ Variable g of type bool already in context. #eval verify noShadowPgm2 (options := .quiet) --------------------------------------------------------------------- + +end Strata + +end diff --git a/StrataTest/Languages/Core/Tests/StatementEvalTests.lean b/StrataTest/Languages/Core/Tests/StatementEvalTests.lean index 57740ddfb8..45da142c5c 100644 --- a/StrataTest/Languages/Core/Tests/StatementEvalTests.lean +++ b/StrataTest/Languages/Core/Tests/StatementEvalTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.StatementEval +meta import Strata.Languages.Core.StatementEval + +meta section namespace Core --------------------------------------------------------------------- @@ -588,3 +591,5 @@ if $__nondet_cond_0 then 1 else 2 == 1 end Tests --------------------------------------------------------------------- end Core + +end diff --git a/StrataTest/Languages/Core/Tests/StatementTypeTests.lean b/StrataTest/Languages/Core/Tests/StatementTypeTests.lean index c635fb2184..9598cfa51b 100644 --- a/StrataTest/Languages/Core/Tests/StatementTypeTests.lean +++ b/StrataTest/Languages/Core/Tests/StatementTypeTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.StatementType +meta import Strata.Languages.Core.StatementType + +meta section namespace Core --------------------------------------------------------------------- @@ -281,3 +284,5 @@ info: error: [call Foo(x == x, out x, out y);]: In-out arguments (parameters app end CallOutArgTests end Core + +end diff --git a/StrataTest/Languages/Core/Tests/StatisticsTest.lean b/StrataTest/Languages/Core/Tests/StatisticsTest.lean index 7371461e55..060dc29505 100644 --- a/StrataTest/Languages/Core/Tests/StatisticsTest.lean +++ b/StrataTest/Languages/Core/Tests/StatisticsTest.lean @@ -3,6 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- Tests that the Core verification pipeline produces the expected statistics @@ -10,9 +11,12 @@ counters for a simple program. Uses `Core.typeCheckAndEval` which returns `Statistics` directly. -/ -import Strata.Languages.Core.Core -import Strata.Languages.Core.Verifier -import Strata.Util.Statistics +meta import Strata.Languages.Core.Core +meta import Strata.Languages.Core.Verifier +meta import Strata.Util.Statistics +import Strata.DDM.Integration.Lean.HashCommands + +meta section open Strata @@ -89,3 +93,5 @@ info: [statistics] Evaluator.factoryOps: 286 match Core.typeCheckAndEval .quiet program with | .error e => IO.println s!"Error: {e.message}" | .ok (_, stats) => IO.print stats.format + +end diff --git a/StrataTest/Languages/Core/Tests/TerminationCheckTests.lean b/StrataTest/Languages/Core/Tests/TerminationCheckTests.lean index 48486280af..240f4eefee 100644 --- a/StrataTest/Languages/Core/Tests/TerminationCheckTests.lean +++ b/StrataTest/Languages/Core/Tests/TerminationCheckTests.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! # Termination Checking Tests @@ -1210,3 +1214,5 @@ rec function bad (@[cases] xs : IntList) : int #eval verify decreasesNonVarPgm (options := .quiet) end Strata.TerminationCheckTest + +end diff --git a/StrataTest/Languages/Core/Tests/TestASTtoCST.lean b/StrataTest/Languages/Core/Tests/TestASTtoCST.lean index 981a7fc688..f567784cee 100644 --- a/StrataTest/Languages/Core/Tests/TestASTtoCST.lean +++ b/StrataTest/Languages/Core/Tests/TestASTtoCST.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.DDMTransform.ASTtoCST -import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Languages.Core.DDMTransform.ASTtoCST +meta import Strata.Languages.Core.DDMTransform.Translate +import Strata.DDM.Integration.Lean.HashCommands + +meta section -- Tests for Core.Program → CST Conversion -- This file tests one-direction conversion: AST → CST using the old @@ -777,3 +781,5 @@ spec { #eval ASTtoCST strPrefixSuffixPgm end Strata.Test + +end diff --git a/StrataTest/Languages/Core/Tests/TypeDeclTests.lean b/StrataTest/Languages/Core/Tests/TypeDeclTests.lean index 64a0764567..175249bb68 100644 --- a/StrataTest/Languages/Core/Tests/TypeDeclTests.lean +++ b/StrataTest/Languages/Core/Tests/TypeDeclTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.TypeDecl +meta import Strata.Languages.Core.TypeDecl + +meta section /-! ## Tests for TypeDecl -/ @@ -17,3 +20,5 @@ open Lambda.LTy.Syntax #eval format $ TypeConstructor.toType { name := "Foo", params := ["a", "b", "c"] } end Core + +end diff --git a/StrataTest/Languages/Core/Tests/VCGPathTests.lean b/StrataTest/Languages/Core/Tests/VCGPathTests.lean index ae78c8d69d..5e645a7aa8 100644 --- a/StrataTest/Languages/Core/Tests/VCGPathTests.lean +++ b/StrataTest/Languages/Core/Tests/VCGPathTests.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands + +meta section --------------------------------------------------------------------- namespace Strata @@ -669,3 +673,7 @@ Result: ✅ pass #eval verify noDupConcreteFalse (options := .quiet) --------------------------------------------------------------------- + +end Strata + +end diff --git a/StrataTest/Languages/Core/VCOutcomeTests.lean b/StrataTest/Languages/Core/VCOutcomeTests.lean index c4a2b5374c..103c1c9a59 100644 --- a/StrataTest/Languages/Core/VCOutcomeTests.lean +++ b/StrataTest/Languages/Core/VCOutcomeTests.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier -import Strata.Languages.Core.SarifOutput +meta import all Strata.Languages.Core.Verifier +meta import all Strata.Languages.Core.SarifOutput + +meta section /-! ## Tests for VCOutcome @@ -281,3 +284,5 @@ private def cleanObligation : Imperative.ProofObligation Core.Expression := #guard (unsatResult.adjustForPhases [Strata.frontEndPhase] cleanObligation).1 == unsatResult end Core + +end diff --git a/StrataTest/Languages/Dyn/Examples/Arithmetic.lean b/StrataTest/Languages/Dyn/Examples/Arithmetic.lean index 619d5cd9f6..62c17046cd 100644 --- a/StrataTest/Languages/Dyn/Examples/Arithmetic.lean +++ b/StrataTest/Languages/Dyn/Examples/Arithmetic.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Dyn.Dyn +meta import Strata.Languages.Dyn.Dyn +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace Strata namespace Dyn diff --git a/StrataTest/Languages/Dyn/Examples/BasicTypes.lean b/StrataTest/Languages/Dyn/Examples/BasicTypes.lean index eaf804e096..34bb87bed8 100644 --- a/StrataTest/Languages/Dyn/Examples/BasicTypes.lean +++ b/StrataTest/Languages/Dyn/Examples/BasicTypes.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Dyn.Dyn +meta import Strata.Languages.Dyn.Dyn +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace Strata namespace Dyn diff --git a/StrataTest/Languages/Dyn/Examples/ControlFlow.lean b/StrataTest/Languages/Dyn/Examples/ControlFlow.lean index 4597537508..f6d75a3f2a 100644 --- a/StrataTest/Languages/Dyn/Examples/ControlFlow.lean +++ b/StrataTest/Languages/Dyn/Examples/ControlFlow.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Dyn.Dyn +meta import Strata.Languages.Dyn.Dyn +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace Strata namespace Dyn diff --git a/StrataTest/Languages/Dyn/Examples/FunctionCalls.lean b/StrataTest/Languages/Dyn/Examples/FunctionCalls.lean index fdf898550e..ddec113304 100644 --- a/StrataTest/Languages/Dyn/Examples/FunctionCalls.lean +++ b/StrataTest/Languages/Dyn/Examples/FunctionCalls.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Dyn.Dyn +meta import Strata.Languages.Dyn.Dyn +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace Strata namespace Dyn diff --git a/StrataTest/Languages/Dyn/Examples/HeapOps.lean b/StrataTest/Languages/Dyn/Examples/HeapOps.lean index 23999b66c5..e71057f753 100644 --- a/StrataTest/Languages/Dyn/Examples/HeapOps.lean +++ b/StrataTest/Languages/Dyn/Examples/HeapOps.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Dyn.Dyn +meta import Strata.Languages.Dyn.Dyn +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace Strata namespace Dyn diff --git a/StrataTest/Languages/Dyn/Examples/ListOperations.lean b/StrataTest/Languages/Dyn/Examples/ListOperations.lean index a9a0287c69..21030066c8 100644 --- a/StrataTest/Languages/Dyn/Examples/ListOperations.lean +++ b/StrataTest/Languages/Dyn/Examples/ListOperations.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Dyn.Dyn +meta import Strata.Languages.Dyn.Dyn +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace Strata namespace Dyn diff --git a/StrataTest/Languages/Dyn/Examples/StringOps.lean b/StrataTest/Languages/Dyn/Examples/StringOps.lean index 74b1b1f207..41cd7a919d 100644 --- a/StrataTest/Languages/Dyn/Examples/StringOps.lean +++ b/StrataTest/Languages/Dyn/Examples/StringOps.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Dyn.Dyn +meta import Strata.Languages.Dyn.Dyn +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace Strata namespace Dyn diff --git a/StrataTest/Languages/Dyn/Examples/Trivial.lean b/StrataTest/Languages/Dyn/Examples/Trivial.lean index 4a6e63977d..50ee93d68c 100644 --- a/StrataTest/Languages/Dyn/Examples/Trivial.lean +++ b/StrataTest/Languages/Dyn/Examples/Trivial.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Dyn.Dyn -import Strata.Languages.Dyn.Dyn +meta import Strata.Languages.Dyn.Dyn +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace Strata namespace Dyn diff --git a/StrataTest/Languages/Dyn/Examples/TypeIntrospection.lean b/StrataTest/Languages/Dyn/Examples/TypeIntrospection.lean index ee89e8adf9..713a1d7289 100644 --- a/StrataTest/Languages/Dyn/Examples/TypeIntrospection.lean +++ b/StrataTest/Languages/Dyn/Examples/TypeIntrospection.lean @@ -3,8 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Dyn.Dyn +meta import Strata.Languages.Dyn.Dyn +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace Strata namespace Dyn diff --git a/StrataTest/Languages/Laurel/AbstractToConcreteTreeTranslatorTest.lean b/StrataTest/Languages/Laurel/AbstractToConcreteTreeTranslatorTest.lean index 701405b362..549824b04b 100644 --- a/StrataTest/Languages/Laurel/AbstractToConcreteTreeTranslatorTest.lean +++ b/StrataTest/Languages/Laurel/AbstractToConcreteTreeTranslatorTest.lean @@ -3,18 +3,20 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- Tests that the Laurel AST to DDM concrete syntax tree conversion (programToStrata) preserves program structure through roundtripping. -/ -import Strata.DDM.Elab -import Strata.DDM.BuiltinDialects.Init -import Strata.Languages.Laurel.Grammar.LaurelGrammar -import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator -import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator -import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator +meta import Strata.DDM.Elab +meta import Strata.DDM.BuiltinDialects.Init +meta import Strata.Languages.Laurel.Grammar.LaurelGrammar +meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator + +meta section open Strata open Strata.Elab (parseStrataProgramFromDialect) @@ -225,3 +227,4 @@ info: procedure test(): int #eval do IO.println (← roundtrip r"procedure test(): int { };") end Strata.Laurel +end diff --git a/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean b/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean index 0811d5e955..69f3c0d53c 100644 --- a/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean +++ b/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean @@ -3,18 +3,21 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- Tests that the constrained type elimination pass correctly transforms Laurel programs by comparing the output against expected results. -/ -import Strata.DDM.Elab -import Strata.DDM.BuiltinDialects.Init -import Strata.Languages.Laurel.Grammar.LaurelGrammar -import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator -import Strata.Languages.Laurel.ConstrainedTypeElim -import Strata.Languages.Laurel.Resolution +meta import Strata.DDM.Elab +meta import Strata.DDM.BuiltinDialects.Init +meta import Strata.Languages.Laurel.Grammar.LaurelGrammar +meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.ConstrainedTypeElim +meta import Strata.Languages.Laurel.Resolution + +meta section open Strata open Strata.Elab (parseStrataProgramFromDialect) @@ -116,3 +119,5 @@ procedure $witness_posint() IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc))) end Laurel +end Strata +end diff --git a/StrataTest/Languages/Laurel/DivisionByZeroCheckTest.lean b/StrataTest/Languages/Laurel/DivisionByZeroCheckTest.lean index 40e8a9112d..e6e9968c74 100644 --- a/StrataTest/Languages/Laurel/DivisionByZeroCheckTest.lean +++ b/StrataTest/Languages/Laurel/DivisionByZeroCheckTest.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util @@ -62,4 +65,5 @@ procedure callPureDivUnsafe(x: int) #guard_msgs(drop info, error) in #eval testInputWithOffset "DivByZeroE2E" e2eProgram 22 processLaurelFile -end Laurel +end Strata.Laurel +end diff --git a/StrataTest/Languages/Laurel/DuplicateNameTests.lean b/StrataTest/Languages/Laurel/DuplicateNameTests.lean index beb1a06737..22a5ff9f1e 100644 --- a/StrataTest/Languages/Laurel/DuplicateNameTests.lean +++ b/StrataTest/Languages/Laurel/DuplicateNameTests.lean @@ -3,18 +3,21 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- Tests that the resolution pass detects duplicate names in the same scope. Uses inline error annotations like the other Laurel tests (e.g. T1_AssertFalse). -/ -import StrataTest.Util.TestDiagnostics -import Strata.DDM.Elab -import Strata.DDM.BuiltinDialects.Init -import Strata.Languages.Laurel.Grammar.LaurelGrammar -import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator -import Strata.Languages.Laurel.Resolution +meta import all StrataTest.Util.TestDiagnostics +meta import Strata.DDM.Elab +meta import Strata.DDM.BuiltinDialects.Init +meta import Strata.Languages.Laurel.Grammar.LaurelGrammar +meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.Resolution + +meta section open StrataTest.Util open Strata @@ -175,3 +178,5 @@ datatype Foo { A } #eval testInputWithOffset "DupCompositeDatatype" dupCompositeDatatype 135 processResolution end Laurel +end Strata +end diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypes.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypes.lean index 80d21eb4d6..7d6987cb55 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypes.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypes.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypesError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypesError.lean index 342b6b144d..4c3d20f45f 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypesError.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypesError.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T12_Operators.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T12_Operators.lean index b33450c145..c792a70e09 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T12_Operators.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T12_Operators.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T13_WhileLoops.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T13_WhileLoops.lean index b6b0b2e178..8b0cc1934b 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T13_WhileLoops.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T13_WhileLoops.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T14_Quantifiers.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T14_Quantifiers.lean index c60edd889c..6b748b0444 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T14_Quantifiers.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T14_Quantifiers.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T15_ShortCircuit.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T15_ShortCircuit.lean index 2e5b46a8ab..4eeadef166 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T15_ShortCircuit.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T15_ShortCircuit.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T16_PropertySummary.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T16_PropertySummary.lean index b9d25ce265..aa4c4f796c 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T16_PropertySummary.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T16_PropertySummary.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T17_ForLoop.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T17_ForLoop.lean index 9e0276a960..b1502b1fd1 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T17_ForLoop.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T17_ForLoop.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveFunction.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveFunction.lean index 23da15a520..b4aac70e17 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveFunction.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveFunction.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_BitvectorTypes.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_BitvectorTypes.lean index dec53e08a4..8c0955581e 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_BitvectorTypes.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_BitvectorTypes.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_InvokeOn.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_InvokeOn.lean index a5eb37f347..10bfacab74 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_InvokeOn.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_InvokeOn.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T1_AssertFalse.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T1_AssertFalse.lean index 7a913ad921..08595dd29b 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T1_AssertFalse.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T1_AssertFalse.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_InferTypeError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_InferTypeError.lean index 8ac8f93f48..a69eb2ba09 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_InferTypeError.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_InferTypeError.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBodyError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBodyError.lean index c86b0e3c9c..ea2a4288d2 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBodyError.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBodyError.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T21_ExitMultiPathAssert.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T21_ExitMultiPathAssert.lean index 97db999027..1b15cfeff7 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T21_ExitMultiPathAssert.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T21_ExitMultiPathAssert.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_ArityMismatch.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_ArityMismatch.lean index 94c0f22371..fce8013d30 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_ArityMismatch.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_ArityMismatch.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_MultipleReturns.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_MultipleReturns.lean index c3e31806d7..76b8a7f934 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_MultipleReturns.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_MultipleReturns.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressions.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressions.lean index e65d283f57..5f6a92f98d 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressions.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressions.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressionsError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressionsError.lean index 2b3767391c..d94d179dea 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressionsError.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressionsError.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlow.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlow.lean index 6e79453261..1e9307a396 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlow.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlow.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError.lean index 3ebe4eb4cf..80e2335737 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T4_LoopJumps.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T4_LoopJumps.lean index 040bf3a186..da88caa329 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T4_LoopJumps.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T4_LoopJumps.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T4b_Exit.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T4b_Exit.lean index ce3868af8f..0380886295 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T4b_Exit.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T4b_Exit.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T5_ProcedureCalls.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T5_ProcedureCalls.lean index e1e5c0cfd8..7187078aca 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T5_ProcedureCalls.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T5_ProcedureCalls.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T6_Preconditions.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T6_Preconditions.lean index c7f1742a88..c3ae951491 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T6_Preconditions.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T6_Preconditions.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T7_Decreases.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T7_Decreases.lean index ee5cfc149d..bef96b8eb3 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T7_Decreases.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T7_Decreases.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_Postconditions.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_Postconditions.lean index 526a03dd92..74723d1ecf 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_Postconditions.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_Postconditions.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_PostconditionsErrors.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_PostconditionsErrors.lean index d61c5849da..88f8bec609 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_PostconditionsErrors.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_PostconditionsErrors.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8b_EarlyReturnPostconditions.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8b_EarlyReturnPostconditions.lean index 964fc7dfb0..659a1e22a9 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8b_EarlyReturnPostconditions.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8b_EarlyReturnPostconditions.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8c_BodilessInlining.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8c_BodilessInlining.lean index 34ef67a97e..a7ff015b31 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8c_BodilessInlining.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8c_BodilessInlining.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.SimpleAPI +meta import Strata.SimpleAPI + +meta section /-! # Bodiless Procedure Inlining Test @@ -57,3 +60,4 @@ procedure caller() return output end Strata.Laurel.BodilessInliningTest +end diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8d_HeapMutatingValueReturn.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8d_HeapMutatingValueReturn.lean index 0a8321d945..f81e63553d 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8d_HeapMutatingValueReturn.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8d_HeapMutatingValueReturn.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T9_Nondeterministic.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T9_Nondeterministic.lean index d8dbacf369..a926078732 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T9_Nondeterministic.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T9_Nondeterministic.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean b/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean index e46f03ef99..c45aabd6ca 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T2_ModifiesClauses.lean b/StrataTest/Languages/Laurel/Examples/Objects/T2_ModifiesClauses.lean index 52a16146c5..375e845dfd 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T2_ModifiesClauses.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T2_ModifiesClauses.lean @@ -3,6 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- A modifies clause CAN be placed on any procedure to generate a modifies axiom. @@ -14,8 +15,10 @@ since otherwise all heap state is lost after calling them. -/ -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritance.lean b/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritance.lean index ba406b0ddc..6b83965968 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritance.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritance.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritanceErrors.lean b/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritanceErrors.lean index af1b8ee5eb..91aff3432a 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritanceErrors.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritanceErrors.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T6_Datatypes.lean b/StrataTest/Languages/Laurel/Examples/Objects/T6_Datatypes.lean index 9bb51c2d13..1567885390 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T6_Datatypes.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T6_Datatypes.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean b/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean index 189295102d..068bb6fd8b 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T8_NonCompositeModifies.lean b/StrataTest/Languages/Laurel/Examples/Objects/T8_NonCompositeModifies.lean index 76bb786239..c83f53fc5a 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T8_NonCompositeModifies.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T8_NonCompositeModifies.lean @@ -3,6 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- Regression test for issue #490: a modifies clause referencing a non-composite @@ -11,8 +12,10 @@ in laurelAnalyze. The fix filters out non-composite modifies entries and emits a diagnostic error. -/ -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T1_Decimals.lean b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T1_Decimals.lean index 98d3908d77..a87350fda6 100644 --- a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T1_Decimals.lean +++ b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T1_Decimals.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_String.lean b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_String.lean index 02b5729dc8..b183cf9e2d 100644 --- a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_String.lean +++ b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_String.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util diff --git a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_StringConcatLifting.lean b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_StringConcatLifting.lean index 6f0b2a01a7..c7f5caef5b 100644 --- a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_StringConcatLifting.lean +++ b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_StringConcatLifting.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples +meta import all StrataTest.Util.TestDiagnostics +meta import all StrataTest.Languages.Laurel.TestExamples + +meta section open StrataTest.Util open Strata diff --git a/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean b/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean index f3a3acbd6f..a771d0207d 100644 --- a/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean +++ b/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean @@ -3,6 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- Tests that the expression lifter correctly handles statement constructs @@ -10,11 +11,13 @@ Tests that the expression lifter correctly handles statement constructs by comparing the lifted Laurel against expected output. -/ -import Strata.DDM.Elab -import Strata.DDM.BuiltinDialects.Init -import Strata.Languages.Laurel.Grammar.LaurelGrammar -import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator -import Strata.Languages.Laurel.LaurelToCoreTranslator +meta import Strata.DDM.Elab +meta import Strata.DDM.BuiltinDialects.Init +meta import Strata.Languages.Laurel.Grammar.LaurelGrammar +meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.LaurelToCoreTranslator + +meta section open Strata open Strata.Elab (parseStrataProgramFromDialect) @@ -53,3 +56,5 @@ info: procedure assertInBlockExpr() IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc))) end Laurel +end Strata +end diff --git a/StrataTest/Languages/Laurel/LiftHolesTest.lean b/StrataTest/Languages/Laurel/LiftHolesTest.lean index 0f5a4997d3..acb4bae314 100644 --- a/StrataTest/Languages/Laurel/LiftHolesTest.lean +++ b/StrataTest/Languages/Laurel/LiftHolesTest.lean @@ -3,19 +3,22 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- Tests that the eliminateHoles pass correctly replaces `.Hole` nodes with calls to freshly generated uninterpreted functions, with types inferred from context. -/ -import Strata.DDM.Elab -import Strata.DDM.BuiltinDialects.Init -import Strata.Languages.Laurel.Grammar.LaurelGrammar -import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator -import Strata.Languages.Laurel.InferHoleTypes -import Strata.Languages.Laurel.EliminateHoles -import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator +meta import Strata.DDM.Elab +meta import Strata.DDM.BuiltinDialects.Init +meta import Strata.Languages.Laurel.Grammar.LaurelGrammar +meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.InferHoleTypes +meta import Strata.Languages.Laurel.EliminateHoles +meta import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator + +meta section open Strata open Strata.Elab (parseStrataProgramFromDialect) @@ -381,3 +384,5 @@ procedure test() { assert IntList..isCons() }; " end Laurel +end Strata +end diff --git a/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean b/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean index e88deb4143..f267f79373 100644 --- a/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean +++ b/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean @@ -3,6 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- Tests that the expression lifter correctly hoists imperative procedure calls @@ -10,11 +11,13 @@ out of assert and assume conditions, while leaving assignments untouched (so they are rejected downstream). -/ -import Strata.DDM.Elab -import Strata.DDM.BuiltinDialects.Init -import Strata.Languages.Laurel.Grammar.LaurelGrammar -import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator -import Strata.Languages.Laurel.LaurelToCoreTranslator +meta import Strata.DDM.Elab +meta import Strata.DDM.BuiltinDialects.Init +meta import Strata.Languages.Laurel.Grammar.LaurelGrammar +meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.LaurelToCoreTranslator + +meta section open Strata open Strata.Elab (parseStrataProgramFromDialect) @@ -115,3 +118,5 @@ procedure test() { " end Laurel +end Strata +end diff --git a/StrataTest/Languages/Laurel/MapStmtExprTest.lean b/StrataTest/Languages/Laurel/MapStmtExprTest.lean index b9329a99f8..6e5a19e44b 100644 --- a/StrataTest/Languages/Laurel/MapStmtExprTest.lean +++ b/StrataTest/Languages/Laurel/MapStmtExprTest.lean @@ -3,19 +3,22 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- Tests for the generic `mapStmtExprM` traversal. Verifies that `mapStmtExpr id` is the identity: applying it to a parsed program produces identical output. -/ -import Strata.DDM.Elab -import Strata.DDM.BuiltinDialects.Init -import Strata.Languages.Laurel.Grammar.LaurelGrammar -import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator -import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator -import Strata.Languages.Laurel.MapStmtExpr -import Strata.Languages.Laurel.Resolution +meta import Strata.DDM.Elab +meta import Strata.DDM.BuiltinDialects.Init +meta import Strata.Languages.Laurel.Grammar.LaurelGrammar +meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator +meta import Strata.Languages.Laurel.MapStmtExpr +meta import Strata.Languages.Laurel.Resolution + +meta section open Strata open Strata.Elab (parseStrataProgramFromDialect) @@ -84,3 +87,4 @@ info: ok: mapStmtExpr id ≡ id #eval! testMapStmtExprId testProgram end Strata.Laurel +end diff --git a/StrataTest/Languages/Laurel/ResolutionKindTests.lean b/StrataTest/Languages/Laurel/ResolutionKindTests.lean index 52355edf11..7076e08741 100644 --- a/StrataTest/Languages/Laurel/ResolutionKindTests.lean +++ b/StrataTest/Languages/Laurel/ResolutionKindTests.lean @@ -3,18 +3,21 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- Tests that the resolution pass detects kind mismatches — e.g. using a variable where a type is expected, or calling a type as if it were a procedure. -/ -import StrataTest.Util.TestDiagnostics -import Strata.DDM.Elab -import Strata.DDM.BuiltinDialects.Init -import Strata.Languages.Laurel.Grammar.LaurelGrammar -import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator -import Strata.Languages.Laurel.Resolution +meta import all StrataTest.Util.TestDiagnostics +meta import Strata.DDM.Elab +meta import Strata.DDM.BuiltinDialects.Init +meta import Strata.Languages.Laurel.Grammar.LaurelGrammar +meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.Resolution + +meta section open StrataTest.Util open Strata @@ -111,3 +114,5 @@ procedure test() opaque { #eval testInputWithOffset "MultiOutputInExpr" multiOutputInExpr 100 processResolution end Laurel +end Strata +end diff --git a/StrataTest/Languages/Laurel/StatisticsTest.lean b/StrataTest/Languages/Laurel/StatisticsTest.lean index 00bc6c7b24..06cb8a7f80 100644 --- a/StrataTest/Languages/Laurel/StatisticsTest.lean +++ b/StrataTest/Languages/Laurel/StatisticsTest.lean @@ -3,6 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- Tests that the Laurel compilation pipeline produces the expected statistics @@ -10,12 +11,14 @@ counters. Uses `translateWithLaurel` which returns `Statistics` as the fourth tuple element. -/ -import Strata.DDM.Elab -import Strata.DDM.BuiltinDialects.Init -import Strata.Languages.Laurel.Grammar.LaurelGrammar -import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator -import Strata.Languages.Laurel.LaurelCompilationPipeline -import Strata.Util.Statistics +meta import Strata.DDM.Elab +meta import Strata.DDM.BuiltinDialects.Init +meta import Strata.Languages.Laurel.Grammar.LaurelGrammar +meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.LaurelCompilationPipeline +meta import Strata.Util.Statistics + +meta section open Strata open Strata.Elab (parseStrataProgramFromDialect) @@ -73,3 +76,5 @@ procedure p2(x: int) returns (y: int) IO.print stats.format end Laurel +end Strata +end diff --git a/StrataTest/Languages/Laurel/TestExamples.lean b/StrataTest/Languages/Laurel/TestExamples.lean index 00d14ae804..9b598cc486 100644 --- a/StrataTest/Languages/Laurel/TestExamples.lean +++ b/StrataTest/Languages/Laurel/TestExamples.lean @@ -3,14 +3,17 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import Strata.DDM.Elab -import Strata.DDM.BuiltinDialects.Init -import Strata.Util.IO -import Strata.Languages.Laurel.Grammar.LaurelGrammar -import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator -import Strata.Languages.Laurel.LaurelCompilationPipeline +meta import all StrataTest.Util.TestDiagnostics +meta import Strata.DDM.Elab +meta import Strata.DDM.BuiltinDialects.Init +meta import Strata.Util.IO +meta import Strata.Languages.Laurel.Grammar.LaurelGrammar +meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.LaurelCompilationPipeline + +meta section open StrataTest.Util open Strata @@ -50,3 +53,5 @@ def processLaurelFileKeepIntermediates (input : InputContext) : IO (Array Diagno processLaurelFileWithOptions { translateOptions := { keepAllFilesPrefix := dir}} input end Laurel +end Strata +end diff --git a/StrataTest/Languages/Laurel/TypeAliasElimTest.lean b/StrataTest/Languages/Laurel/TypeAliasElimTest.lean index 7110cdfeec..c1e98d3622 100644 --- a/StrataTest/Languages/Laurel/TypeAliasElimTest.lean +++ b/StrataTest/Languages/Laurel/TypeAliasElimTest.lean @@ -3,6 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module /- Tests that the type alias elimination pass correctly transforms @@ -13,12 +14,14 @@ produced only by the Python frontend), these tests construct programs programmatically and run resolve + typeAliasElim. -/ -import Strata.DDM.Elab -import Strata.DDM.BuiltinDialects.Init -import Strata.Languages.Laurel.Grammar.LaurelGrammar -import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator -import Strata.Languages.Laurel.TypeAliasElim -import Strata.Languages.Laurel.Resolution +meta import Strata.DDM.Elab +meta import Strata.DDM.BuiltinDialects.Init +meta import Strata.Languages.Laurel.Grammar.LaurelGrammar +meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.TypeAliasElim +meta import Strata.Languages.Laurel.Resolution + +meta section open Strata.Laurel @@ -128,3 +131,5 @@ return a; #eval! do let result := resolveAndElim procSigProgram printProcs result.staticProcedures + +end diff --git a/StrataTest/Languages/Python/CorePreludeTest.lean b/StrataTest/Languages/Python/CorePreludeTest.lean index 0eadf406aa..b205e1c791 100644 --- a/StrataTest/Languages/Python/CorePreludeTest.lean +++ b/StrataTest/Languages/Python/CorePreludeTest.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Python.CorePrelude -import Strata.DDM.Ion +meta import Strata.Languages.Python.CorePrelude +meta import Strata.DDM.Ion + +meta section namespace Strata.Python @@ -23,3 +26,4 @@ private def testCorePreludeRoundTrip : Bool := #guard testCorePreludeRoundTrip end Strata.Python +end diff --git a/StrataTest/Languages/Python/PreludeVerifyTest.lean b/StrataTest/Languages/Python/PreludeVerifyTest.lean index ad21d1bcdc..a81e93288b 100644 --- a/StrataTest/Languages/Python/PreludeVerifyTest.lean +++ b/StrataTest/Languages/Python/PreludeVerifyTest.lean @@ -3,10 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Python.PySpecPipeline -import Strata.Languages.Python.PyFactory -import Strata.Languages.Core.Verifier +meta import all Strata.Languages.Python.PySpecPipeline +meta import all Strata.Languages.Python.PyFactory +meta import all Strata.Languages.Core.Verifier + +meta section /-! # Prelude Verification Test @@ -38,3 +41,4 @@ private def verifyPrelude : IO (Array DiagnosticModel) := do #eval verifyPrelude end Strata.Python.PreludeVerifyTest +end diff --git a/StrataTest/Languages/Python/PySpecArgTypeTest.lean b/StrataTest/Languages/Python/PySpecArgTypeTest.lean index 21f8e48e21..ebe28f0b47 100644 --- a/StrataTest/Languages/Python/PySpecArgTypeTest.lean +++ b/StrataTest/Languages/Python/PySpecArgTypeTest.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Python.PySpecPipeline -import Strata.Languages.Python.Specs.DDM +meta import all Strata.Languages.Python.PySpecPipeline +meta import all Strata.Languages.Python.Specs.DDM + +meta section /-! ## Test: specArgToFuncDeclArg preserves parameter type info @@ -115,3 +118,4 @@ info: procedure test_typed_func(x: Any, y: Any): Any IO.println (toString (formatProcedure proc)) end Strata.Python.PySpecArgTypeTest +end diff --git a/StrataTest/Languages/Python/Regex/ReParserTests.lean b/StrataTest/Languages/Python/Regex/ReParserTests.lean index 1694e1aad8..e899f8e5d5 100644 --- a/StrataTest/Languages/Python/Regex/ReParserTests.lean +++ b/StrataTest/Languages/Python/Regex/ReParserTests.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Python.Regex.ReParser +meta import Strata.Languages.Python.Regex.ReParser + +meta section /-! ## Tests for Python Regex ReParser -/ @@ -494,3 +497,4 @@ info: Except.error (Strata.Python.ParseError.patternError "Unbalanced parenthesi end Test.parseTop end Strata.Python +end diff --git a/StrataTest/Languages/Python/Regex/ReToCoreTests.lean b/StrataTest/Languages/Python/Regex/ReToCoreTests.lean index 74624e80f0..c57043d461 100644 --- a/StrataTest/Languages/Python/Regex/ReToCoreTests.lean +++ b/StrataTest/Languages/Python/Regex/ReToCoreTests.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Python.Regex.ReToCore -import Strata.Languages.Core.DDMTransform.ASTtoCST +meta import Strata.Languages.Python.Regex.ReToCore +meta import Strata.Languages.Core.DDMTransform.ASTtoCST + +meta section namespace Strata.Python.Tests @@ -224,3 +227,4 @@ info: (re.union(re.concat(re.concat(str.to.re(""), str.to.re("a")), str.to.re("" #eval Std.format $ pythonRegexToCoreEraseTypes "^a" .fullmatch end Strata.Python.Tests +end diff --git a/StrataTest/Languages/Python/Specs/DeclsTest.lean b/StrataTest/Languages/Python/Specs/DeclsTest.lean index 0eab1a8977..c5e8e7f8c0 100644 --- a/StrataTest/Languages/Python/Specs/DeclsTest.lean +++ b/StrataTest/Languages/Python/Specs/DeclsTest.lean @@ -3,7 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.Languages.Python.Specs.Decls +module + +meta import Strata.Languages.Python.Specs.Decls + +meta section open Strata.Python.Specs @@ -14,3 +18,4 @@ namespace DeclsTest #[SpecType.intLiteral ⟨0, 0⟩ 0, SpecType.intLiteral ⟨0, 0⟩ 0]).intLits.size == 1 end DeclsTest +end diff --git a/StrataTest/Languages/Python/TestExamples.lean b/StrataTest/Languages/Python/TestExamples.lean index 1a9dfa4197..8ccb052cb7 100644 --- a/StrataTest/Languages/Python/TestExamples.lean +++ b/StrataTest/Languages/Python/TestExamples.lean @@ -3,12 +3,15 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import StrataTest.Util.TestDiagnostics -import StrataTest.Util.Python +public import Strata.Languages.Core.Verifier +public import Strata.Languages.Laurel.Laurel import Strata.Languages.Python.PySpecPipeline import Strata.Languages.Python.PyFactory -import Strata.Languages.Laurel.LaurelToCoreTranslator +import Strata.DDM.Ion + +import StrataTest.Util.TestDiagnostics open StrataTest.Util open Strata @@ -51,7 +54,7 @@ def withPythonToLaurel (pythonCmd : System.FilePath) (input : InputContext) /-- Run the Python → Ion → Laurel pipeline and return the Laurel program. The caller can inspect the Laurel IR directly or continue to Core/SMT. -/ -def processPythonToLaurel (pythonCmd : System.FilePath) (input : InputContext) +public def processPythonToLaurel (pythonCmd : System.FilePath) (input : InputContext) : IO Laurel.Program := withPythonToLaurel pythonCmd input fun laurel _ => pure laurel @@ -60,7 +63,7 @@ def processPythonToLaurel (pythonCmd : System.FilePath) (input : InputContext) The `input` should contain raw Python source code. The `pythonCmd` must point to a Python 3 interpreter with `strata.gen` installed. -/ -def processPythonFile (pythonCmd : System.FilePath) (input : InputContext) +public def processPythonFile (pythonCmd : System.FilePath) (input : InputContext) : IO (Array Diagnostic) := do withPythonToLaurel pythonCmd input fun laurel pyFile => do let (coreOpt, translateDiags) ← translateCombinedLaurel laurel diff --git a/StrataTest/Languages/Python/ToLaurelTest.lean b/StrataTest/Languages/Python/ToLaurelTest.lean index bbf7e437a5..9ac0ffff2b 100644 --- a/StrataTest/Languages/Python/ToLaurelTest.lean +++ b/StrataTest/Languages/Python/ToLaurelTest.lean @@ -3,9 +3,12 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Python.Specs.ToLaurel -import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator +meta import all Strata.Languages.Python.Specs.ToLaurel +meta import all Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator + +meta section /-! # PySpec → Laurel Translation Tests @@ -1088,3 +1091,4 @@ private def translateFunc (args : Array Arg := #[]) assert! body.contains "assume Any..isfrom_str(result)" end Strata.Python.Specs.ToLaurel.Tests +end diff --git a/StrataTest/Transform/ANFEncoderTests.lean b/StrataTest/Transform/ANFEncoderTests.lean index f40337acb8..536c93b92e 100644 --- a/StrataTest/Transform/ANFEncoderTests.lean +++ b/StrataTest/Transform/ANFEncoderTests.lean @@ -3,9 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Transform.ANFEncoder -import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Transform.ANFEncoder +meta import Strata.Languages.Core.DDMTransform.Translate +import Strata.DDM.Integration.Lean.HashCommands + +meta section namespace Core.ANFEncoder.Tests @@ -172,3 +176,4 @@ procedure test (x : int) #eval IO.println (toString (anfEncodeProgram (translateCore nestedDupProg)).2) end Core.ANFEncoder.Tests +end diff --git a/StrataTest/Transform/CallElim.lean b/StrataTest/Transform/CallElim.lean index c950d3cf27..70f17478b7 100644 --- a/StrataTest/Transform/CallElim.lean +++ b/StrataTest/Transform/CallElim.lean @@ -3,17 +3,20 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module import Strata.DDM.Integration.Lean -import Strata.DDM.Util.Format -import Strata.Languages.Core.Core -import Strata.Languages.Core.DDMTransform.Translate -import Strata.Languages.Core.ProgramType -import Strata.Languages.Core.ProgramWF -import Strata.Languages.Core.StatementSemantics -import Strata.Transform.CoreTransform -import Strata.Transform.CallElim -import Strata.Languages.Core.Verifier +meta import Strata.DDM.Util.Format +meta import Strata.Languages.Core.Core +meta import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Languages.Core.ProgramType +meta import Strata.Languages.Core.ProgramWF +meta import Strata.Languages.Core.StatementSemantics +meta import Strata.Transform.CoreTransform +meta import Strata.Transform.CallElim +meta import Strata.Languages.Core.Verifier + +meta section open Core @@ -238,3 +241,4 @@ private def cleanObligation : Imperative.ProofObligation Core.Expression := #guard (satResult.adjustForPhases [callElimPipelinePhase.phase] cleanObligation).1 == satResult end CallElimPhaseTests +end diff --git a/StrataTest/Transform/DetToKleene.lean b/StrataTest/Transform/DetToKleene.lean index f838cc27d9..895c96ea3c 100644 --- a/StrataTest/Transform/DetToKleene.lean +++ b/StrataTest/Transform/DetToKleene.lean @@ -3,12 +3,15 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Transform.DetToKleene -import Strata.Languages.Core.StatementSemantics -import Strata.Languages.Core.ProgramType -import Strata.Languages.Core.ProgramWF -import Strata.DL.Lambda.IntBoolFactory +meta import Strata.Transform.DetToKleene +meta import Strata.Languages.Core.StatementSemantics +meta import Strata.Languages.Core.ProgramType +meta import Strata.Languages.Core.ProgramWF +meta import Strata.DL.Lambda.IntBoolFactory + +meta section open Core @@ -33,3 +36,4 @@ def KleeneTest1Ans : Option (KleeneStmt Expression (Cmd Expression)) := #eval (toString $ Std.format (StmtToKleeneStmt KleeneTest1)) == (toString $ Std.format KleeneTest1Ans) end KleeneExamples +end diff --git a/StrataTest/Transform/LoopElim.lean b/StrataTest/Transform/LoopElim.lean index 7753452085..95aec9ecaf 100644 --- a/StrataTest/Transform/LoopElim.lean +++ b/StrataTest/Transform/LoopElim.lean @@ -3,11 +3,13 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Transform.LoopElim -import Strata.Languages.Core.Verifier +meta import Strata.Transform.LoopElim +meta import Strata.Languages.Core.Verifier /-! ## Loop-elimination pipeline phase obligation tests -/ +meta section section LoopElimPhaseTests open Core open Strata.SMT @@ -35,3 +37,4 @@ private def cleanObligation : Imperative.ProofObligation Core.Expression := #guard (satResult.adjustForPhases [loopElimPipelinePhase.phase] cleanObligation).1 == satResult end LoopElimPhaseTests +end diff --git a/StrataTest/Transform/PrecondElim.lean b/StrataTest/Transform/PrecondElim.lean index 3242d25afa..c3bbdad064 100644 --- a/StrataTest/Transform/PrecondElim.lean +++ b/StrataTest/Transform/PrecondElim.lean @@ -3,12 +3,15 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module import Strata.DDM.Integration.Lean -import Strata.Languages.Core.Core -import Strata.Languages.Core.DDMTransform.Translate -import Strata.Languages.Core.ProgramType -import Strata.Transform.PrecondElim +meta import Strata.Languages.Core.Core +meta import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Languages.Core.ProgramType +meta import Strata.Transform.PrecondElim + +meta section open Core open Core.PrecondElim @@ -495,3 +498,4 @@ private def printFirstObligation (expr : Core.Expression.Expr) : IO Unit := do end SeqBoundsObligations end PrecondElimTests +end diff --git a/StrataTest/Transform/ProcBodyVerify.lean b/StrataTest/Transform/ProcBodyVerify.lean index 920c26652d..140c00d156 100644 --- a/StrataTest/Transform/ProcBodyVerify.lean +++ b/StrataTest/Transform/ProcBodyVerify.lean @@ -3,11 +3,14 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Transform.ProcBodyVerify -import Strata.Languages.Core.Program +meta import Strata.Transform.ProcBodyVerify +meta import Strata.Languages.Core.Program import Strata.DDM.Integration.Lean -import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Languages.Core.DDMTransform.Translate + +meta section /-! # Procedure Body Verification Tests @@ -171,3 +174,4 @@ info: ok: verify_MultipleModifies: { "MultipleModifies" end ProcBodyVerifyTest +end diff --git a/StrataTest/Transform/ProcedureInlining.lean b/StrataTest/Transform/ProcedureInlining.lean index a7c7c08f4a..5f4f5d4c13 100644 --- a/StrataTest/Transform/ProcedureInlining.lean +++ b/StrataTest/Transform/ProcedureInlining.lean @@ -3,17 +3,20 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module import Strata.DDM.Integration.Lean -import Strata.DDM.Util.Format -import Strata.Languages.Core.Core -import Strata.Languages.Core.DDMTransform.Translate -import Strata.Languages.Core.StatementSemantics -import Strata.Languages.Core.ProgramType -import Strata.Languages.Core.ProgramWF -import Strata.Transform.CoreTransform -import Strata.Transform.ProcedureInlining -import Strata.Util.Tactics +meta import Strata.DDM.Util.Format +meta import Strata.Languages.Core.Core +meta import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Languages.Core.StatementSemantics +meta import Strata.Languages.Core.ProgramType +meta import Strata.Languages.Core.ProgramWF +meta import Strata.Transform.CoreTransform +meta import Strata.Transform.ProcedureInlining +meta import Strata.Util.Tactics + +meta section open Core open Core.Transform @@ -481,3 +484,4 @@ def testThreeChainCG := do | ⟨.error m, _⟩ => s!"ERROR: {m}")) end ProcedureInliningExamples +end diff --git a/StrataTest/Transform/SymbolicEvalTests.lean b/StrataTest/Transform/SymbolicEvalTests.lean index a14ad8cd8c..e117ae3a36 100644 --- a/StrataTest/Transform/SymbolicEvalTests.lean +++ b/StrataTest/Transform/SymbolicEvalTests.lean @@ -3,10 +3,14 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Core -import Strata.Languages.Core.DDMTransform.Translate -import Strata.SimpleAPI +meta import Strata.Languages.Core.Core +meta import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.SimpleAPI +import Strata.DDM.Integration.Lean.HashCommands + +meta section /-! ## Symbolic evaluation phase tests -/ @@ -242,3 +246,4 @@ procedure blockTest () #eval evalAndPrint blockExitIfProg end Core.SymbolicEval.Tests +end diff --git a/StrataTest/Util/IO.lean b/StrataTest/Util/IO.lean index 480acd8c08..f1dcc153b8 100644 --- a/StrataTest/Util/IO.lean +++ b/StrataTest/Util/IO.lean @@ -3,8 +3,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Util.IO +meta import Strata.Util.IO + +meta section -- Test that readInputSource can read from a regular file def testReadFile : IO Unit := do @@ -48,3 +51,5 @@ info: Binary file read test passed #eval do testReadBinFile IO.println "Binary file read test passed" + +end diff --git a/StrataTest/Util/Python.lean b/StrataTest/Util/Python.lean index f6abf7a1ae..214711d248 100644 --- a/StrataTest/Util/Python.lean +++ b/StrataTest/Util/Python.lean @@ -5,6 +5,7 @@ -/ module +public meta import Strata.DDM.Util.Fin import all Strata.DDM.Util.Fin /- @@ -16,7 +17,7 @@ It also provides a few functions for checking Python versions and running `mise`. -/ -public section +public meta section namespace Strata.Python /-- diff --git a/StrataTest/Util/TestDiagnostics.lean b/StrataTest/Util/TestDiagnostics.lean index ebfb9f8ecb..24a45912f8 100644 --- a/StrataTest/Util/TestDiagnostics.lean +++ b/StrataTest/Util/TestDiagnostics.lean @@ -3,8 +3,10 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +module -import Strata.Languages.Core.Verifier +import Strata.DDM.Parser +public import Strata.Languages.Core.Verifier import Lean.Elab.Command open Strata @@ -13,7 +15,7 @@ open Lean Elab namespace StrataTest.Util /-- A diagnostic expectation parsed from source comments -/ -structure DiagnosticExpectation where +public structure DiagnosticExpectation where line : Nat colStart : Nat colEnd : Nat @@ -31,7 +33,7 @@ private def commentMarker (line : String) : Option String := /-- Parse diagnostic expectations from source file comments. Format: `// ^^^^^^ error: message` or `# ^^^^^^ error: message` on the line after the problematic code -/ -def parseDiagnosticExpectations (content : String) : List DiagnosticExpectation := Id.run do +public def parseDiagnosticExpectations (content : String) : List DiagnosticExpectation := Id.run do let lines := content.splitOn "\n" let mut expectations := [] @@ -80,7 +82,7 @@ def stringContains (haystack : String) (needle : String) : Bool := needle.isEmpty || (haystack.splitOn needle).length > 1 /-- Check if a Diagnostic matches a DiagnosticExpectation -/ -def matchesDiagnostic (diag : Diagnostic) (exp : DiagnosticExpectation) : Bool := +public def matchesDiagnostic (diag : Diagnostic) (exp : DiagnosticExpectation) : Bool := diag.start.line == exp.line && diag.start.column == exp.colStart && diag.ending.line == exp.line && diff --git a/StrataTestExtra/Languages/Python/Issue1000Test.lean b/StrataTestExtra/Languages/Python/Issue1000Test.lean index 0bf12058d6..ad5ed5d230 100644 --- a/StrataTestExtra/Languages/Python/Issue1000Test.lean +++ b/StrataTestExtra/Languages/Python/Issue1000Test.lean @@ -6,6 +6,7 @@ import StrataTest.Languages.Python.TestExamples import StrataTest.Util.TestDiagnostics +import StrataTest.Util.Python open StrataTest.Util open Strata.Python (processPythonFile withPython) diff --git a/StrataTestExtra/Languages/Python/VerifyPythonTest.lean b/StrataTestExtra/Languages/Python/VerifyPythonTest.lean index 2e23151c6f..8da9c5124f 100644 --- a/StrataTestExtra/Languages/Python/VerifyPythonTest.lean +++ b/StrataTestExtra/Languages/Python/VerifyPythonTest.lean @@ -4,9 +4,10 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ +import Strata.DDM.Parser import StrataTest.Languages.Python.TestExamples +import StrataTest.Util.Python import StrataTest.Util.TestDiagnostics -import Strata.DDM.Parser /-! ## Test: Inline Python verification via processPythonFile From beb9b9c47860541377f882385a1b6f32ed0b59da Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mika=C3=ABl=20Mayer?= Date: Wed, 20 May 2026 18:04:54 -0500 Subject: [PATCH 26/28] Pass mkDischarge through PyAnalyzeConfig to verifyProgram (#1200) The `mkDischarge` parameter was accepted by `Core.verifyProgram` but not exposed through `PyAnalyzeConfig` or the CLI `verify` command, so callers could not supply a custom solver discharge function. This PR: - Adds `mkDischarge` to `PyAnalyzeConfig` (defaulting to `Core.mkDischargeFn`) and forwards it to the verification call. - Adds `mkDischarge` as a parameter to `verifyCommand` and passes it through to the `verify` call. - Adds `mkDischarge` as a parameter to `pyAnalyzeLaurelCommand` (same pattern), so downstream executables can override the discharge function without redefining the command. Tested: existing tests pass, build succeeds. Fixes #1199 --- Strata/Pipeline/PyAnalyzeLaurel.lean | 2 ++ StrataMainLib.lean | 8 ++++---- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/Strata/Pipeline/PyAnalyzeLaurel.lean b/Strata/Pipeline/PyAnalyzeLaurel.lean index a03fe7d187..9f5e4f9e68 100644 --- a/Strata/Pipeline/PyAnalyzeLaurel.lean +++ b/Strata/Pipeline/PyAnalyzeLaurel.lean @@ -39,6 +39,7 @@ public structure PyAnalyzeConfig where skipVerification : Bool := false profilePipeline : Bool := true metricsHandle : Option IO.FS.Handle := none + mkDischarge : Core.MkDischargeFn := Core.mkDischargeFn private def runPipeline (config : PyAnalyzeConfig) : PipelineM (PyAnalyzeOutcome × Statistics) := do @@ -99,6 +100,7 @@ private def runPipeline (config : PyAnalyzeConfig) (externalPhases := [Strata.frontEndPhase]) (prefixPhases := inlinePhases) (keepAllFilesPrefix := config.keepAllFilesPrefix) + (mkDischarge := config.mkDischarge) (pipelineCtx := some ctx) |>.toBaseIO diff --git a/StrataMainLib.lean b/StrataMainLib.lean index 2ca6c87ba2..d697b2aa32 100644 --- a/StrataMainLib.lean +++ b/StrataMainLib.lean @@ -599,7 +599,7 @@ private def reportUserCodeError (range : SourceRange) (msg : String) h.putStrLn line return location -def pyAnalyzeLaurelCommand : Command where +def pyAnalyzeLaurelCommand (mkDischarge : Core.MkDischargeFn := Core.mkDischargeFn) : Command where name := "pyAnalyzeLaurel" args := [ "file" ] flags := verifyOptionsFlags ++ [ @@ -694,7 +694,7 @@ def pyAnalyzeLaurelCommand : Command where verifyOptions := options entryPoint, isBugFinding outputMode, skipVerification - metricsHandle + metricsHandle, mkDischarge } -- Always print pipeline warnings @@ -1263,7 +1263,7 @@ def transformCommand : Command where | .ok program => IO.print (Core.formatProgram program) | .error e => exitFailure s!"Transform failed: {e}" -def verifyCommand : Command where +def verifyCommand (mkDischarge : Core.MkDischargeFn := Core.mkDischargeFn) : Command where name := "verify" args := [ "file" ] flags := verifyOptionsFlags ++ [ @@ -1332,7 +1332,7 @@ def verifyCommand : Command where else if pgm.dialect == "Boole" then Boole.verify opts.solver pgm inputCtx proceduresToVerify opts else - verify pgm inputCtx proceduresToVerify opts + verify pgm inputCtx proceduresToVerify opts (mkDischarge := mkDischarge) catch e => println! f!"{e}" IO.Process.exit ExitCode.internalError From e9d0f83d83b915b8d6a4e30aa94db134270129cc Mon Sep 17 00:00:00 2001 From: Joe Hendrix Date: Thu, 21 May 2026 09:19:46 -0700 Subject: [PATCH 27/28] Minimize imports via lake shake and add import lint/stats (#1020) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit ## Summary Run `lake shake` to minimize the import graph across all 293 Strata modules, reducing average transitive Strata imports by 32% (56 → 38) and total transitive imports (including Lean/Std) by 40% (1379 → 831). Add CI linting to ensure `Strata.lean` transitively imports every module, and add an import statistics script for ongoing measurement. ## Changes - **Import lint driver (`Scripts/CheckImports.lean`)**: Verifies that all `.lean` files under `Strata/` are transitively imported by `Strata.lean`. Registered as `lintDriver` in `lakefile.toml` so `lake lint` runs it automatically. Supports `-- noimport: Strata.Foo` comments in `Strata.lean` to allowlist intentionally excluded modules. - **Import statistics script (`Scripts/ImportStats.lean`)**: Computes per-module transitive import counts (both total and Strata-only), reporting average, median, min, max, top/bottom lists, and histograms. Run via `lake exe ImportStats`. - **`lake shake Strata --fix`**: Applied shake's suggestions to remove unnecessary imports across 225 files (net -185 lines). This is the bulk of the change. - **Aggregator modules use `-- shake: keep`**: Pure aggregator modules (`CBMC.lean`, `GOTO.lean`, `B3.lean`, `Dyn.lean`, `Python.lean`, `Imperative.lean`, `Lambda.lean`, `DDM.lean`, `LExprType.lean`, `B3/Verifier.lean`) intentionally re-export their submodules and are annotated with `-- shake: keep` so `lake shake --fix` won't strip them. - **DDM elaboration imports use `-- shake: keep`**: Files using `#dialect`, `#strata`, `#strata_gen`, and related macros have elaboration-time import dependencies that shake cannot detect. These are annotated with `-- shake: keep` to prevent breakage. - **Renamed aggregator files**: `Dyn/Dyn.lean` → `Dyn.lean`, `Python/Python.lean` → `Python.lean`, `Imperative/Imperative.lean` → `Imperative.lean` — the `Foo/Foo.lean` pattern is unnecessary now that these are proper `module` files. - **Orphaned modules added to `Strata.lean`**: When shake stripped re-exports from real code files (e.g. `ProgramWF.lean` no longer re-exports `StatementWF`), the orphaned modules were added directly to `Strata.lean` to maintain full coverage. ## Results | Metric | Before | After | Change | |---|---|---|---| | Avg transitive imports (Strata-only) | 56.2 | 38.2 | -32% | | Median transitive imports (Strata-only) | 38 | 22 | -42% | | Avg transitive imports (all) | 1379 | 831 | -40% | | Total import edges (Strata-only) | 16,455 | 11,194 | -32% | | Clean build time | 3m 02s | 2m 58s | -2% | By submitting this pull request, I confirm that you can use, modify, copy, and redistribute this contribution, under the terms of your choice. --- Strata.lean | 32 +- Strata/Backends/CBMC/CProver.lean | 2 - Strata/Backends/CBMC/CollectSymbols.lean | 4 +- Strata/Backends/CBMC/Common.lean | 2 +- Strata/Backends/CBMC/CoreToCBMC.lean | 10 +- Strata/Backends/CBMC/GOTO/Code.lean | 1 - .../Backends/CBMC/GOTO/CoreToCProverGOTO.lean | 10 +- .../CBMC/GOTO/CoreToGOTOPipeline.lean | 6 +- Strata/Backends/CBMC/GOTO/Expr.lean | 1 - Strata/Backends/CBMC/GOTO/InstToJson.lean | 5 +- Strata/Backends/CBMC/GOTO/Instruction.lean | 1 - .../CBMC/GOTO/LambdaToCProverGOTO.lean | 2 +- Strata/Backends/CBMC/GOTO/SourceLocation.lean | 2 +- Strata/Backends/CBMC/StrataToCBMC.lean | 12 +- Strata/DDM/Elab/Core.lean | 4 +- Strata/DDM/Elab/DialectM.lean | 1 - Strata/DDM/Util/Ion/SystemSymbolIds.lean | 2 +- Strata/DL/{Imperative => }/Imperative.lean | 5 +- Strata/DL/Imperative/BasicBlock.lean | 1 - Strata/DL/Imperative/CFGSemantics.lean | 3 - Strata/DL/Imperative/Cmd.lean | 2 - Strata/DL/Imperative/CmdEval.lean | 1 - Strata/DL/Imperative/CmdSemantics.lean | 3 - Strata/DL/Imperative/CmdType.lean | 1 - Strata/DL/Imperative/EvalContext.lean | 3 - Strata/DL/Imperative/KleeneStmt.lean | 4 +- Strata/DL/Imperative/MetaData.lean | 1 - Strata/DL/Imperative/SMTUtils.lean | 8 +- Strata/DL/Imperative/SemanticsProps.lean | 1 - Strata/DL/Imperative/StmtEval.lean | 2 +- Strata/DL/Imperative/ToCProverGOTO.lean | 5 +- Strata/DL/Lambda/AdtRankAxioms.lean | 1 - Strata/DL/Lambda/Denote/LExprAnnotated.lean | 1 - Strata/DL/Lambda/Denote/LExprDenote.lean | 6 +- Strata/DL/Lambda/Factory.lean | 6 +- Strata/DL/Lambda/FactoryWF.lean | 7 - Strata/DL/Lambda/Identifiers.lean | 4 +- Strata/DL/Lambda/IntBoolFactory.lean | 1 - Strata/DL/Lambda/LExpr.lean | 5 +- Strata/DL/Lambda/LExprEval.lean | 1 - Strata/DL/Lambda/LExprT.lean | 1 - Strata/DL/Lambda/LExprType.lean | 9 - Strata/DL/Lambda/LExprTypeEnv.lean | 6 +- Strata/DL/Lambda/LExprTypeSpec.lean | 4 +- Strata/DL/Lambda/LExprWF.lean | 1 + Strata/DL/Lambda/LState.lean | 2 +- Strata/DL/Lambda/LTy.lean | 5 +- Strata/DL/Lambda/LTyUnify.lean | 1 + Strata/DL/Lambda/Lambda.lean | 7 +- Strata/DL/Lambda/Preconditions.lean | 2 - Strata/DL/Lambda/RecursiveAxioms.lean | 2 - Strata/DL/Lambda/Reflect.lean | 12 +- Strata/DL/Lambda/Scopes.lean | 2 +- Strata/DL/Lambda/Semantics.lean | 3 - Strata/DL/Lambda/TypeFactory.lean | 4 - Strata/DL/{SMT => }/SMT.lean | 2 +- Strata/DL/SMT/DDMTransform/Parse.lean | 4 +- Strata/DL/SMT/DDMTransform/Translate.lean | 5 +- Strata/DL/SMT/Denote.lean | 1 + Strata/DL/SMT/Encoder.lean | 12 +- Strata/DL/SMT/Factory.lean | 2 - Strata/DL/SMT/FactoryCorrect.lean | 2 +- Strata/DL/SMT/Function.lean | 2 +- Strata/DL/SMT/IncrementalSolver.lean | 5 +- Strata/DL/SMT/Op.lean | 1 + Strata/DL/SMT/Solver.lean | 9 +- Strata/DL/SMT/Term.lean | 3 +- Strata/DL/SMT/Translate.lean | 1 - Strata/DL/Util/LabelGen.lean | 1 - Strata/DL/Util/Nodup.lean | 1 + .../Languages/B3/DDMTransform/Conversion.lean | 1 + .../B3/DDMTransform/DefinitionAST.lean | 4 +- .../Languages/B3/DDMTransform/ParseCST.lean | 5 +- Strata/Languages/B3/Verifier.lean | 6 +- Strata/Languages/B3/Verifier/Diagnosis.lean | 2 - Strata/Languages/B3/Verifier/Expression.lean | 5 +- Strata/Languages/B3/Verifier/Formatter.lean | 3 +- Strata/Languages/B3/Verifier/Program.lean | 8 +- Strata/Languages/B3/Verifier/State.lean | 1 - Strata/Languages/B3/Verifier/Statements.lean | 5 - Strata/Languages/Boole/Boole.lean | 4 +- Strata/Languages/Boole/Grammar.lean | 7 +- Strata/Languages/Boole/Verify.lean | 7 +- Strata/Languages/C_Simp/C_Simp.lean | 8 +- .../Languages/C_Simp/DDMTransform/Parse.lean | 5 +- .../C_Simp/DDMTransform/Translate.lean | 3 +- Strata/Languages/C_Simp/Verify.lean | 7 +- Strata/Languages/Core/Axiom.lean | 4 +- Strata/Languages/Core/CallGraph.lean | 2 + Strata/Languages/Core/CmdEval.lean | 3 - Strata/Languages/Core/CmdType.lean | 2 +- Strata/Languages/Core/Core.lean | 8 +- Strata/Languages/Core/CoreGen.lean | 7 +- .../Languages/Core/DDMTransform/ASTtoCST.lean | 1 - .../Core/DDMTransform/FormatCore.lean | 2 +- .../Languages/Core/DDMTransform/Grammar.lean | 3 +- .../Core/DDMTransform/Translate.lean | 7 +- Strata/Languages/Core/EntryPoint.lean | 1 - Strata/Languages/Core/Env.lean | 3 +- Strata/Languages/Core/Expressions.lean | 4 +- Strata/Languages/Core/Factory.lean | 5 +- Strata/Languages/Core/FactoryWF.lean | 3 - Strata/Languages/Core/Function.lean | 2 +- Strata/Languages/Core/FunctionType.lean | 3 +- Strata/Languages/Core/Identifiers.lean | 4 +- .../Languages/Core/ObligationExtraction.lean | 3 +- Strata/Languages/Core/PipelinePhase.lean | 1 - Strata/Languages/Core/Procedure.lean | 1 - Strata/Languages/Core/ProcedureEval.lean | 7 +- Strata/Languages/Core/ProcedureType.lean | 6 +- Strata/Languages/Core/ProcedureWF.lean | 6 +- Strata/Languages/Core/Program.lean | 1 - Strata/Languages/Core/ProgramEval.lean | 10 +- Strata/Languages/Core/ProgramType.lean | 4 +- Strata/Languages/Core/ProgramWF.lean | 5 +- Strata/Languages/Core/SMTEncoder.lean | 11 +- Strata/Languages/Core/Statement.lean | 8 +- Strata/Languages/Core/StatementEval.lean | 7 +- Strata/Languages/Core/StatementSemantics.lean | 5 +- .../Core/StatementSemanticsProps.lean | 9 +- Strata/Languages/Core/StatementType.lean | 9 +- Strata/Languages/Core/StatementWF.lean | 4 - Strata/Languages/Core/Statistics.lean | 2 +- Strata/Languages/Core/TypeDecl.lean | 2 +- Strata/Languages/Core/Verifier.lean | 16 +- Strata/Languages/Core/WF.lean | 1 - Strata/Languages/Dyn/DDMTransform/Parse.lean | 5 +- Strata/Languages/Dyn/Dyn.lean | 3 +- Strata/Languages/Dyn/Verify.lean | 1 - .../Languages/Laurel/ConstrainedTypeElim.lean | 3 +- .../Laurel/CoreDefinitionsForLaurel.lean | 8 +- .../Laurel/CoreGroupingAndOrdering.lean | 2 +- .../Languages/Laurel/DesugarShortCircuit.lean | 5 +- Strata/Languages/Laurel/EliminateHoles.lean | 4 +- .../Laurel/EliminateValueReturns.lean | 4 +- Strata/Languages/Laurel/FilterPrelude.lean | 1 + Strata/Languages/Laurel/Grammar.lean | 10 + .../AbstractToConcreteTreeTranslator.lean | 4 +- .../ConcreteToAbstractTreeTranslator.lean | 3 - .../Laurel/Grammar/LaurelGrammar.lean | 5 +- .../Laurel/HeapParameterization.lean | 12 +- .../Laurel/HeapParameterizationConstants.lean | 8 +- Strata/Languages/Laurel/InferHoleTypes.lean | 5 +- Strata/Languages/Laurel/Laurel.lean | 3 +- .../Laurel/LaurelCompilationPipeline.lean | 12 +- .../Laurel/LaurelToCoreTranslator.lean | 28 +- Strata/Languages/Laurel/LaurelTypes.lean | 3 - .../Laurel/LiftImperativeExpressions.lean | 7 +- Strata/Languages/Laurel/ModifiesClauses.lean | 5 +- Strata/Languages/Laurel/Resolution.lean | 3 +- Strata/Languages/Laurel/TypeAliasElim.lean | 2 +- Strata/Languages/Laurel/TypeHierarchy.lean | 7 +- Strata/Languages/Python/CorePrelude.lean | 7 +- .../Languages/Python/FunctionSignatures.lean | 3 +- Strata/Languages/Python/PyFactory.lean | 6 +- Strata/Languages/Python/PySpecPipeline.lean | 1 - Strata/Languages/Python/Python.lean | 5 - Strata/Languages/Python/PythonDialect.lean | 8 +- .../Python/PythonLaurelCorePrelude.lean | 7 +- .../Python/PythonRuntimeLaurelPart.lean | 2 + Strata/Languages/Python/PythonToCore.lean | 10 +- Strata/Languages/Python/PythonToLaurel.lean | 3 +- Strata/Languages/Python/Regex/ReToCore.lean | 3 +- Strata/Languages/Python/Specs.lean | 2 - Strata/Languages/Python/Specs/DDM.lean | 5 +- Strata/Languages/Python/Specs/Decls.lean | 1 - .../Python/Specs/IdentifyOverloads.lean | 2 +- Strata/Languages/Python/Specs/ToLaurel.lean | 1 - Strata/MetaVerifier.lean | 33 +- Strata/Pipeline/Context.lean | 1 - Strata/Pipeline/PyAnalyzeLaurel.lean | 4 +- Strata/SimpleAPI.lean | 10 +- Strata/Transform/CallElim.lean | 1 - Strata/Transform/CallElimCorrect.lean | 15 +- Strata/Transform/CoreSpecification.lean | 1 - Strata/Transform/CoreTransform.lean | 2 - Strata/Transform/DetToKleene.lean | 2 - Strata/Transform/DetToKleeneCorrect.lean | 7 +- Strata/Transform/FilterProcedures.lean | 2 +- Strata/Transform/LoopElim.lean | 1 - Strata/Transform/PrecondElim.lean | 11 +- Strata/Transform/ProcBodyVerify.lean | 3 - Strata/Transform/ProcBodyVerifyCorrect.lean | 7 +- Strata/Transform/ProcedureInlining.lean | 8 - Strata/Transform/Specification.lean | 1 - .../Transform/StructuredToUnstructured.lean | 4 - Strata/Transform/TerminationCheck.lean | 6 +- Strata/Util/FileRange.lean | 1 - Strata/Util/IO.lean | 4 - Strata/Util/List.lean | 2 +- Strata/Util/Sarif.lean | 4 +- Strata/Util/Statistics.lean | 5 +- Strata/Util/Tactics.lean | 7 +- StrataMainLib.lean | 1 + .../Backends/CBMC/GOTO/E2E_CoreToGOTO.lean | 2 + .../CBMC/GOTO/LambdaToCProverGOTO.lean | 1 + .../Backends/CBMC/GOTO/ToCProverGOTO.lean | 1 + .../Backends/CBMC/SimpleAdd/SimpleAdd.lean | 1 + StrataTest/DL/Imperative/ArithEval.lean | 3 +- StrataTest/DL/Imperative/ArithType.lean | 1 + .../DL/Imperative/CFGToCProverGOTO.lean | 1 + StrataTest/DL/Imperative/SMTEncoder.lean | 2 +- StrataTest/DL/Lambda/ReflectTests.lean | 4 +- StrataTest/DL/Lambda/TestGen.lean | 4 +- StrataTest/Languages/B3/DDMFormatTests.lean | 1 + .../B3/Verifier/TranslationTests.lean | 1 + .../Languages/B3/Verifier/VerifierTests.lean | 2 + .../Languages/C_Simp/Examples/Coprime.lean | 3 +- .../Core/Examples/DDMAxiomsExtraction.lean | 303 +----------------- StrataTest/Languages/Core/Examples/Loops.lean | 1 + .../Core/Examples/SubstFvarsCaptureTests.lean | 1 + .../Languages/Core/Examples/TypeDecl.lean | 1 + .../Languages/Core/Tests/CmdEvalTests.lean | 1 + .../Core/Tests/ProcedureTypeTests.lean | 1 + .../Core/Tests/ProgramEvalTests.lean | 3 +- .../Laurel/ConstrainedTypeElimTest.lean | 3 +- .../Laurel/LiftExpressionAssignmentsTest.lean | 4 +- .../LiftImperativeCallsInAssertTest.lean | 4 +- .../Languages/Laurel/TypeAliasElimTest.lean | 5 +- .../Languages/Python/PySpecArgTypeTest.lean | 1 + StrataTest/Transform/ANFEncoderTests.lean | 2 + 221 files changed, 408 insertions(+), 855 deletions(-) rename Strata/DL/{Imperative => }/Imperative.lean (87%) delete mode 100644 Strata/DL/Lambda/LExprType.lean rename Strata/DL/{SMT => }/SMT.lean (94%) create mode 100644 Strata/Languages/Laurel/Grammar.lean diff --git a/Strata.lean b/Strata.lean index 4f094503e4..e1428c20c5 100644 --- a/Strata.lean +++ b/Strata.lean @@ -12,9 +12,9 @@ import Strata.DDM.Integration.Lean import Strata.DDM.Ion /- Dialect Library -/ -import Strata.DL.SMT.SMT +import Strata.DL.SMT import Strata.DL.Lambda.Lambda -import Strata.DL.Imperative.Imperative +import Strata.DL.Imperative /- Utilities -/ import Strata.Util.NameProofs @@ -25,6 +25,8 @@ import Strata.Languages.Core.FactoryWF import Strata.Languages.Core.SeqModel import Strata.Languages.Core.StatementSemantics import Strata.Languages.Core.SarifOutput + +import Strata.Languages.Laurel.Grammar import Strata.Languages.Laurel.LaurelCompilationPipeline /- Code Transforms -/ @@ -71,4 +73,28 @@ import Strata.SimpleAPI /- Pipeline -/ import Strata.Pipeline.PyAnalyzeLaurel --- noimport: Strata.Util.Random -- deletion candidate: nothing imports this module + -- deletion candidates: nothing imports these modules: + +-- noimport: +import Strata.DL.Imperative.CFGSemantics +import Strata.DL.Imperative.SemanticsProps +import Strata.DL.Lambda.Denote.Assumptions +import Strata.DL.Lambda.Denote.CallOfLFuncDenote +import Strata.DL.Lambda.Denote.LExprDenote +import Strata.DL.Lambda.Denote.LExprDenoteConstrs +import Strata.DL.Lambda.Denote.LExprDenoteEq +import Strata.DL.Lambda.Denote.LExprDenoteProps +import Strata.DL.Lambda.Denote.LExprDenoteSubst +import Strata.DL.Lambda.Denote.LExprDenoteTySubst +import Strata.DL.Lambda.Denote.LExprSemanticsConsistent +import Strata.DL.Lambda.LExprTypeSpec +import Strata.DL.Lambda.MetaData +import Strata.DL.Lambda.Reflect +import Strata.DL.Lambda.Semantics +import Strata.DL.Lambda.TypeFactoryWF +import Strata.DL.Util.HList +import Strata.Languages.Core.ProgramWF +import Strata.Languages.Core.StatementWF +import Strata.Languages.Dyn.DDMTransform.Parse +import Strata.Languages.Dyn.DDMTransform.Translate +import Strata.Util.Random diff --git a/Strata/Backends/CBMC/CProver.lean b/Strata/Backends/CBMC/CProver.lean index b121a91ac8..b1f08998ef 100644 --- a/Strata/Backends/CBMC/CProver.lean +++ b/Strata/Backends/CBMC/CProver.lean @@ -7,5 +7,3 @@ module ------------------------------------------------------------------------------- -public import Strata.Backends.CBMC.GOTO.Program -public import Strata.Backends.CBMC.GOTO.InstToJson diff --git a/Strata/Backends/CBMC/CollectSymbols.lean b/Strata/Backends/CBMC/CollectSymbols.lean index 2eaead9e63..7d4918f5f9 100644 --- a/Strata/Backends/CBMC/CollectSymbols.lean +++ b/Strata/Backends/CBMC/CollectSymbols.lean @@ -6,10 +6,8 @@ module public import Strata.Backends.CBMC.GOTO.InstToJson -public import Strata.Backends.CBMC.GOTO.LambdaToCProverGOTO -import Strata.DL.Lambda.TypeConstructor -import Strata.DL.Lambda.TypeFactory public import Strata.Languages.Core.Program +import Strata.Backends.CBMC.GOTO.LambdaToCProverGOTO namespace Strata diff --git a/Strata/Backends/CBMC/Common.lean b/Strata/Backends/CBMC/Common.lean index 42dda661f3..02d18338d3 100644 --- a/Strata/Backends/CBMC/Common.lean +++ b/Strata/Backends/CBMC/Common.lean @@ -5,8 +5,8 @@ -/ module -public import Lean.Data.Json public import Strata.DL.Util.Map +public import Lean.Data.Json.FromToJson.Basic public section diff --git a/Strata/Backends/CBMC/CoreToCBMC.lean b/Strata/Backends/CBMC/CoreToCBMC.lean index 04617c385c..6e3b2f2587 100644 --- a/Strata/Backends/CBMC/CoreToCBMC.lean +++ b/Strata/Backends/CBMC/CoreToCBMC.lean @@ -8,15 +8,9 @@ module public import Strata.Backends.CBMC.Common public import Strata.Languages.Core.Procedure -import Lean.Data.Json -import Lean.Parser.Types -import Strata.DDM.Integration.Lean.HashCommands -import Strata.Languages.Core.Env -import Strata.Languages.Core.DDMTransform.Grammar +public import Strata.DDM.AST +import Strata.DDM.Integration.Lean.HashCommands -- shake: keep import Strata.Languages.Core.DDMTransform.Translate -import Strata.DL.Util.Map -import Strata.Languages.Core.Core -import Strata.Util.Tactics public section diff --git a/Strata/Backends/CBMC/GOTO/Code.lean b/Strata/Backends/CBMC/GOTO/Code.lean index 28e687efc2..5f3a70e68a 100644 --- a/Strata/Backends/CBMC/GOTO/Code.lean +++ b/Strata/Backends/CBMC/GOTO/Code.lean @@ -6,7 +6,6 @@ module public import Strata.Backends.CBMC.GOTO.Expr -public import Strata.Backends.CBMC.GOTO.SourceLocation import Strata.Util.Tactics namespace CProverGOTO diff --git a/Strata/Backends/CBMC/GOTO/CoreToCProverGOTO.lean b/Strata/Backends/CBMC/GOTO/CoreToCProverGOTO.lean index a0ef4725c2..7ade59e8b8 100644 --- a/Strata/Backends/CBMC/GOTO/CoreToCProverGOTO.lean +++ b/Strata/Backends/CBMC/GOTO/CoreToCProverGOTO.lean @@ -5,12 +5,14 @@ -/ module -public import Strata.Backends.CBMC.GOTO.InstToJson -public import Strata.Backends.CBMC.GOTO.DefaultSymbols public import Strata.Backends.CBMC.GOTO.LambdaToCProverGOTO public import Strata.DL.Imperative.ToCProverGOTO -public import Strata.Languages.Core.Verifier -import Lean.Parser.Types +public import Strata.Backends.CBMC.GOTO.Program +public import Strata.Languages.Core.Program +import Strata.Backends.CBMC.GOTO.DefaultSymbols +import Strata.Languages.Core.DDMTransform.Translate +import Strata.Languages.Core.ProgramType +import Strata.Util.Json public section diff --git a/Strata/Backends/CBMC/GOTO/CoreToGOTOPipeline.lean b/Strata/Backends/CBMC/GOTO/CoreToGOTOPipeline.lean index 2cc5e57433..535f7cfe39 100644 --- a/Strata/Backends/CBMC/GOTO/CoreToGOTOPipeline.lean +++ b/Strata/Backends/CBMC/GOTO/CoreToGOTOPipeline.lean @@ -5,9 +5,13 @@ -/ module -public import Strata.Backends.CBMC.CollectSymbols public import Strata.Backends.CBMC.GOTO.CoreToCProverGOTO import Strata.Transform.ProcedureInlining +public import Strata.Languages.Core.Factory +import Strata.Backends.CBMC.CollectSymbols +import Strata.Backends.CBMC.GOTO.DefaultSymbols +import Strata.Languages.Core.ProgramType +import Strata.Util.Json /-! ## Core-to-GOTO translation pipeline diff --git a/Strata/Backends/CBMC/GOTO/Expr.lean b/Strata/Backends/CBMC/GOTO/Expr.lean index 5befec28f3..26dfb43be7 100644 --- a/Strata/Backends/CBMC/GOTO/Expr.lean +++ b/Strata/Backends/CBMC/GOTO/Expr.lean @@ -6,7 +6,6 @@ module public import Strata.Backends.CBMC.GOTO.Type -public import Strata.Backends.CBMC.GOTO.SourceLocation import Strata.Util.Tactics namespace CProverGOTO diff --git a/Strata/Backends/CBMC/GOTO/InstToJson.lean b/Strata/Backends/CBMC/GOTO/InstToJson.lean index f88a359df7..1d729feeac 100644 --- a/Strata/Backends/CBMC/GOTO/InstToJson.lean +++ b/Strata/Backends/CBMC/GOTO/InstToJson.lean @@ -5,11 +5,12 @@ -/ module -public import Strata.Backends.CBMC.Common -public import Strata.Util.Json public import Strata.Backends.CBMC.GOTO.Program import Strata.Util.Tactics +public import Strata.DL.Util.Map +import Strata.Backends.CBMC.Common +import Strata.Util.Json public section diff --git a/Strata/Backends/CBMC/GOTO/Instruction.lean b/Strata/Backends/CBMC/GOTO/Instruction.lean index 11832259b2..9a064c49b0 100644 --- a/Strata/Backends/CBMC/GOTO/Instruction.lean +++ b/Strata/Backends/CBMC/GOTO/Instruction.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.Backends.CBMC.GOTO.Expr public import Strata.Backends.CBMC.GOTO.Code namespace CProverGOTO diff --git a/Strata/Backends/CBMC/GOTO/LambdaToCProverGOTO.lean b/Strata/Backends/CBMC/GOTO/LambdaToCProverGOTO.lean index f1605bee04..acb40ec514 100644 --- a/Strata/Backends/CBMC/GOTO/LambdaToCProverGOTO.lean +++ b/Strata/Backends/CBMC/GOTO/LambdaToCProverGOTO.lean @@ -5,9 +5,9 @@ -/ module -public import Strata.DL.Lambda.Lambda public import Strata.Backends.CBMC.GOTO.Expr import Strata.Languages.Core.CoreOp +public import Strata.DL.Lambda.LExprT public section namespace Lambda diff --git a/Strata/Backends/CBMC/GOTO/SourceLocation.lean b/Strata/Backends/CBMC/GOTO/SourceLocation.lean index 2ad412eefa..48d193c8f7 100644 --- a/Strata/Backends/CBMC/GOTO/SourceLocation.lean +++ b/Strata/Backends/CBMC/GOTO/SourceLocation.lean @@ -5,7 +5,7 @@ -/ module -public import Lean.Data.Json +public import Lean.Data.Json.FromToJson.Basic namespace CProverGOTO ------------------------------------------------------------------------------- diff --git a/Strata/Backends/CBMC/StrataToCBMC.lean b/Strata/Backends/CBMC/StrataToCBMC.lean index 394f875498..a931ce7c39 100644 --- a/Strata/Backends/CBMC/StrataToCBMC.lean +++ b/Strata/Backends/CBMC/StrataToCBMC.lean @@ -5,13 +5,13 @@ -/ module -import Lean.Data.Json -import Lean.Parser.Types -import Strata.DL.Util.Map -public import Strata.Languages.C_Simp.C_Simp -public import Strata.Languages.C_Simp.Verify public import Strata.Backends.CBMC.Common -import Strata.Util.Tactics +public import Strata.DDM.AST +import Strata.DDM.Integration.Lean.HashCommands -- shake: keep +public import Strata.Languages.C_Simp.C_Simp +import Strata.Languages.C_Simp.DDMTransform.Parse +import Strata.Languages.C_Simp.DDMTransform.Translate +import Strata.Languages.Core.Identifiers open Lean open Strata.CBMC diff --git a/Strata/DDM/Elab/Core.lean b/Strata/DDM/Elab/Core.lean index ac7821282d..e44c777d3c 100644 --- a/Strata/DDM/Elab/Core.lean +++ b/Strata/DDM/Elab/Core.lean @@ -11,8 +11,8 @@ import Strata.DDM.HNF import all Strata.DDM.Util.Array import all Strata.DDM.Util.Fin import all Strata.DDM.Util.Lean -import Strata.DDM.Util.Fin -import Strata.Util.DecideProp +public import Strata.DDM.Util.Fin +public import Strata.Util.DecideProp open Lean ( Message diff --git a/Strata/DDM/Elab/DialectM.lean b/Strata/DDM/Elab/DialectM.lean index ed3286c482..9e9c859bf0 100644 --- a/Strata/DDM/Elab/DialectM.lean +++ b/Strata/DDM/Elab/DialectM.lean @@ -11,7 +11,6 @@ public import Strata.DDM.Elab.Core import all Strata.DDM.Util.Array import all Strata.DDM.Util.Fin -import Strata.Util.DecideProp set_option autoImplicit false diff --git a/Strata/DDM/Util/Ion/SystemSymbolIds.lean b/Strata/DDM/Util/Ion/SystemSymbolIds.lean index dfb0dad26d..d99667dbb5 100644 --- a/Strata/DDM/Util/Ion/SystemSymbolIds.lean +++ b/Strata/DDM/Util/Ion/SystemSymbolIds.lean @@ -7,7 +7,7 @@ module import Lean.Elab.Command -- shake: keep public import Strata.DDM.Util.Ion.AST -meta import Strata.DDM.Util.Ion.SymbolTable +meta import Strata.DDM.Util.Ion.SymbolTable --shake: keep -- Use metaprogramming to declare `{sym}SymbolId : SymbolId` for each system symbol. section diff --git a/Strata/DL/Imperative/Imperative.lean b/Strata/DL/Imperative.lean similarity index 87% rename from Strata/DL/Imperative/Imperative.lean rename to Strata/DL/Imperative.lean index 7713f0753e..a9abadbe4e 100644 --- a/Strata/DL/Imperative/Imperative.lean +++ b/Strata/DL/Imperative.lean @@ -3,7 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -module +module -- shake: keep-all public import Strata.DL.Imperative.PureExpr public import Strata.DL.Imperative.HasVars @@ -20,6 +20,3 @@ public import Strata.DL.Imperative.KleeneStmtSemantics public import Strata.DL.Imperative.SemanticsProps public import Strata.DL.Imperative.SMTUtils - -import Strata.DL.Imperative.BasicBlock -import Strata.DL.Imperative.CFGSemantics diff --git a/Strata/DL/Imperative/BasicBlock.lean b/Strata/DL/Imperative/BasicBlock.lean index c956006655..564652f1dc 100644 --- a/Strata/DL/Imperative/BasicBlock.lean +++ b/Strata/DL/Imperative/BasicBlock.lean @@ -6,7 +6,6 @@ module public import Strata.DL.Imperative.MetaData -public import Strata.DL.Imperative.PureExpr public section diff --git a/Strata/DL/Imperative/CFGSemantics.lean b/Strata/DL/Imperative/CFGSemantics.lean index f472e56d04..9ddd57722e 100644 --- a/Strata/DL/Imperative/CFGSemantics.lean +++ b/Strata/DL/Imperative/CFGSemantics.lean @@ -6,10 +6,7 @@ module public import Strata.DL.Imperative.BasicBlock -public import Strata.DL.Imperative.Cmd -public import Strata.DL.Imperative.CmdSemantics public import Strata.DL.Imperative.StmtSemantics -public import Strata.DL.Util.Relations public section diff --git a/Strata/DL/Imperative/Cmd.lean b/Strata/DL/Imperative/Cmd.lean index 24da7fce49..ac443016d2 100644 --- a/Strata/DL/Imperative/Cmd.lean +++ b/Strata/DL/Imperative/Cmd.lean @@ -5,10 +5,8 @@ -/ module -public import Strata.DL.Imperative.PureExpr public import Strata.DL.Imperative.MetaData public import Strata.DL.Imperative.HasVars -import Strata.DL.Lambda.LExpr --------------------------------------------------------------------- diff --git a/Strata/DL/Imperative/CmdEval.lean b/Strata/DL/Imperative/CmdEval.lean index c5c99659f2..46bd494695 100644 --- a/Strata/DL/Imperative/CmdEval.lean +++ b/Strata/DL/Imperative/CmdEval.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.DL.Imperative.Cmd public import Strata.DL.Imperative.EvalContext namespace Imperative diff --git a/Strata/DL/Imperative/CmdSemantics.lean b/Strata/DL/Imperative/CmdSemantics.lean index a2da7a8607..712f09657f 100644 --- a/Strata/DL/Imperative/CmdSemantics.lean +++ b/Strata/DL/Imperative/CmdSemantics.lean @@ -6,9 +6,6 @@ module public import Strata.DL.Imperative.Cmd -public import Strata.DL.Imperative.HasVars -public import Strata.DL.Util.Map -public import Strata.DL.Util.ListUtils import all Strata.DL.Util.ListUtils --------------------------------------------------------------------- diff --git a/Strata/DL/Imperative/CmdType.lean b/Strata/DL/Imperative/CmdType.lean index 9ea4b7d37f..a4b651f120 100644 --- a/Strata/DL/Imperative/CmdType.lean +++ b/Strata/DL/Imperative/CmdType.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.DL.Imperative.Cmd public import Strata.DL.Imperative.TypeContext namespace Imperative diff --git a/Strata/DL/Imperative/EvalContext.lean b/Strata/DL/Imperative/EvalContext.lean index 941fa3b15f..f9fd22b9f7 100644 --- a/Strata/DL/Imperative/EvalContext.lean +++ b/Strata/DL/Imperative/EvalContext.lean @@ -7,9 +7,6 @@ module public import Strata.DL.Imperative.Cmd public import Strata.DL.Imperative.EvalError -public import Strata.DL.Imperative.MetaData -public import Strata.DL.Util.ListMap -public import Strata.DL.Util.Maps namespace Imperative open Std (ToFormat Format format) diff --git a/Strata/DL/Imperative/KleeneStmt.lean b/Strata/DL/Imperative/KleeneStmt.lean index faa049dd3f..a23d7312f7 100644 --- a/Strata/DL/Imperative/KleeneStmt.lean +++ b/Strata/DL/Imperative/KleeneStmt.lean @@ -5,9 +5,7 @@ -/ module -public import Strata.DL.Imperative.MetaData -public import Strata.DL.Imperative.Stmt -public import Strata.DL.Imperative.HasVars +public import Strata.DL.Imperative.Cmd --------------------------------------------------------------------- diff --git a/Strata/DL/Imperative/MetaData.lean b/Strata/DL/Imperative/MetaData.lean index 28c15c480b..21a1db7857 100644 --- a/Strata/DL/Imperative/MetaData.lean +++ b/Strata/DL/Imperative/MetaData.lean @@ -7,7 +7,6 @@ module public import Strata.DL.Imperative.PureExpr public import Strata.DL.Util.DecidableEq -public import Strata.Util.FileRange public import Strata.Util.Provenance namespace Imperative diff --git a/Strata/DL/Imperative/SMTUtils.lean b/Strata/DL/Imperative/SMTUtils.lean index 541ec17d98..407fad69cc 100644 --- a/Strata/DL/Imperative/SMTUtils.lean +++ b/Strata/DL/Imperative/SMTUtils.lean @@ -5,14 +5,14 @@ -/ module -public import Strata.DL.SMT.SMT -import Strata.DL.SMT.DDMTransform.Parse import Strata.DL.SMT.DDMTransform.Translate import Strata.DDM.Elab -import Strata.DDM.Format public import Strata.Pipeline.Context -public import Strata.DL.Imperative.PureExpr public import Strata.DL.Imperative.EvalContext +public import Strata.DL.SMT.Encoder +public import Strata.DL.SMT.IncrementalSolver +public import Strata.DL.Util.Map +public import Strata.Languages.Core.Options namespace Imperative open Std (ToFormat Format format) diff --git a/Strata/DL/Imperative/SemanticsProps.lean b/Strata/DL/Imperative/SemanticsProps.lean index 772aa9c4bb..feff847016 100644 --- a/Strata/DL/Imperative/SemanticsProps.lean +++ b/Strata/DL/Imperative/SemanticsProps.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.DL.Imperative.CmdSemantics import all Strata.DL.Imperative.CmdSemantics public import Strata.DL.Imperative.StmtSemantics import all Strata.DL.Imperative.StmtSemantics diff --git a/Strata/DL/Imperative/StmtEval.lean b/Strata/DL/Imperative/StmtEval.lean index f09895a74c..68b29d6786 100644 --- a/Strata/DL/Imperative/StmtEval.lean +++ b/Strata/DL/Imperative/StmtEval.lean @@ -5,7 +5,7 @@ -/ module -public import Strata.DL.Imperative.StmtSemantics +public import Strata.DL.Imperative.Stmt namespace Imperative diff --git a/Strata/DL/Imperative/ToCProverGOTO.lean b/Strata/DL/Imperative/ToCProverGOTO.lean index b3d33c2b24..09f0b5a0ce 100644 --- a/Strata/DL/Imperative/ToCProverGOTO.lean +++ b/Strata/DL/Imperative/ToCProverGOTO.lean @@ -5,10 +5,9 @@ -/ module -public import Strata.Backends.CBMC.GOTO.Program -public import Strata.DL.Imperative.Imperative import all Strata.DL.Imperative.Stmt -import Strata.Util.FileRange +public import Strata.Backends.CBMC.GOTO.Instruction +public import Strata.DL.Imperative.Stmt open Std (ToFormat Format format) diff --git a/Strata/DL/Lambda/AdtRankAxioms.lean b/Strata/DL/Lambda/AdtRankAxioms.lean index a444bb5ee5..6bd2b08e63 100644 --- a/Strata/DL/Lambda/AdtRankAxioms.lean +++ b/Strata/DL/Lambda/AdtRankAxioms.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.DL.Lambda.Factory public import Strata.DL.Lambda.IntBoolFactory public import Strata.DL.Lambda.TypeFactory diff --git a/Strata/DL/Lambda/Denote/LExprAnnotated.lean b/Strata/DL/Lambda/Denote/LExprAnnotated.lean index 305fc4c129..0c6795a4b9 100644 --- a/Strata/DL/Lambda/Denote/LExprAnnotated.lean +++ b/Strata/DL/Lambda/Denote/LExprAnnotated.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.DL.Lambda.LExpr public import Strata.DL.Lambda.LExprWF import all Strata.DL.Lambda.LExprWF diff --git a/Strata/DL/Lambda/Denote/LExprDenote.lean b/Strata/DL/Lambda/Denote/LExprDenote.lean index a86505a9ce..326bc6a24f 100644 --- a/Strata/DL/Lambda/Denote/LExprDenote.lean +++ b/Strata/DL/Lambda/Denote/LExprDenote.lean @@ -6,9 +6,11 @@ module import Strata.DL.Lambda.Denote.LExprAnnotated -public import Strata.DL.Util.HList import Strata.DL.Lambda.Factory -import Strata.DL.Lambda.TypeFactory +meta import Init.Grind.Cases +import Std.Tactic.BVDecide.Normalize.BitVec +import Std.Tactic.BVDecide.Normalize.Prop +import Strata.DL.Util.HList /-! ## Core Denotational Semantics diff --git a/Strata/DL/Lambda/Factory.lean b/Strata/DL/Lambda/Factory.lean index a3ecfcf4ea..54840acf07 100644 --- a/Strata/DL/Lambda/Factory.lean +++ b/Strata/DL/Lambda/Factory.lean @@ -8,14 +8,10 @@ module public import Strata.DL.Lambda.LExprWF import all Strata.DL.Lambda.LExprWF import all Strata.DL.Lambda.LExpr -public import Strata.DL.Lambda.LTy public import Strata.DL.Lambda.LTyUnify import all Strata.DL.Lambda.LTyUnify -public import Strata.DDM.AST -public import Strata.DDM.Util.Array public import Strata.DL.Util.Func -public import Strata.DL.Util.List -public import Strata.DL.Util.ListMap +import Std.Data.HashMap.Lemmas /-! ## Lambda's Factory diff --git a/Strata/DL/Lambda/FactoryWF.lean b/Strata/DL/Lambda/FactoryWF.lean index 67590792b3..35cc617ea7 100644 --- a/Strata/DL/Lambda/FactoryWF.lean +++ b/Strata/DL/Lambda/FactoryWF.lean @@ -7,13 +7,6 @@ module public import Strata.DL.Lambda.Factory import all Strata.DL.Lambda.Factory -public import Strata.DL.Lambda.LExprEval -public import Strata.DL.Lambda.LExprWF -public import Strata.DL.Lambda.LTy -public import Strata.DDM.Util.Array -public import Strata.DL.Util.Func -public import Strata.DL.Util.List -public import Strata.DL.Util.ListMap /-! ## Well-formedness of LFunc and Factory diff --git a/Strata/DL/Lambda/Identifiers.lean b/Strata/DL/Lambda/Identifiers.lean index 603ed0915f..1dab79c4fa 100644 --- a/Strata/DL/Lambda/Identifiers.lean +++ b/Strata/DL/Lambda/Identifiers.lean @@ -5,10 +5,8 @@ -/ module -public import Strata.DL.Lambda.LTy -public import Strata.DL.Util.Map public import Strata.Util.FileRange -public import Std.Data.HashMap.Lemmas +import Std.Data.HashMap.Lemmas --------------------------------------------------------------------- diff --git a/Strata/DL/Lambda/IntBoolFactory.lean b/Strata/DL/Lambda/IntBoolFactory.lean index b58a2028ee..e814c95dbf 100644 --- a/Strata/DL/Lambda/IntBoolFactory.lean +++ b/Strata/DL/Lambda/IntBoolFactory.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.DL.Lambda.LState public import Strata.DL.Lambda.FactoryWF import all Strata.DL.Lambda.LTy import all Strata.DL.Lambda.LExpr diff --git a/Strata/DL/Lambda/LExpr.lean b/Strata/DL/Lambda/LExpr.lean index 2eacf83523..5e348832f7 100644 --- a/Strata/DL/Lambda/LExpr.lean +++ b/Strata/DL/Lambda/LExpr.lean @@ -7,9 +7,8 @@ module public import Strata.DL.Lambda.LTy public import Strata.DL.Lambda.Identifiers -public import Strata.DL.Lambda.MetaData -public import Strata.DL.Util.DecidableEq -public meta import Lean.Elab.Term +public import Lean.Meta.Basic +import Strata.DL.Util.DecidableEq /-! ## Lambda Expressions with Quantifiers diff --git a/Strata/DL/Lambda/LExprEval.lean b/Strata/DL/Lambda/LExprEval.lean index 0705b7259d..ec51c65345 100644 --- a/Strata/DL/Lambda/LExprEval.lean +++ b/Strata/DL/Lambda/LExprEval.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.DL.Lambda.LExprWF public import Strata.DL.Lambda.LState /-! ## Partial evaluator for Lambda expressions diff --git a/Strata/DL/Lambda/LExprT.lean b/Strata/DL/Lambda/LExprT.lean index 49f42bcc7b..48e43ed3a5 100644 --- a/Strata/DL/Lambda/LExprT.lean +++ b/Strata/DL/Lambda/LExprT.lean @@ -7,7 +7,6 @@ module public import Strata.DL.Lambda.LExprTypeEnv import all Strata.DL.Lambda.LExprTypeEnv -public import Strata.DL.Lambda.LExprWF import all Strata.DL.Lambda.LExprWF /-! ## Type Inference Transform for Lambda Expressions. diff --git a/Strata/DL/Lambda/LExprType.lean b/Strata/DL/Lambda/LExprType.lean deleted file mode 100644 index d5609dbc2b..0000000000 --- a/Strata/DL/Lambda/LExprType.lean +++ /dev/null @@ -1,9 +0,0 @@ -/- - Copyright Strata Contributors - - SPDX-License-Identifier: Apache-2.0 OR MIT --/ -module - -public import Strata.DL.Lambda.LExprTypeSpec -public import Strata.DL.Lambda.LExprT diff --git a/Strata/DL/Lambda/LExprTypeEnv.lean b/Strata/DL/Lambda/LExprTypeEnv.lean index 98c0109e80..4c78ea9db9 100644 --- a/Strata/DL/Lambda/LExprTypeEnv.lean +++ b/Strata/DL/Lambda/LExprTypeEnv.lean @@ -5,13 +5,9 @@ -/ module -public import Strata.DL.Lambda.LExprWF -public import Strata.DL.Lambda.LTyUnify import all Strata.DL.Lambda.LTyUnify -public import Strata.DL.Lambda.Factory public import Strata.DL.Lambda.TypeFactory -public import Strata.DL.Util.Maps -public import Strata.DL.Util.String +import Strata.DL.Util.String /-! ## Type Environment diff --git a/Strata/DL/Lambda/LExprTypeSpec.lean b/Strata/DL/Lambda/LExprTypeSpec.lean index 5495868ec6..2420689d19 100644 --- a/Strata/DL/Lambda/LExprTypeSpec.lean +++ b/Strata/DL/Lambda/LExprTypeSpec.lean @@ -5,16 +5,13 @@ -/ module -public import Strata.DL.Lambda.LExprTypeEnv import all Strata.DL.Lambda.LExprTypeEnv -public import Strata.DL.Lambda.LExprWF import all Strata.DL.Lambda.LExprWF import all Strata.DL.Lambda.LExpr import all Strata.DL.Lambda.LTy import all Strata.DL.Lambda.LTyUnify import all Strata.DL.Util.Map import all Strata.DL.Util.Maps -import Strata.DL.Lambda.Factory import all Strata.DL.Lambda.Identifiers import all Strata.DL.Util.Func import all Strata.DL.Util.ListMap @@ -22,6 +19,7 @@ import all Strata.DL.Util.List public import Strata.DL.Lambda.LExprT import all Strata.DL.Lambda.LExprT public import Strata.DL.Lambda.FactoryWF +public meta import Init.Grind.Cases /-! ## Typing Relation for Lambda Expressions diff --git a/Strata/DL/Lambda/LExprWF.lean b/Strata/DL/Lambda/LExprWF.lean index 8a8232b7f7..a1b0118d4a 100644 --- a/Strata/DL/Lambda/LExprWF.lean +++ b/Strata/DL/Lambda/LExprWF.lean @@ -7,6 +7,7 @@ module public import Strata.DL.Lambda.LExpr import all Strata.DL.Lambda.LExpr +public import Strata.DL.Util.Map /-! ## Well-formedness of Lambda Expressions diff --git a/Strata/DL/Lambda/LState.lean b/Strata/DL/Lambda/LState.lean index 34a1a77235..334c8d9b9a 100644 --- a/Strata/DL/Lambda/LState.lean +++ b/Strata/DL/Lambda/LState.lean @@ -7,7 +7,7 @@ module public import Strata.DL.Lambda.Factory public import Strata.DL.Lambda.Scopes -public import Strata.Util.Name +import Strata.Util.Name /-! ## State for (Partial) Evaluation of Lambda Expressions diff --git a/Strata/DL/Lambda/LTy.lean b/Strata/DL/Lambda/LTy.lean index de906e6543..f44bd3eac2 100644 --- a/Strata/DL/Lambda/LTy.lean +++ b/Strata/DL/Lambda/LTy.lean @@ -5,9 +5,10 @@ -/ module -public import Strata.DL.Util.Map import Strata.Util.Tactics -public meta import Lean.Elab.Term +public meta import Lean.Elab.Term.TermElabM +import Std.Data.DTreeMap -- shake: keep +import Std.Tactic.BVDecide -- shake: keep /-! ## Formalization of Mono- and Poly- Types in Lambda diff --git a/Strata/DL/Lambda/LTyUnify.lean b/Strata/DL/Lambda/LTyUnify.lean index 1116b65372..d7bde942b8 100644 --- a/Strata/DL/Lambda/LTyUnify.lean +++ b/Strata/DL/Lambda/LTyUnify.lean @@ -12,6 +12,7 @@ import all Strata.DL.Util.List public import Strata.DL.Util.Maps import all Strata.DL.Util.Maps import all Strata.DL.Util.Map +import Std.Tactic.BVDecide.Normalize.BitVec /-! ## Type Substitution and Unification diff --git a/Strata/DL/Lambda/Lambda.lean b/Strata/DL/Lambda/Lambda.lean index eb8587d00a..cd73b7ff67 100644 --- a/Strata/DL/Lambda/Lambda.lean +++ b/Strata/DL/Lambda/Lambda.lean @@ -6,12 +6,7 @@ module public import Strata.DL.Lambda.LExprEval -public import Strata.DL.Lambda.LExprType -public import Strata.DL.Lambda.LExpr -public import Strata.DL.Lambda.Semantics -public import Strata.DL.Lambda.Denote.LExprSemanticsConsistent -public import Strata.DL.Lambda.TypeFactory -public import Strata.DL.Lambda.Reflect +public import Strata.DL.Lambda.LExprT namespace Lambda open Strata diff --git a/Strata/DL/Lambda/Preconditions.lean b/Strata/DL/Lambda/Preconditions.lean index 8f969d8ef4..1057d3cd27 100644 --- a/Strata/DL/Lambda/Preconditions.lean +++ b/Strata/DL/Lambda/Preconditions.lean @@ -6,8 +6,6 @@ module public import Strata.DL.Lambda.IntBoolFactory -public import Strata.DL.Lambda.Factory -public import Strata.DL.Lambda.LExprWF /-! # Function Precondition Obligation Collection diff --git a/Strata/DL/Lambda/RecursiveAxioms.lean b/Strata/DL/Lambda/RecursiveAxioms.lean index 60f3b4c220..5a02ce9286 100644 --- a/Strata/DL/Lambda/RecursiveAxioms.lean +++ b/Strata/DL/Lambda/RecursiveAxioms.lean @@ -5,9 +5,7 @@ -/ module -public import Strata.DL.Lambda.Factory public import Strata.DL.Lambda.TypeFactory -import Strata.DL.Util.List /-! ## Axiom Generation for Recursive Functions diff --git a/Strata/DL/Lambda/Reflect.lean b/Strata/DL/Lambda/Reflect.lean index 558b0a83c8..6b8684d196 100644 --- a/Strata/DL/Lambda/Reflect.lean +++ b/Strata/DL/Lambda/Reflect.lean @@ -5,13 +5,11 @@ -/ module -public meta import Strata.DL.Lambda.LExpr -public meta import Strata.DL.Lambda.LState -public meta import Strata.DL.Lambda.LTy -public meta import Strata.DL.Lambda.LExprTypeEnv -public meta import Lean.Elab.Term -public meta import Lean.Meta -public meta import Strata.DL.Lambda.Identifiers +public meta import Std.Do.Triple.SpecLemmas +public import Strata.DL.Lambda.LExpr +public meta import Strata.DL.Lambda.LExprWF +import Lean.Meta.AppBuilder +import Strata.DL.Util.Map /-! ## Reflect Lambda expressions into Lean's Logic diff --git a/Strata/DL/Lambda/Scopes.lean b/Strata/DL/Lambda/Scopes.lean index d30fdbf126..b208b84acd 100644 --- a/Strata/DL/Lambda/Scopes.lean +++ b/Strata/DL/Lambda/Scopes.lean @@ -5,8 +5,8 @@ -/ module -public import Strata.DL.Lambda.LExprWF public import Strata.DL.Util.Maps +public import Strata.DL.Lambda.LExpr namespace Lambda diff --git a/Strata/DL/Lambda/Semantics.lean b/Strata/DL/Lambda/Semantics.lean index 0c9e6256a7..b47e944e73 100644 --- a/Strata/DL/Lambda/Semantics.lean +++ b/Strata/DL/Lambda/Semantics.lean @@ -5,13 +5,10 @@ -/ module -public import Strata.DL.Lambda.LExpr import all Strata.DL.Lambda.LExpr public import Strata.DL.Lambda.LExprEval import all Strata.DL.Lambda.LExprEval -public import Strata.DL.Lambda.LExprWF import all Strata.DL.Lambda.LExprWF -public import Strata.DL.Lambda.LState import all Strata.DL.Lambda.LState import all Strata.DL.Lambda.Factory public import Strata.DL.Lambda.FactoryWF diff --git a/Strata/DL/Lambda/TypeFactory.lean b/Strata/DL/Lambda/TypeFactory.lean index 4b859ca12b..7443f3a4a4 100644 --- a/Strata/DL/Lambda/TypeFactory.lean +++ b/Strata/DL/Lambda/TypeFactory.lean @@ -5,12 +5,8 @@ -/ module -public import Strata.DL.Lambda.LExprWF -public import Strata.DL.Lambda.LTy import all Strata.DL.Lambda.LTy public import Strata.DL.Lambda.Factory -public import Strata.DL.Util.List -public import Strata.Util.Tactics import all Strata.Util.Tactics /-! diff --git a/Strata/DL/SMT/SMT.lean b/Strata/DL/SMT.lean similarity index 94% rename from Strata/DL/SMT/SMT.lean rename to Strata/DL/SMT.lean index 67fbaf1093..e5dabbc7ee 100644 --- a/Strata/DL/SMT/SMT.lean +++ b/Strata/DL/SMT.lean @@ -3,7 +3,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -module +module-- shake: keep-all public import Strata.DL.SMT.AbstractSolver public import Strata.DL.SMT.Encoder diff --git a/Strata/DL/SMT/DDMTransform/Parse.lean b/Strata/DL/SMT/DDMTransform/Parse.lean index 03be10777f..87295fdc78 100644 --- a/Strata/DL/SMT/DDMTransform/Parse.lean +++ b/Strata/DL/SMT/DDMTransform/Parse.lean @@ -5,9 +5,9 @@ -/ module -public import Strata.DDM.Integration.Lean -public meta import Strata.DDM.Integration.Lean import Strata.DDM.BuiltinDialects.BuiltinM +public import Strata.DDM.Integration.Lean.OfAstM +import Strata.DDM.Integration.Lean --shake: keep public section diff --git a/Strata/DL/SMT/DDMTransform/Translate.lean b/Strata/DL/SMT/DDMTransform/Translate.lean index 740314bc4c..c5197cde69 100644 --- a/Strata/DL/SMT/DDMTransform/Translate.lean +++ b/Strata/DL/SMT/DDMTransform/Translate.lean @@ -8,8 +8,9 @@ module public import Strata.DL.SMT.DDMTransform.Parse public import Strata.DL.SMT.Term public import Strata.Util.Provenance -public import Strata.Util.Tactics -import Strata.DDM.Elab.LoadedDialects +public import Strata.DDM.Elab.LoadedDialects +import Strata.DDM.BuiltinDialects.Init +import Strata.Util.Tactics namespace Strata diff --git a/Strata/DL/SMT/Denote.lean b/Strata/DL/SMT/Denote.lean index d1b84925d8..46e8f4982d 100644 --- a/Strata/DL/SMT/Denote.lean +++ b/Strata/DL/SMT/Denote.lean @@ -6,6 +6,7 @@ module public import Strata.Languages.Core.SMTEncoder +import Std.Tactic.BVDecide.Normalize.Prop public section diff --git a/Strata/DL/SMT/Encoder.lean b/Strata/DL/SMT/Encoder.lean index 67757d404a..128335c7ad 100644 --- a/Strata/DL/SMT/Encoder.lean +++ b/Strata/DL/SMT/Encoder.lean @@ -5,14 +5,12 @@ -/ module -public import Strata.DL.SMT.DDMTransform.Translate -public import Strata.DL.SMT.Factory -public import Strata.DL.SMT.Op -public import Strata.Util.Name public import Strata.DL.SMT.Solver -public import Strata.DL.SMT.Term -public import Strata.DL.SMT.TermType -import Std.Data.HashMap +import Std.Tactic.BVDecide.Normalize.Prop +import Strata.DL.SMT.DDMTransform.Parse +import Strata.DL.SMT.Factory +import Strata.Util.Name +import Strata.Util.Tactics /-! Based on Cedar's Term language. diff --git a/Strata/DL/SMT/Factory.lean b/Strata/DL/SMT/Factory.lean index e3ce868f20..c0156ce9ef 100644 --- a/Strata/DL/SMT/Factory.lean +++ b/Strata/DL/SMT/Factory.lean @@ -7,9 +7,7 @@ module public import Strata.DL.Util.BitVec public import Strata.DL.SMT.Function -public import Strata.DL.SMT.Op public import Strata.DL.SMT.Term -public import Strata.DL.SMT.TermType @[expose] public section diff --git a/Strata/DL/SMT/FactoryCorrect.lean b/Strata/DL/SMT/FactoryCorrect.lean index e131000128..5235d152b6 100644 --- a/Strata/DL/SMT/FactoryCorrect.lean +++ b/Strata/DL/SMT/FactoryCorrect.lean @@ -7,8 +7,8 @@ module public import Strata.DL.SMT.Denote import all Strata.DL.SMT.Denote -public import Strata.DL.SMT.Factory import all Strata.DL.SMT.Factory +import Std.Tactic.BVDecide.Normalize.BitVec /-! # Correctness of Factory optimizations diff --git a/Strata/DL/SMT/Function.lean b/Strata/DL/SMT/Function.lean index 75eee43193..31d2690702 100644 --- a/Strata/DL/SMT/Function.lean +++ b/Strata/DL/SMT/Function.lean @@ -5,7 +5,7 @@ -/ module -public import Strata.DL.SMT.Term +public import Strata.DL.SMT.Op public section /-! diff --git a/Strata/DL/SMT/IncrementalSolver.lean b/Strata/DL/SMT/IncrementalSolver.lean index 4a1e65dbc7..ab1ee818b3 100644 --- a/Strata/DL/SMT/IncrementalSolver.lean +++ b/Strata/DL/SMT/IncrementalSolver.lean @@ -6,9 +6,8 @@ module public import Strata.DL.SMT.AbstractSolver -public import Strata.DL.SMT.Factory -import Strata.DDM.Format -import Std.Data.HashMap +import Strata.DL.SMT.DDMTransform.Translate +import Strata.DL.SMT.Factory /-! # Incremental SMT-LIB Backend diff --git a/Strata/DL/SMT/Op.lean b/Strata/DL/SMT/Op.lean index 5983f16541..7ff540f91b 100644 --- a/Strata/DL/SMT/Op.lean +++ b/Strata/DL/SMT/Op.lean @@ -8,6 +8,7 @@ module public import Strata.DL.SMT.TermType public meta import Lean.Elab.Command public meta import Init.Data.String.Legacy +import Lean.Message public section /-! diff --git a/Strata/DL/SMT/Solver.lean b/Strata/DL/SMT/Solver.lean index d49e2b8529..22fa63968c 100644 --- a/Strata/DL/SMT/Solver.lean +++ b/Strata/DL/SMT/Solver.lean @@ -5,13 +5,10 @@ -/ module -public import Strata.DL.SMT.DDMTransform.Translate public import Strata.DL.SMT.Term -public import Strata.DL.SMT.TermType -public import Strata.Languages.Core.Options -import Strata.DDM.Format -public import Strata.DDM.Util.String -import Std.Data.HashMap +import Strata.DDM.Util.String +import Strata.DL.SMT.DDMTransform.Translate +import Strata.Languages.Core.Options /-! Based on Cedar's Term language. diff --git a/Strata/DL/SMT/Term.lean b/Strata/DL/SMT/Term.lean index dc91b48062..99c4ee0aea 100644 --- a/Strata/DL/SMT/Term.lean +++ b/Strata/DL/SMT/Term.lean @@ -5,11 +5,10 @@ -/ module -public import Strata.DL.SMT.TermType import all Strata.DL.Util.BitVec public import Strata.DL.SMT.Op public import Strata.DDM.Util.Decimal -public import Strata.DDM.Util.DecimalRat +import Strata.DDM.Util.DecimalRat public section /-! diff --git a/Strata/DL/SMT/Translate.lean b/Strata/DL/SMT/Translate.lean index 1b761271b0..81cc7a9328 100644 --- a/Strata/DL/SMT/Translate.lean +++ b/Strata/DL/SMT/Translate.lean @@ -5,7 +5,6 @@ -/ module -import Lean.Meta.Basic public import Strata.Languages.Core.SMTEncoder diff --git a/Strata/DL/Util/LabelGen.lean b/Strata/DL/Util/LabelGen.lean index 25f3fa1bf6..e9765f4bb6 100644 --- a/Strata/DL/Util/LabelGen.lean +++ b/Strata/DL/Util/LabelGen.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.DL.Util.Counter import all Strata.DL.Util.Counter public import Strata.DL.Util.StringGen import all Strata.DL.Util.StringGen diff --git a/Strata/DL/Util/Nodup.lean b/Strata/DL/Util/Nodup.lean index 3f4754553f..2f8a680c60 100644 --- a/Strata/DL/Util/Nodup.lean +++ b/Strata/DL/Util/Nodup.lean @@ -4,6 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ module +import Strata.DL.Util.List public section diff --git a/Strata/Languages/B3/DDMTransform/Conversion.lean b/Strata/Languages/B3/DDMTransform/Conversion.lean index 5ed910b254..d0ef656d27 100644 --- a/Strata/Languages/B3/DDMTransform/Conversion.lean +++ b/Strata/Languages/B3/DDMTransform/Conversion.lean @@ -8,6 +8,7 @@ module public import Strata.Languages.B3.DDMTransform.ParseCST public import Strata.Languages.B3.DDMTransform.DefinitionAST import Strata.Util.Tactics +import Std.Tactic.BVDecide.Normalize.Prop public section diff --git a/Strata/Languages/B3/DDMTransform/DefinitionAST.lean b/Strata/Languages/B3/DDMTransform/DefinitionAST.lean index 5780bbe1f3..78b96dd00e 100644 --- a/Strata/Languages/B3/DDMTransform/DefinitionAST.lean +++ b/Strata/Languages/B3/DDMTransform/DefinitionAST.lean @@ -5,9 +5,9 @@ -/ module -public import Strata.DDM.Integration.Lean -public import Strata.DDM.Util.Format import Strata.Util.Tactics +public import Strata.DDM.Integration.Lean.OfAstM +import Strata.DDM.Integration.Lean -- shake: keep public section diff --git a/Strata/Languages/B3/DDMTransform/ParseCST.lean b/Strata/Languages/B3/DDMTransform/ParseCST.lean index 9da940d036..1286e92005 100644 --- a/Strata/Languages/B3/DDMTransform/ParseCST.lean +++ b/Strata/Languages/B3/DDMTransform/ParseCST.lean @@ -5,8 +5,9 @@ -/ module -public import Strata.DDM.Integration.Lean -public import Strata.DDM.Util.Format +public import Strata.DDM.Integration.Lean.OfAstM +import Strata.DDM.Integration.Lean.Gen +import Strata.DDM.Integration.Lean.HashCommands -- shake: keep public section diff --git a/Strata/Languages/B3/Verifier.lean b/Strata/Languages/B3/Verifier.lean index 86dcd716b5..bb27f5aab1 100644 --- a/Strata/Languages/B3/Verifier.lean +++ b/Strata/Languages/B3/Verifier.lean @@ -5,14 +5,14 @@ -/ module +import Strata.DDM.Integration.Lean.HashCommands -- shake: keep public import Strata.Languages.B3.Verifier.Expression public import Strata.Languages.B3.Verifier.Formatter public import Strata.Languages.B3.Verifier.State public import Strata.Languages.B3.Verifier.Program public import Strata.Languages.B3.Verifier.Diagnosis -meta import Strata.Languages.B3.DDMTransform.ParseCST -meta import Strata.Languages.B3.Verifier.Statements -meta import Strata.Languages.B3.Verifier.Program +public meta import Strata.Languages.B3.Verifier.Program +public meta import Strata.Languages.B3.Verifier.Statements open Strata open Strata.B3.Verifier diff --git a/Strata/Languages/B3/Verifier/Diagnosis.lean b/Strata/Languages/B3/Verifier/Diagnosis.lean index 2566e58b64..d99b0c5f13 100644 --- a/Strata/Languages/B3/Verifier/Diagnosis.lean +++ b/Strata/Languages/B3/Verifier/Diagnosis.lean @@ -5,8 +5,6 @@ -/ module -public import Strata.Languages.B3.Verifier.State -public import Strata.Languages.B3.Verifier.Expression public import Strata.Languages.B3.Verifier.Statements public section diff --git a/Strata/Languages/B3/Verifier/Expression.lean b/Strata/Languages/B3/Verifier/Expression.lean index 91ce0bb462..d4ebe6ced5 100644 --- a/Strata/Languages/B3/Verifier/Expression.lean +++ b/Strata/Languages/B3/Verifier/Expression.lean @@ -5,12 +5,11 @@ -/ module -public import Strata.Languages.B3.DDMTransform.DefinitionAST -public import Strata.DL.SMT.SMT -public import Strata.DL.SMT.Factory public import Strata.Languages.B3.DDMTransform.Conversion import Strata.DDM.Format import Strata.Util.Tactics +public import Strata.DL.SMT.Term +import Strata.DL.SMT.Factory public section diff --git a/Strata/Languages/B3/Verifier/Formatter.lean b/Strata/Languages/B3/Verifier/Formatter.lean index 85f086501c..6855a2c9ab 100644 --- a/Strata/Languages/B3/Verifier/Formatter.lean +++ b/Strata/Languages/B3/Verifier/Formatter.lean @@ -5,7 +5,8 @@ -/ module -public import Strata.DL.SMT.DDMTransform.Translate +public import Strata.DL.SMT.Term +import Strata.DL.SMT.DDMTransform.Translate public section diff --git a/Strata/Languages/B3/Verifier/Program.lean b/Strata/Languages/B3/Verifier/Program.lean index 60707177c2..8b1b61343c 100644 --- a/Strata/Languages/B3/Verifier/Program.lean +++ b/Strata/Languages/B3/Verifier/Program.lean @@ -5,13 +5,9 @@ -/ module -public import Strata.Languages.B3.Verifier.Diagnosis -import Strata.Languages.B3.Verifier.State -import Strata.Languages.B3.Verifier.Expression -import Strata.Languages.B3.Verifier.Formatter -import Strata.Languages.B3.Verifier.Statements import Strata.Languages.B3.Transform.FunctionToAxiom -import Strata.Languages.B3.DDMTransform.Conversion +public import Strata.Languages.B3.Verifier.State +import Strata.Languages.B3.Verifier.Diagnosis public section diff --git a/Strata/Languages/B3/Verifier/State.lean b/Strata/Languages/B3/Verifier/State.lean index 20318758bb..f7d1049b05 100644 --- a/Strata/Languages/B3/Verifier/State.lean +++ b/Strata/Languages/B3/Verifier/State.lean @@ -6,7 +6,6 @@ module public import Strata.Languages.B3.Verifier.Expression -public import Strata.Languages.B3.DDMTransform.DefinitionAST public import Strata.DL.SMT.Solver import Strata.DL.SMT.Factory diff --git a/Strata/Languages/B3/Verifier/Statements.lean b/Strata/Languages/B3/Verifier/Statements.lean index e93833711f..00fe9d1022 100644 --- a/Strata/Languages/B3/Verifier/Statements.lean +++ b/Strata/Languages/B3/Verifier/Statements.lean @@ -5,13 +5,8 @@ -/ module -public import Strata.Languages.B3.Verifier.Expression public import Strata.Languages.B3.Verifier.State -public import Strata.Languages.B3.DDMTransform.ParseCST -public import Strata.Languages.B3.DDMTransform.Conversion import Strata.DDM.Format -import Strata.DDM.Integration.Lean -import Strata.DDM.Util.Format import Strata.Util.Tactics /-! diff --git a/Strata/Languages/Boole/Boole.lean b/Strata/Languages/Boole/Boole.lean index 5ca91abf63..e733208d2e 100644 --- a/Strata/Languages/Boole/Boole.lean +++ b/Strata/Languages/Boole/Boole.lean @@ -5,8 +5,8 @@ -/ module -public import Strata.Languages.Boole.Grammar -meta import Strata.DDM.Integration.Lean +public import Strata.Languages.Boole.Grammar -- shake: keep +import Strata.DDM.Integration.Lean.Gen -- shake: keep public section diff --git a/Strata/Languages/Boole/Grammar.lean b/Strata/Languages/Boole/Grammar.lean index 4b20ea8b5b..95608a7e1e 100644 --- a/Strata/Languages/Boole/Grammar.lean +++ b/Strata/Languages/Boole/Grammar.lean @@ -5,11 +5,13 @@ -/ module -public import Strata.Languages.Core.DDMTransform.Grammar -meta import Strata.DDM.Integration.Lean +public import Strata.Languages.Core.DDMTransform.Grammar -- shake: keep +import Strata.DDM.Integration.Lean.HashCommands -- shake: keep +import Strata.DDM.BuiltinDialects.Init --------------------------------------------------------------------- +public section namespace Strata --------------------------------------------------------------------- @@ -98,3 +100,4 @@ op prog (commands : SpacePrefixSepBy Command) : Program => --------------------------------------------------------------------- end Strata +end diff --git a/Strata/Languages/Boole/Verify.lean b/Strata/Languages/Boole/Verify.lean index 5c237ab6e5..911f096294 100644 --- a/Strata/Languages/Boole/Verify.lean +++ b/Strata/Languages/Boole/Verify.lean @@ -6,12 +6,9 @@ module public import Strata.Languages.Boole.Boole -public import Strata.Languages.Core.Program -public import Strata.Languages.Core.Statement public import Strata.Languages.Core.Verifier -public import Strata.DL.Lambda.LExpr -import Strata.DL.Lambda.LExprWF -public import Strata.DL.Imperative.Stmt +import Strata.Languages.Core.Core +import Strata.Util.Tactics public section diff --git a/Strata/Languages/C_Simp/C_Simp.lean b/Strata/Languages/C_Simp/C_Simp.lean index 53b7b8e645..447726873e 100644 --- a/Strata/Languages/C_Simp/C_Simp.lean +++ b/Strata/Languages/C_Simp/C_Simp.lean @@ -5,12 +5,10 @@ -/ module -public import Strata.Languages.C_Simp.DDMTransform.Parse public import Strata.DL.Imperative.Stmt -public import Strata.DL.Lambda.Lambda -public import Strata.DL.Lambda.LExpr -public import Strata.DL.Lambda.LTy -public import Strata.DL.Lambda.Identifiers +public import Strata.DL.Lambda.LExprTypeEnv +public import Strata.DL.Lambda.LState +public import Strata.Languages.C_Simp.DDMTransform.Parse -- strata: keep public section diff --git a/Strata/Languages/C_Simp/DDMTransform/Parse.lean b/Strata/Languages/C_Simp/DDMTransform/Parse.lean index 5b1a09f0e8..5cf9696928 100644 --- a/Strata/Languages/C_Simp/DDMTransform/Parse.lean +++ b/Strata/Languages/C_Simp/DDMTransform/Parse.lean @@ -5,8 +5,9 @@ -/ module -public import Strata.DDM.Integration.Lean -import Strata.DDM.Util.Format +public import Strata.DDM.AST +import Strata.DDM.BuiltinDialects.Init +import Strata.DDM.Integration.Lean.HashCommands -- shake: keep public section diff --git a/Strata/Languages/C_Simp/DDMTransform/Translate.lean b/Strata/Languages/C_Simp/DDMTransform/Translate.lean index 5b1493e6e6..339a213802 100644 --- a/Strata/Languages/C_Simp/DDMTransform/Translate.lean +++ b/Strata/Languages/C_Simp/DDMTransform/Translate.lean @@ -5,10 +5,9 @@ -/ module -public import Strata.Languages.C_Simp.DDMTransform.Parse public import Strata.Languages.C_Simp.C_Simp -import Strata.DDM.AST public import Strata.Languages.Core.CoreOp +public import Strata.DDM.AST public section diff --git a/Strata/Languages/C_Simp/Verify.lean b/Strata/Languages/C_Simp/Verify.lean index b04c557882..4bcb6cdb45 100644 --- a/Strata/Languages/C_Simp/Verify.lean +++ b/Strata/Languages/C_Simp/Verify.lean @@ -6,12 +6,9 @@ module public import Strata.Languages.C_Simp.C_Simp -public import Strata.Languages.C_Simp.DDMTransform.Translate -public import Strata.Languages.Core.Options public import Strata.Languages.Core.Verifier -import Lean.Parser.Types -import Strata.Languages.Core.CoreOp -import Strata.DL.Imperative.Stmt +import Strata.Languages.C_Simp.DDMTransform.Translate +import Strata.Languages.Core.Core public section diff --git a/Strata/Languages/Core/Axiom.lean b/Strata/Languages/Core/Axiom.lean index 38795accbf..4248d7a1de 100644 --- a/Strata/Languages/Core/Axiom.lean +++ b/Strata/Languages/Core/Axiom.lean @@ -7,9 +7,7 @@ module -public import Strata.Languages.Core.Statement -public import Strata.DL.Lambda.LTy -public import Strata.DL.Lambda.LExpr +public import Strata.Languages.Core.Identifiers namespace Core public section diff --git a/Strata/Languages/Core/CallGraph.lean b/Strata/Languages/Core/CallGraph.lean index 0ddbc39c53..c4589bf765 100644 --- a/Strata/Languages/Core/CallGraph.lean +++ b/Strata/Languages/Core/CallGraph.lean @@ -6,6 +6,8 @@ module public import Strata.Languages.Core.Program +import Std.Data.HashMap.AdditionalOperations +import Strata.Languages.Core.Factory --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/CmdEval.lean b/Strata/Languages/Core/CmdEval.lean index b57c96817f..d8b42b9a8d 100644 --- a/Strata/Languages/Core/CmdEval.lean +++ b/Strata/Languages/Core/CmdEval.lean @@ -5,10 +5,7 @@ -/ module -public import Strata.Languages.Core.Expressions public import Strata.Languages.Core.Env -public import Strata.DL.Imperative.EvalContext -public import Strata.DL.Imperative.CmdEval public section diff --git a/Strata/Languages/Core/CmdType.lean b/Strata/Languages/Core/CmdType.lean index db6063cc75..38e0dc7d88 100644 --- a/Strata/Languages/Core/CmdType.lean +++ b/Strata/Languages/Core/CmdType.lean @@ -7,7 +7,7 @@ module public import Strata.Languages.Core.Expressions public import Strata.DL.Imperative.TypeContext -public import Strata.DL.Lambda.Factory +import Strata.DL.Lambda.LExprT namespace Core open Lambda Imperative diff --git a/Strata/Languages/Core/Core.lean b/Strata/Languages/Core/Core.lean index e600ad3601..d9154629cf 100644 --- a/Strata/Languages/Core/Core.lean +++ b/Strata/Languages/Core/Core.lean @@ -5,11 +5,13 @@ -/ module +public import Strata.Languages.Core.DDMTransform.ASTtoCST -- shake: keep +public import Strata.Languages.Core.Env public import Strata.Languages.Core.Options +public import Strata.Util.Statistics public import Strata.Languages.Core.ProgramEval -public import Strata.Languages.Core.ProgramType -public import Strata.Languages.Core.DDMTransform.ASTtoCST -public import Strata.Languages.Core.Statistics +import Strata.Languages.Core.ProgramType +import Strata.Languages.Core.Statistics --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/CoreGen.lean b/Strata/Languages/Core/CoreGen.lean index 5c0ce72381..18c32931df 100644 --- a/Strata/Languages/Core/CoreGen.lean +++ b/Strata/Languages/Core/CoreGen.lean @@ -5,13 +5,12 @@ -/ module -public import Strata.Languages.Core.Statement public import Strata.DL.Util.LabelGen -public import Strata.DL.Util.StringGen import all Strata.DL.Util.StringGen import all Strata.DL.Util.Counter -public import Strata.DL.Util.ListUtils -open Core Lambda Imperative +public import Strata.Languages.Core.Identifiers +import Std.Tactic.BVDecide.Normalize.Prop +open Core Lambda /-! ## Strata Core Identifier Generator This file contains a Strata Core Identifier generator `CoreGenState.gen`, where the diff --git a/Strata/Languages/Core/DDMTransform/ASTtoCST.lean b/Strata/Languages/Core/DDMTransform/ASTtoCST.lean index 805805f413..e6112fc6bd 100644 --- a/Strata/Languages/Core/DDMTransform/ASTtoCST.lean +++ b/Strata/Languages/Core/DDMTransform/ASTtoCST.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.Languages.Core.DDMTransform.FormatCore public import Strata.Languages.Core.Program public section diff --git a/Strata/Languages/Core/DDMTransform/FormatCore.lean b/Strata/Languages/Core/DDMTransform/FormatCore.lean index 0bc517fd8a..f611d38321 100644 --- a/Strata/Languages/Core/DDMTransform/FormatCore.lean +++ b/Strata/Languages/Core/DDMTransform/FormatCore.lean @@ -9,7 +9,7 @@ public import Strata.Languages.Core.DDMTransform.Grammar public import Strata.Languages.Core.Procedure public import Strata.DDM.Util.DecimalRat public import Strata.DDM.Format -public import Strata.Languages.Core.CoreOp +import Strata.Languages.Core.Factory public section diff --git a/Strata/Languages/Core/DDMTransform/Grammar.lean b/Strata/Languages/Core/DDMTransform/Grammar.lean index ae29f0cfc9..6c422114f1 100644 --- a/Strata/Languages/Core/DDMTransform/Grammar.lean +++ b/Strata/Languages/Core/DDMTransform/Grammar.lean @@ -11,10 +11,9 @@ -/ module -public import Strata.DDM.AST public import Strata.DDM.HNF -import Strata.DDM.Integration.Lean public import Strata.DDM.Integration.Lean.OfAstM +import Strata.DDM.Integration.Lean -- shake: keep --------------------------------------------------------------------- public section diff --git a/Strata/Languages/Core/DDMTransform/Translate.lean b/Strata/Languages/Core/DDMTransform/Translate.lean index 570e02f5ad..c92d5baf70 100644 --- a/Strata/Languages/Core/DDMTransform/Translate.lean +++ b/Strata/Languages/Core/DDMTransform/Translate.lean @@ -5,12 +5,7 @@ -/ module -public import Strata.DDM.AST -public import Strata.Languages.Core.DDMTransform.Grammar -public import Strata.Languages.Core.Core -public import Strata.Languages.Core.CoreGen -public import Strata.Languages.Core.CoreOp -public import Strata.DDM.Util.DecimalRat +public import Strata.Languages.Core.Env --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/EntryPoint.lean b/Strata/Languages/Core/EntryPoint.lean index 56667c5ace..1567bb2b07 100644 --- a/Strata/Languages/Core/EntryPoint.lean +++ b/Strata/Languages/Core/EntryPoint.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.Languages.Core.CallGraph public import Strata.Languages.Core.PipelinePhase import Strata.Transform.ProcedureInlining diff --git a/Strata/Languages/Core/Env.lean b/Strata/Languages/Core/Env.lean index 1089a1ce99..f7f4d1391c 100644 --- a/Strata/Languages/Core/Env.lean +++ b/Strata/Languages/Core/Env.lean @@ -7,7 +7,8 @@ module public import Strata.Languages.Core.Program public import Strata.DL.Imperative.EvalContext -public import Strata.Util.Name +public import Strata.DL.Lambda.LExprEval +public import Strata.Languages.Core.Factory public section diff --git a/Strata/Languages/Core/Expressions.lean b/Strata/Languages/Core/Expressions.lean index 0a25a77bbf..2366150f4f 100644 --- a/Strata/Languages/Core/Expressions.lean +++ b/Strata/Languages/Core/Expressions.lean @@ -5,11 +5,11 @@ -/ module -public import Strata.DL.Lambda.Lambda -public import Strata.DL.Imperative.PureExpr public import Strata.Languages.Core.Identifiers public import Strata.Languages.Core.CoreOp public import Strata.DL.Imperative.HasVars +public import Strata.DL.Lambda.LExprTypeEnv +public import Strata.DL.Lambda.LState namespace Core open Std (ToFormat Format format) diff --git a/Strata/Languages/Core/Factory.lean b/Strata/Languages/Core/Factory.lean index 67002bf27f..6898d7d246 100644 --- a/Strata/Languages/Core/Factory.lean +++ b/Strata/Languages/Core/Factory.lean @@ -7,11 +7,7 @@ module public meta import Lean.Elab.Command -public import Strata.Languages.Core.Identifiers -public meta import Strata.Languages.Core.Identifiers public import Strata.Languages.Core.Expressions -public import Strata.DL.Lambda.Factory -public import Strata.DL.Lambda.FactoryWF public import Strata.DL.Lambda.IntBoolFactory import all Strata.DL.Lambda.IntBoolFactory import all Strata.DL.Lambda.LTy @@ -19,6 +15,7 @@ import all Strata.DL.Lambda.LExpr import all Strata.DL.Lambda.Factory import all Strata.DL.Lambda.FactoryWF import Strata.DL.Util.BitVec +public meta import Strata.DL.Lambda.IntBoolFactory --------------------------------------------------------------------- namespace Core diff --git a/Strata/Languages/Core/FactoryWF.lean b/Strata/Languages/Core/FactoryWF.lean index 770b21096e..f7bf15a818 100644 --- a/Strata/Languages/Core/FactoryWF.lean +++ b/Strata/Languages/Core/FactoryWF.lean @@ -6,9 +6,6 @@ module public import Strata.Languages.Core.Factory -public import Strata.DL.Lambda.Factory -import Strata.DL.Util.Func -public import Strata.DL.Lambda.IntBoolFactory import all Strata.DL.Lambda.IntBoolFactory import all Strata.DL.Lambda.LTy import all Strata.DL.Lambda.Factory diff --git a/Strata/Languages/Core/Function.lean b/Strata/Languages/Core/Function.lean index 858e2d0f04..0e6104a735 100644 --- a/Strata/Languages/Core/Function.lean +++ b/Strata/Languages/Core/Function.lean @@ -6,7 +6,7 @@ module -public import Strata.Languages.Core.Statement +public import Strata.Languages.Core.Expressions --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/FunctionType.lean b/Strata/Languages/Core/FunctionType.lean index 7a1016840d..3913f5a4cb 100644 --- a/Strata/Languages/Core/FunctionType.lean +++ b/Strata/Languages/Core/FunctionType.lean @@ -6,7 +6,8 @@ module public import Strata.Languages.Core.Function -public import Strata.Languages.Core.Program +import Strata.DL.Lambda.LExprT +import Strata.Languages.Core.Procedure --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/Identifiers.lean b/Strata/Languages/Core/Identifiers.lean index 196ac5ddb7..e110572122 100644 --- a/Strata/Languages/Core/Identifiers.lean +++ b/Strata/Languages/Core/Identifiers.lean @@ -5,9 +5,9 @@ -/ module -public import Strata.DL.Lambda.LExprTypeEnv -public import Strata.DL.Lambda.Factory public meta import Strata.DL.Lambda.LExpr +public meta import Std.Do.Triple.SpecLemmas +public import Strata.DL.Lambda.LExpr namespace Core public section diff --git a/Strata/Languages/Core/ObligationExtraction.lean b/Strata/Languages/Core/ObligationExtraction.lean index 5cd3cd05f4..09b43e1943 100644 --- a/Strata/Languages/Core/ObligationExtraction.lean +++ b/Strata/Languages/Core/ObligationExtraction.lean @@ -5,7 +5,8 @@ -/ module -public import Strata.Languages.Core.Env +public import Strata.DL.Imperative.EvalContext +public import Strata.Languages.Core.Program /-! # Proof Obligation Extraction A Core-to-obligations pass that walks a post-PE program and extracts diff --git a/Strata/Languages/Core/PipelinePhase.lean b/Strata/Languages/Core/PipelinePhase.lean index d8528569d8..24b0b54783 100644 --- a/Strata/Languages/Core/PipelinePhase.lean +++ b/Strata/Languages/Core/PipelinePhase.lean @@ -7,7 +7,6 @@ module public import Strata.Transform.CoreTransform public import Strata.DL.Imperative.SMTUtils -public import Strata.DL.Imperative.EvalContext /-! # Pipeline Phase Definitions for Model Validation diff --git a/Strata/Languages/Core/Procedure.lean b/Strata/Languages/Core/Procedure.lean index 90b00cce92..9734c4655e 100644 --- a/Strata/Languages/Core/Procedure.lean +++ b/Strata/Languages/Core/Procedure.lean @@ -6,7 +6,6 @@ module -public import Strata.DL.Imperative.HasVars public import Strata.Languages.Core.Statement --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/ProcedureEval.lean b/Strata/Languages/Core/ProcedureEval.lean index 9ea328f41b..ba6a9a9218 100644 --- a/Strata/Languages/Core/ProcedureEval.lean +++ b/Strata/Languages/Core/ProcedureEval.lean @@ -5,10 +5,9 @@ -/ module -public import Strata.Languages.Core.Procedure -public import Strata.Languages.Core.Statement -public import Strata.Languages.Core.StatementEval -public import Strata.Languages.Core.StatementSemantics +public import Strata.Languages.Core.Env +public import Strata.Util.Statistics +import Strata.Languages.Core.StatementEval public section --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/ProcedureType.lean b/Strata/Languages/Core/ProcedureType.lean index 9b5b9bdbed..c3a4e4f1b3 100644 --- a/Strata/Languages/Core/ProcedureType.lean +++ b/Strata/Languages/Core/ProcedureType.lean @@ -5,9 +5,9 @@ -/ module -public import Strata.Languages.Core.Procedure -public import Strata.DL.Imperative.HasVars -public import Strata.Languages.Core.StatementType +public import Strata.Languages.Core.Program +import Strata.DL.Lambda.LExprT +import Strata.Languages.Core.StatementType --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/ProcedureWF.lean b/Strata/Languages/Core/ProcedureWF.lean index 99aaa67c87..29bc257916 100644 --- a/Strata/Languages/Core/ProcedureWF.lean +++ b/Strata/Languages/Core/ProcedureWF.lean @@ -5,11 +5,7 @@ -/ module -public import Strata.DL.Util.ListUtils -public import Strata.Languages.Core.Program -public import Strata.Languages.Core.ProcedureType -public import Strata.Languages.Core.WF -public import Strata.Languages.Core.StatementWF +public import Strata.Languages.Core.Procedure public section diff --git a/Strata/Languages/Core/Program.lean b/Strata/Languages/Core/Program.lean index 2f012eafef..db44d9ffe4 100644 --- a/Strata/Languages/Core/Program.lean +++ b/Strata/Languages/Core/Program.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.Languages.Core.Procedure public import Strata.Languages.Core.Function public import Strata.Languages.Core.TypeDecl public import Strata.Languages.Core.Axiom diff --git a/Strata/Languages/Core/ProgramEval.lean b/Strata/Languages/Core/ProgramEval.lean index c16a5dfd3a..764910d1a8 100644 --- a/Strata/Languages/Core/ProgramEval.lean +++ b/Strata/Languages/Core/ProgramEval.lean @@ -6,14 +6,8 @@ module public import Strata.Languages.Core.Env -public import Strata.Languages.Core.Program -public import Strata.Languages.Core.ProcedureEval -public import Strata.Languages.Core.Statement -public import Strata.Languages.Core.StatementEval -public import Strata.Languages.Core.StatementSemantics -public import Strata.DL.Lambda.LExprEval -public import Strata.DL.Imperative.StmtEval -public import Strata.DL.Imperative.CmdEval +public import Strata.Util.Statistics +import Strata.Languages.Core.ProcedureEval --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/ProgramType.lean b/Strata/Languages/Core/ProgramType.lean index 14b88ac03e..bd7faac0ba 100644 --- a/Strata/Languages/Core/ProgramType.lean +++ b/Strata/Languages/Core/ProgramType.lean @@ -5,10 +5,10 @@ -/ module -public import Strata.DL.Lambda.LExprType -public import Strata.Languages.Core.Program public import Strata.Languages.Core.FunctionType public import Strata.Languages.Core.ProcedureType +public import Strata.DL.Lambda.LExprT +public import Strata.Languages.Core.Factory public section diff --git a/Strata/Languages/Core/ProgramWF.lean b/Strata/Languages/Core/ProgramWF.lean index fbba9a2fca..0229c1b3b8 100644 --- a/Strata/Languages/Core/ProgramWF.lean +++ b/Strata/Languages/Core/ProgramWF.lean @@ -5,14 +5,13 @@ -/ module -public import Strata.DL.Util.ListUtils public import Strata.Languages.Core.ProgramType public import Strata.Languages.Core.WF -public import Strata.Languages.Core.StatementWF -public import Strata.Languages.Core.ProcedureWF import all Strata.Languages.Core.Program import all Strata.Languages.Core.ProgramType import all Strata.Languages.Core.StatementType +import Std.Do.Triple.SpecLemmas +import Std.Tactic.BVDecide.Normalize.Prop /-! ## Well-Formedness for Programs This file is the entry point of typechecker correctness proofs. Specifically, diff --git a/Strata/Languages/Core/SMTEncoder.lean b/Strata/Languages/Core/SMTEncoder.lean index 57593a85fd..deec2b60d5 100644 --- a/Strata/Languages/Core/SMTEncoder.lean +++ b/Strata/Languages/Core/SMTEncoder.lean @@ -5,13 +5,14 @@ -/ module -public import Strata.Languages.Core.Core -public import Strata.DL.SMT.SMT public import Strata.DL.Imperative.SMTUtils public import Strata.DL.Lambda.RecursiveAxioms -import Init.Data.String.Extra -public import Strata.DDM.Util.DecimalRat -public import Strata.Languages.Core.CoreOp +public import Strata.DL.SMT.Factory +public import Strata.Languages.Core.Env +public import Strata.Util.Name +public import Strata.Util.Statistics +public import Strata.DL.SMT.DDMTransform.Translate -- shake: keep +import Strata.Languages.Core.Statistics --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/Statement.lean b/Strata/Languages/Core/Statement.lean index d221db67d6..be30b7d37d 100644 --- a/Strata/Languages/Core/Statement.lean +++ b/Strata/Languages/Core/Statement.lean @@ -6,14 +6,8 @@ module public import Strata.Languages.Core.Expressions -public import Strata.DL.Imperative.PureExpr -public import Strata.Languages.Core.Identifiers -public import Strata.Languages.Core.Factory public import Strata.DL.Imperative.Stmt -public import Strata.DL.Imperative.HasVars -public import Strata.DL.Lambda.LExpr -public import Strata.DL.Lambda.TypeConstructor -import Strata.Util.Tactics +import Std.Tactic.BVDecide.Normalize.Prop namespace Core open Imperative diff --git a/Strata/Languages/Core/StatementEval.lean b/Strata/Languages/Core/StatementEval.lean index 57f800544d..bdf236dd97 100644 --- a/Strata/Languages/Core/StatementEval.lean +++ b/Strata/Languages/Core/StatementEval.lean @@ -5,18 +5,15 @@ -/ module -public import Strata.Languages.Core.Statement import all Strata.Languages.Core.Statement -public import Strata.Languages.Core.Program -public import Strata.Languages.Core.Env public import Strata.Languages.Core.CmdEval public import Strata.Languages.Core.Statistics -public import Strata.DL.Lambda.LTyUnify -public import Strata.DL.Lambda.LExprT public import Strata.DL.Imperative.StmtEval public import Strata.Languages.Core.StatementSemantics import all Strata.DL.Imperative.Stmt import all Strata.DL.Imperative.CmdEval +public import Strata.DL.Imperative.CmdEval +public import Strata.Util.Statistics --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/StatementSemantics.lean b/Strata/Languages/Core/StatementSemantics.lean index 233cffd42d..3dae95242c 100644 --- a/Strata/Languages/Core/StatementSemantics.lean +++ b/Strata/Languages/Core/StatementSemantics.lean @@ -5,11 +5,10 @@ -/ module -public import Strata.DL.Lambda.LExpr -public import Strata.DL.Lambda.LExprWF public import Strata.DL.Imperative.StmtSemantics -public import Strata.Languages.Core.CoreGen public import Strata.Languages.Core.Procedure +public import Strata.Languages.Core.Factory +import Std.Tactic.BVDecide.Normalize.Prop --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/StatementSemanticsProps.lean b/Strata/Languages/Core/StatementSemanticsProps.lean index 273ad23d60..59ae6d6aaf 100644 --- a/Strata/Languages/Core/StatementSemanticsProps.lean +++ b/Strata/Languages/Core/StatementSemanticsProps.lean @@ -5,25 +5,18 @@ -/ module -public import Strata.DL.Imperative.CmdSemantics import all Strata.DL.Imperative.CmdSemantics -public import Strata.DL.Imperative.StmtSemantics import all Strata.DL.Imperative.StmtSemantics -public import Strata.DL.Imperative.HasVars import all Strata.DL.Imperative.HasVars -public import Strata.DL.Util.Nodup import all Strata.DL.Util.Nodup public import Strata.DL.Util.ListUtils import all Strata.DL.Util.ListUtils -public import Strata.Languages.Core.Procedure -public import Strata.Languages.Core.Statement import all Strata.Languages.Core.Statement public import Strata.Languages.Core.StatementSemantics import all Strata.Languages.Core.StatementSemantics import all Strata.DL.Imperative.Cmd import all Strata.DL.Imperative.Stmt -import Strata.Util.Tactics -public import Strata.Languages.Core.WF +import Std.Tactic.BVDecide.Normalize.BitVec public section diff --git a/Strata/Languages/Core/StatementType.lean b/Strata/Languages/Core/StatementType.lean index 979b6ad95b..98991a7e15 100644 --- a/Strata/Languages/Core/StatementType.lean +++ b/Strata/Languages/Core/StatementType.lean @@ -5,12 +5,11 @@ -/ module -public import Strata.Languages.Core.Statement -public import Strata.Languages.Core.CmdType public import Strata.Languages.Core.Program -public import Strata.Languages.Core.FunctionType -public import Strata.DL.Imperative.CmdType -import Strata.Util.Tactics +import Strata.DL.Imperative.CmdType +import Strata.DL.Lambda.LExprT +import Strata.Languages.Core.CmdType +import Strata.Languages.Core.FunctionType public section diff --git a/Strata/Languages/Core/StatementWF.lean b/Strata/Languages/Core/StatementWF.lean index 28d126e76e..1c6c60b85e 100644 --- a/Strata/Languages/Core/StatementWF.lean +++ b/Strata/Languages/Core/StatementWF.lean @@ -5,10 +5,6 @@ -/ module -public import Strata.DL.Util.ListUtils -public import Strata.Languages.Core.Program -public import Strata.Languages.Core.WF -public import Strata.Languages.Core.StatementType import all Strata.Languages.Core.StatementType import all Strata.DL.Util.ListMap import all Strata.DL.Imperative.CmdType diff --git a/Strata/Languages/Core/Statistics.lean b/Strata/Languages/Core/Statistics.lean index 7daf490369..2c5a58dbad 100644 --- a/Strata/Languages/Core/Statistics.lean +++ b/Strata/Languages/Core/Statistics.lean @@ -5,7 +5,7 @@ -/ module -public import Strata.Util.Statistics +import Strata.Util.Statistics /-! # Core evaluator statistics keys -/ diff --git a/Strata/Languages/Core/TypeDecl.lean b/Strata/Languages/Core/TypeDecl.lean index 820599c0ac..2a565b70c3 100644 --- a/Strata/Languages/Core/TypeDecl.lean +++ b/Strata/Languages/Core/TypeDecl.lean @@ -6,8 +6,8 @@ module -public import Strata.Languages.Core.Statement public import Strata.DL.Lambda.TypeConstructor +public import Strata.Languages.Core.Expressions --------------------------------------------------------------------- diff --git a/Strata/Languages/Core/Verifier.lean b/Strata/Languages/Core/Verifier.lean index 26e50d2c7d..8c61e8d45f 100644 --- a/Strata/Languages/Core/Verifier.lean +++ b/Strata/Languages/Core/Verifier.lean @@ -5,16 +5,8 @@ -/ module -public import Strata.Languages.Core.DDMTransform.Translate -public import Strata.Languages.Core.DDMTransform.ASTtoCST -public import Strata.Languages.Core.Options -public import Strata.Languages.Core.CallGraph public import Strata.Languages.Core.SMTEncoder -public import Strata.DL.Imperative.MetaData -public import Strata.DL.Imperative.SMTUtils -public import Strata.DDM.AST public import Strata.Languages.Core.PipelinePhase -import Strata.DL.SMT.IncrementalSolver import Strata.Transform.CallElim import Strata.Transform.FilterProcedures import Strata.Transform.PrecondElim @@ -23,7 +15,12 @@ import Strata.Transform.LoopElim import Strata.Transform.ANFEncoder import Strata.Languages.Core.ObligationExtraction public import Strata.Transform.IrrelevantAxioms -import Strata.Pipeline.Context +public import Std.Tactic.BVDecide.Normalize.BitVec +public import Strata.Languages.Core.Core -- shake: keep +public import Strata.Languages.Core.DDMTransform.ASTtoCST -- shake: keep +public import Strata.Languages.Core.DDMTransform.Translate -- shake: keep +public import Strata.Languages.Core.Statistics -- shake: keep +import Strata.Util.Tactics open Strata.Pipeline (PipelineContext) @@ -916,7 +913,6 @@ def VCOutcome.merge (a b : VCOutcome) : VCOutcome := solverLog := a.solverLog ++ b.solverLog mergedFrom := aPaths ++ bPaths } - /-- A model with values lifted to LExpr for display purposes. This is used for formatting models in a human-readable way diff --git a/Strata/Languages/Core/WF.lean b/Strata/Languages/Core/WF.lean index 0b5f655441..dc8fc161d2 100644 --- a/Strata/Languages/Core/WF.lean +++ b/Strata/Languages/Core/WF.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.DL.Util.Func public import Strata.DL.Util.ListUtils import all Strata.DL.Util.ListUtils public import Strata.Languages.Core.Program diff --git a/Strata/Languages/Dyn/DDMTransform/Parse.lean b/Strata/Languages/Dyn/DDMTransform/Parse.lean index d79c5a56d9..afcc0df9c4 100644 --- a/Strata/Languages/Dyn/DDMTransform/Parse.lean +++ b/Strata/Languages/Dyn/DDMTransform/Parse.lean @@ -5,8 +5,9 @@ -/ module -public import Strata.DDM.Integration.Lean -public import Strata.DDM.Util.Format +public import Strata.DDM.HNF +public import Strata.DDM.Integration.Lean.OfAstM +import Strata.DDM.Integration.Lean public section diff --git a/Strata/Languages/Dyn/Dyn.lean b/Strata/Languages/Dyn/Dyn.lean index e88f75e217..2a1e108efa 100644 --- a/Strata/Languages/Dyn/Dyn.lean +++ b/Strata/Languages/Dyn/Dyn.lean @@ -4,12 +4,11 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ module +public import Strata.Languages.Dyn.DDMTransform.Parse -- shake: keep -- Main Dyn dialect definition -- TODO: Implement AST structure for dynamic Python-like language -public import Strata.Languages.Dyn.DDMTransform.Parse -public import Strata.Languages.Dyn.DDMTransform.Translate public section diff --git a/Strata/Languages/Dyn/Verify.lean b/Strata/Languages/Dyn/Verify.lean index ba76dd5fd9..e422f00968 100644 --- a/Strata/Languages/Dyn/Verify.lean +++ b/Strata/Languages/Dyn/Verify.lean @@ -7,7 +7,6 @@ module -- TODO: Verification integration for Dyn language -public import Strata.Languages.Dyn.Dyn public section diff --git a/Strata/Languages/Laurel/ConstrainedTypeElim.lean b/Strata/Languages/Laurel/ConstrainedTypeElim.lean index dce1a2eef3..49cca37de7 100644 --- a/Strata/Languages/Laurel/ConstrainedTypeElim.lean +++ b/Strata/Languages/Laurel/ConstrainedTypeElim.lean @@ -5,8 +5,9 @@ -/ module -public import Strata.Languages.Laurel.MapStmtExpr public import Strata.Languages.Laurel.Resolution +import Strata.Languages.Laurel.MapStmtExpr +import Strata.Util.Tactics /-! # Constrained Type Elimination diff --git a/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean b/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean index 2df59b8ceb..f2c9d1afa6 100644 --- a/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean +++ b/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean @@ -5,11 +5,11 @@ -/ module -public import Strata.DDM.Elab public import Strata.DDM.AST -public import Strata.Languages.Laurel.Grammar.LaurelGrammar -public meta import Strata.Languages.Laurel.Grammar.LaurelGrammar -public import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +import Strata.DDM.Integration.Lean.HashCommands -- shake: keep +public import Strata.Languages.Laurel.Laurel +import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +import Strata.Languages.Laurel.Grammar.LaurelGrammar namespace Strata.Laurel diff --git a/Strata/Languages/Laurel/CoreGroupingAndOrdering.lean b/Strata/Languages/Laurel/CoreGroupingAndOrdering.lean index f75057d88f..d38f846a70 100644 --- a/Strata/Languages/Laurel/CoreGroupingAndOrdering.lean +++ b/Strata/Languages/Laurel/CoreGroupingAndOrdering.lean @@ -6,8 +6,8 @@ module public import Strata.Languages.Laurel.Laurel -import Strata.DL.Lambda.LExpr import Strata.DDM.Util.Graph.Tarjan +import Strata.Util.Tactics /-! ## Grouping and Ordering for Core Translation diff --git a/Strata/Languages/Laurel/DesugarShortCircuit.lean b/Strata/Languages/Laurel/DesugarShortCircuit.lean index 6f4e9c5218..ef5982430e 100644 --- a/Strata/Languages/Laurel/DesugarShortCircuit.lean +++ b/Strata/Languages/Laurel/DesugarShortCircuit.lean @@ -5,8 +5,9 @@ -/ module -public import Strata.Languages.Laurel.MapStmtExpr -public import Strata.Languages.Laurel.LiftImperativeExpressions +public import Strata.Languages.Laurel.Resolution +import Strata.Languages.Laurel.LiftImperativeExpressions +import Strata.Languages.Laurel.MapStmtExpr /-! # Desugar Short-Circuit Operators diff --git a/Strata/Languages/Laurel/EliminateHoles.lean b/Strata/Languages/Laurel/EliminateHoles.lean index ecf34a2669..a2d890cbed 100644 --- a/Strata/Languages/Laurel/EliminateHoles.lean +++ b/Strata/Languages/Laurel/EliminateHoles.lean @@ -5,9 +5,9 @@ -/ module -public import Strata.Languages.Laurel.MapStmtExpr -public import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator public import Strata.Util.Statistics +public import Strata.Languages.Laurel.Laurel +import Strata.Languages.Laurel.MapStmtExpr /-! # Deterministic Hole Elimination diff --git a/Strata/Languages/Laurel/EliminateValueReturns.lean b/Strata/Languages/Laurel/EliminateValueReturns.lean index f465c6055c..7c575bf79d 100644 --- a/Strata/Languages/Laurel/EliminateValueReturns.lean +++ b/Strata/Languages/Laurel/EliminateValueReturns.lean @@ -5,7 +5,9 @@ -/ module -public import Strata.Languages.Laurel.MapStmtExpr +public import Strata.Languages.Laurel.Laurel +import Strata.Languages.Laurel.MapStmtExpr +import Strata.Util.Tactics /-! # Eliminate Value Returns diff --git a/Strata/Languages/Laurel/FilterPrelude.lean b/Strata/Languages/Laurel/FilterPrelude.lean index c4c2181c81..b3a92a4dcc 100644 --- a/Strata/Languages/Laurel/FilterPrelude.lean +++ b/Strata/Languages/Laurel/FilterPrelude.lean @@ -6,6 +6,7 @@ module public import Strata.Languages.Laurel.Laurel +import Strata.Languages.Core.Factory /-! ### Prelude Filtering diff --git a/Strata/Languages/Laurel/Grammar.lean b/Strata/Languages/Laurel/Grammar.lean new file mode 100644 index 0000000000..5ac8859c61 --- /dev/null +++ b/Strata/Languages/Laurel/Grammar.lean @@ -0,0 +1,10 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module -- shake: keep-all + +public import Strata.Languages.Laurel.Grammar.LaurelGrammar +public import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +public import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator diff --git a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean index 1ed8e93828..b50dcee969 100644 --- a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean @@ -6,9 +6,9 @@ module public import Strata.DDM.AST -public import Strata.DDM.Format -public import Strata.Languages.Laurel.Grammar.LaurelGrammar public import Strata.Languages.Laurel.Laurel +import Strata.DDM.Format +import Strata.Languages.Laurel.Grammar.LaurelGrammar namespace Strata namespace Laurel diff --git a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean index cf8545d95d..dee56b6ecb 100644 --- a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean @@ -6,10 +6,7 @@ module public import Strata.DDM.AST -public import Strata.Languages.Laurel.Grammar.LaurelGrammar public import Strata.Languages.Laurel.Laurel -public import Strata.DL.Imperative.MetaData -public import Strata.Languages.Core.Expressions namespace Strata namespace Laurel diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean index 02e2159643..252aacbb2a 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean @@ -10,8 +10,9 @@ module -- NOTE: Changes to LaurelGrammar.st are not automatically tracked by the build system. -- Update this file (e.g. this comment) to trigger a recompile after modifying LaurelGrammar.st. -- Last grammar change: multiAssign supports field access targets, added opaque keyword. -public import Strata.DDM.Integration.Lean -public meta import Strata.DDM.Integration.Lean +public import Strata.DDM.AST +import Strata.DDM.BuiltinDialects.Init +import Strata.DDM.Integration.Lean.HashCommands namespace Strata.Laurel diff --git a/Strata/Languages/Laurel/HeapParameterization.lean b/Strata/Languages/Laurel/HeapParameterization.lean index dae58c3caa..d79d800b23 100644 --- a/Strata/Languages/Laurel/HeapParameterization.lean +++ b/Strata/Languages/Laurel/HeapParameterization.lean @@ -5,12 +5,12 @@ -/ module -public import Strata.Languages.Laurel.Laurel -public import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator -public import Strata.Languages.Laurel.LaurelTypes -public import Strata.Languages.Laurel.HeapParameterizationConstants -public import Strata.Languages.Laurel.MapStmtExpr -public import Strata.Util.Tactics +public import Strata.Languages.Laurel.Resolution +import Std.Tactic.BVDecide.Normalize.Prop +import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator +import Strata.Languages.Laurel.HeapParameterizationConstants +import Strata.Languages.Laurel.LaurelTypes +import Strata.Util.Tactics /- Heap Parameterization Pass diff --git a/Strata/Languages/Laurel/HeapParameterizationConstants.lean b/Strata/Languages/Laurel/HeapParameterizationConstants.lean index bfa76a4a59..18118357d5 100644 --- a/Strata/Languages/Laurel/HeapParameterizationConstants.lean +++ b/Strata/Languages/Laurel/HeapParameterizationConstants.lean @@ -5,11 +5,11 @@ -/ module -public import Strata.DDM.Elab public import Strata.DDM.AST -public import Strata.Languages.Laurel.Grammar.LaurelGrammar -public meta import Strata.Languages.Laurel.Grammar.LaurelGrammar -public import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +public import Strata.Languages.Laurel.Laurel +import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +import Strata.Languages.Laurel.Grammar.LaurelGrammar +import Strata.DDM.Integration.Lean.HashCommands -- shake: keep namespace Strata.Laurel diff --git a/Strata/Languages/Laurel/InferHoleTypes.lean b/Strata/Languages/Laurel/InferHoleTypes.lean index ff80f37c5e..b2a63f5255 100644 --- a/Strata/Languages/Laurel/InferHoleTypes.lean +++ b/Strata/Languages/Laurel/InferHoleTypes.lean @@ -5,10 +5,9 @@ -/ module -public import Strata.Languages.Laurel.Laurel -public import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator -public import Strata.Languages.Laurel.LaurelTypes public import Strata.Util.Statistics +public import Strata.Languages.Laurel.Resolution +import Strata.Languages.Laurel.LaurelTypes /-! # Hole Type Inference diff --git a/Strata/Languages/Laurel/Laurel.lean b/Strata/Languages/Laurel/Laurel.lean index 86ae83d022..99933e3754 100644 --- a/Strata/Languages/Laurel/Laurel.lean +++ b/Strata/Languages/Laurel/Laurel.lean @@ -7,9 +7,8 @@ module public import Strata.DL.Imperative.MetaData public import Strata.Languages.Core.Expressions -public import Strata.Languages.Core.Procedure import Strata.Util.Tactics -import Strata.DDM.Util.Decimal +public import Strata.DDM.Util.Decimal /- Documentation for Laurel can be found in docs/verso/LaurelDoc.lean diff --git a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean index 54b97fdfd9..19f0d57b7e 100644 --- a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean +++ b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean @@ -11,8 +11,16 @@ import Strata.Languages.Laurel.EliminateReturnsInExpression import Strata.Languages.Laurel.EliminateValueReturns import Strata.Languages.Laurel.ConstrainedTypeElim import Strata.Languages.Laurel.TypeAliasElim -import Strata.Languages.Core.Verifier -import Strata.Util.Statistics +public import Strata.Languages.Core.Verifier +import Strata.Languages.Core.DDMTransform.ASTtoCST +import Strata.Languages.Laurel.CoreDefinitionsForLaurel +import Strata.Languages.Laurel.EliminateHoles +import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator +import Strata.Languages.Laurel.HeapParameterization +import Strata.Languages.Laurel.InferHoleTypes +import Strata.Languages.Laurel.LiftImperativeExpressions +import Strata.Languages.Laurel.ModifiesClauses +import Strata.Languages.Laurel.TypeHierarchy /-! ## Laurel Compilation Pipeline diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index 9e02d9a825..f40edebc72 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -6,33 +6,17 @@ module public import Strata.Languages.Core.Program -public import Strata.Languages.Core.Verifier -public import Strata.Languages.Core.Statement -public import Strata.Languages.Core.Procedure public import Strata.Languages.Core.Options -public import Strata.Languages.Laurel.Laurel -public import Strata.Languages.Laurel.LiftImperativeExpressions -import Strata.Languages.Laurel.DesugarShortCircuit -public import Strata.Languages.Laurel.InferHoleTypes -public import Strata.Languages.Laurel.EliminateHoles -import Strata.Languages.Laurel.EliminateReturnsInExpression -import Strata.Languages.Laurel.EliminateValueReturns -public import Strata.Languages.Laurel.HeapParameterization -public import Strata.Languages.Laurel.TypeHierarchy -public import Strata.Languages.Laurel.LaurelTypes -public import Strata.Languages.Laurel.ModifiesClauses -public import Strata.Languages.Laurel.CoreDefinitionsForLaurel public import Strata.Languages.Laurel.CoreGroupingAndOrdering -import Strata.DDM.Util.DecimalRat -import Strata.DL.Imperative.Stmt -import Strata.Pipeline.Messages -import Strata.DL.Imperative.MetaData -import Strata.DL.Lambda.LExpr import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator -import Strata.Languages.Laurel.ConstrainedTypeElim import Strata.Util.Tactics +public import Strata.Languages.Laurel.Resolution +import Std.Tactic.BVDecide.Normalize.Bool +import Std.Tactic.BVDecide.Normalize.Prop +import Strata.Languages.Core.Factory +import Strata.Languages.Laurel.LaurelTypes -open Core (VCResult VCResults VerifyOptions) +open Core (VerifyOptions) open Core (intAddOp intSubOp intMulOp intSafeDivOp intSafeModOp intSafeDivTOp intSafeModTOp intNegOp intLtOp intLeOp intGtOp intGeOp boolAndOp boolOrOp boolNotOp boolImpliesOp strConcatOp) open Core (realAddOp realSubOp realMulOp realDivOp realNegOp realLtOp realLeOp realGtOp realGeOp) diff --git a/Strata/Languages/Laurel/LaurelTypes.lean b/Strata/Languages/Laurel/LaurelTypes.lean index 9bbdc86a83..c3554d24e3 100644 --- a/Strata/Languages/Laurel/LaurelTypes.lean +++ b/Strata/Languages/Laurel/LaurelTypes.lean @@ -5,10 +5,7 @@ -/ module -public import Strata.Languages.Laurel.Laurel -public import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator public import Strata.Languages.Laurel.Resolution -import Strata.Util.Tactics public section diff --git a/Strata/Languages/Laurel/LiftImperativeExpressions.lean b/Strata/Languages/Laurel/LiftImperativeExpressions.lean index e87b24d480..a744c1bbcb 100644 --- a/Strata/Languages/Laurel/LiftImperativeExpressions.lean +++ b/Strata/Languages/Laurel/LiftImperativeExpressions.lean @@ -5,12 +5,9 @@ -/ module -public import Strata.Languages.Laurel.Laurel -public import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator -public import Strata.Languages.Laurel.LaurelTypes -public import Strata.Languages.Core.Verifier -public import Strata.DL.Util.Map import Strata.Util.Tactics +public import Strata.Languages.Laurel.Resolution +import Strata.Languages.Laurel.LaurelTypes namespace Strata namespace Laurel diff --git a/Strata/Languages/Laurel/ModifiesClauses.lean b/Strata/Languages/Laurel/ModifiesClauses.lean index 5fb37c60ad..7a96f95766 100644 --- a/Strata/Languages/Laurel/ModifiesClauses.lean +++ b/Strata/Languages/Laurel/ModifiesClauses.lean @@ -5,11 +5,10 @@ -/ module -public import Strata.Languages.Laurel.Laurel -public import Strata.Languages.Laurel.LaurelTypes -public import Strata.Languages.Core.Verifier public import Strata.Languages.Laurel.Resolution import Strata.Languages.Laurel.HeapParameterizationConstants +import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator +import Strata.Languages.Laurel.LaurelTypes /- Modifies clause transformation (Laurel → Laurel). diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index 75e6ac1292..eb43380f7b 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -6,9 +6,8 @@ module public import Strata.Languages.Laurel.Laurel -public import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator import Strata.Util.Tactics -import Strata.Languages.Python.PythonLaurelCorePrelude +import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator /-! # Name Resolution Pass diff --git a/Strata/Languages/Laurel/TypeAliasElim.lean b/Strata/Languages/Laurel/TypeAliasElim.lean index f4ccc539a0..efc898c443 100644 --- a/Strata/Languages/Laurel/TypeAliasElim.lean +++ b/Strata/Languages/Laurel/TypeAliasElim.lean @@ -5,8 +5,8 @@ -/ module -public import Strata.Languages.Laurel.MapStmtExpr public import Strata.Languages.Laurel.Resolution +import Strata.Languages.Laurel.MapStmtExpr /-! # Type Alias Elimination diff --git a/Strata/Languages/Laurel/TypeHierarchy.lean b/Strata/Languages/Laurel/TypeHierarchy.lean index 26b72ff23f..3751c172c0 100644 --- a/Strata/Languages/Laurel/TypeHierarchy.lean +++ b/Strata/Languages/Laurel/TypeHierarchy.lean @@ -5,11 +5,12 @@ -/ module -public import Strata.Languages.Laurel.MapStmtExpr -public import Strata.Languages.Laurel.LaurelTypes -public import Strata.DL.Imperative.MetaData import Strata.Languages.Laurel.HeapParameterizationConstants import Strata.Util.Tactics +public import Strata.Languages.Laurel.Resolution +import Std.Tactic.BVDecide.Normalize.Prop +import Strata.Languages.Laurel.LaurelTypes +import Strata.Languages.Laurel.MapStmtExpr public section diff --git a/Strata/Languages/Python/CorePrelude.lean b/Strata/Languages/Python/CorePrelude.lean index 7dd8c856c9..36ff64c5b0 100644 --- a/Strata/Languages/Python/CorePrelude.lean +++ b/Strata/Languages/Python/CorePrelude.lean @@ -5,10 +5,9 @@ -/ module -public import Strata.DDM.Elab -public import Strata.DDM.AST -public import Strata.Languages.Core.DDMTransform.Grammar -public import Strata.Languages.Core.Verifier +public import Strata.Languages.Core.Program +import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands -- shake: keep namespace Strata namespace Python diff --git a/Strata/Languages/Python/FunctionSignatures.lean b/Strata/Languages/Python/FunctionSignatures.lean index 53eeab9e88..00b00e9bf5 100644 --- a/Strata/Languages/Python/FunctionSignatures.lean +++ b/Strata/Languages/Python/FunctionSignatures.lean @@ -5,7 +5,8 @@ -/ module -public import Strata.Languages.Core.Core +public import Strata.Languages.Core.Expressions +import Strata.Languages.Core.Env namespace Strata namespace Python diff --git a/Strata/Languages/Python/PyFactory.lean b/Strata/Languages/Python/PyFactory.lean index f058b50293..abbc4a2986 100644 --- a/Strata/Languages/Python/PyFactory.lean +++ b/Strata/Languages/Python/PyFactory.lean @@ -5,8 +5,10 @@ -/ module -public import Strata.Languages.Core.Verifier -public import Strata.Languages.Python.Regex.ReToCore +public import Strata.DL.Lambda.Factory +public import Strata.Languages.Core.Identifiers +import Strata.Languages.Core.Factory +import Strata.Languages.Python.Regex.ReToCore namespace Strata namespace Python diff --git a/Strata/Languages/Python/PySpecPipeline.lean b/Strata/Languages/Python/PySpecPipeline.lean index 5c05cfc37a..f3af6d5e66 100644 --- a/Strata/Languages/Python/PySpecPipeline.lean +++ b/Strata/Languages/Python/PySpecPipeline.lean @@ -18,7 +18,6 @@ import Strata.Languages.Python.Specs.IdentifyOverloads import Strata.Languages.Python.Specs.MessageKind import Strata.Languages.Python.Specs.ToLaurel public import Strata.Pipeline.Context -import Strata.Util.DecideProp public import Strata.Util.Statistics /-! ## PySpec Pipeline diff --git a/Strata/Languages/Python/Python.lean b/Strata/Languages/Python/Python.lean index 1e4c2947e7..945f93ce60 100644 --- a/Strata/Languages/Python/Python.lean +++ b/Strata/Languages/Python/Python.lean @@ -5,8 +5,3 @@ -/ module -import Strata.Languages.Python.PythonToCore -import Strata.Languages.Python.PythonDialect -import Strata.Languages.Python.CorePrelude -import Strata.Languages.Python.FunctionSignatures -import Strata.Languages.Python.PythonToLaurel diff --git a/Strata/Languages/Python/PythonDialect.lean b/Strata/Languages/Python/PythonDialect.lean index 2e8b98adc7..13e2cd7b82 100644 --- a/Strata/Languages/Python/PythonDialect.lean +++ b/Strata/Languages/Python/PythonDialect.lean @@ -5,13 +5,11 @@ -/ module -public import Strata.DDM.Integration.Lean -import Strata.DDM.AST -import Strata.DDM.Util.ByteArray -import Strata.DDM.Format -import Strata.DDM.BuiltinDialects.Init public import Strata.DDM.Integration.Lean.OfAstM +public import Strata.DDM.Format +import Strata.DDM.Integration.Lean.Gen +import Strata.DDM.Integration.Lean.HashCommands public section namespace Strata.Python diff --git a/Strata/Languages/Python/PythonLaurelCorePrelude.lean b/Strata/Languages/Python/PythonLaurelCorePrelude.lean index 381fc00bd7..2ab1df5bc0 100644 --- a/Strata/Languages/Python/PythonLaurelCorePrelude.lean +++ b/Strata/Languages/Python/PythonLaurelCorePrelude.lean @@ -5,10 +5,9 @@ -/ module -import Strata.DDM.Elab -import Strata.DDM.AST -import Strata.Languages.Core.DDMTransform.Grammar -public import Strata.Languages.Core.Verifier +import Strata.DDM.Integration.Lean.HashCommands -- shake: keep +public import Strata.Languages.Core.Program +import Strata.Languages.Core.Verifier namespace Strata namespace Python diff --git a/Strata/Languages/Python/PythonRuntimeLaurelPart.lean b/Strata/Languages/Python/PythonRuntimeLaurelPart.lean index f65c131106..7c04bfaea8 100644 --- a/Strata/Languages/Python/PythonRuntimeLaurelPart.lean +++ b/Strata/Languages/Python/PythonRuntimeLaurelPart.lean @@ -7,6 +7,8 @@ module import Strata.Languages.Laurel.Grammar.LaurelGrammar import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator public import Strata.Languages.Laurel.Laurel +public import Strata.DDM.AST +public import Strata.DDM.Integration.Lean.HashCommands -- shake: keep namespace Strata namespace Python diff --git a/Strata/Languages/Python/PythonToCore.lean b/Strata/Languages/Python/PythonToCore.lean index 5641277d32..5c5e9ebd80 100644 --- a/Strata/Languages/Python/PythonToCore.lean +++ b/Strata/Languages/Python/PythonToCore.lean @@ -5,18 +5,12 @@ -/ module -public import Strata.DDM.Elab -public import Strata.DDM.AST -public import Strata.Languages.Core.DDMTransform.Grammar -public import Strata.Languages.Core.Core -public import Strata.Languages.Core.CoreOp public import Strata.Languages.Python.PythonDialect public import Strata.Languages.Python.FunctionSignatures -import Strata.Languages.Python.Regex.ReToCore -import Strata.Languages.Python.PyFactory -import Strata.Languages.Python.FunctionSignatures +public import Strata.Languages.Core.Program +import Strata.Languages.Core.Env namespace Strata open Lambda.LTy.Syntax diff --git a/Strata/Languages/Python/PythonToLaurel.lean b/Strata/Languages/Python/PythonToLaurel.lean index 0c1a030899..1a3fa1ea54 100644 --- a/Strata/Languages/Python/PythonToLaurel.lean +++ b/Strata/Languages/Python/PythonToLaurel.lean @@ -10,7 +10,8 @@ public import Strata.Languages.Laurel.Laurel public import Strata.Languages.Python.OverloadTable public import Strata.Languages.Python.PythonDialect import Strata.Languages.Python.PythonRuntimeLaurelPart -import Strata.Util.DecideProp +import Std.Tactic.BVDecide.Normalize.Prop +import Strata.Util.Tactics /-! # Python to Laurel Translation diff --git a/Strata/Languages/Python/Regex/ReToCore.lean b/Strata/Languages/Python/Regex/ReToCore.lean index c889b3f09d..080d70ac8d 100644 --- a/Strata/Languages/Python/Regex/ReToCore.lean +++ b/Strata/Languages/Python/Regex/ReToCore.lean @@ -6,7 +6,8 @@ module public import Strata.Languages.Python.Regex.ReParser -public import Strata.Languages.Core.Factory +public import Strata.Languages.Core.Expressions +import Strata.Languages.Core.Factory namespace Strata namespace Python diff --git a/Strata/Languages/Python/Specs.lean b/Strata/Languages/Python/Specs.lean index 92663d1706..7090b4f1ab 100644 --- a/Strata/Languages/Python/Specs.lean +++ b/Strata/Languages/Python/Specs.lean @@ -5,13 +5,11 @@ -/ module -import Strata.DDM.Format import all Strata.DDM.Util.Fin import Strata.Languages.Python.ReadPython import Strata.Languages.Python.Specs.DDM public import Strata.Languages.Python.Specs.Decls import Strata.Languages.Python.Specs.MessageKind -import Strata.Pipeline.Messages import Strata.Util.DecideProp namespace Strata.Python.ModuleName diff --git a/Strata/Languages/Python/Specs/DDM.lean b/Strata/Languages/Python/Specs/DDM.lean index 318bfcbad7..7f719d1d77 100644 --- a/Strata/Languages/Python/Specs/DDM.lean +++ b/Strata/Languages/Python/Specs/DDM.lean @@ -5,12 +5,11 @@ -/ module -public import Strata.DDM.Integration.Lean public import Strata.Languages.Python.Specs.Decls -import Strata.DDM.BuiltinDialects.Init -public import Strata.DDM.Integration.Lean.OfAstM +public import Strata.DDM.AST import Strata.DDM.Format import Strata.DDM.Ion +import Strata.DDM.Integration.Lean -- shake: keep namespace Strata.Python diff --git a/Strata/Languages/Python/Specs/Decls.lean b/Strata/Languages/Python/Specs/Decls.lean index c1f2212b0c..e8d016b77d 100644 --- a/Strata/Languages/Python/Specs/Decls.lean +++ b/Strata/Languages/Python/Specs/Decls.lean @@ -4,7 +4,6 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ module -public import Std.Data.HashMap.Basic public import Strata.DDM.Util.SourceRange public import Strata.Languages.Python.PythonIdent diff --git a/Strata/Languages/Python/Specs/IdentifyOverloads.lean b/Strata/Languages/Python/Specs/IdentifyOverloads.lean index 212acc5109..aadb58bd9e 100644 --- a/Strata/Languages/Python/Specs/IdentifyOverloads.lean +++ b/Strata/Languages/Python/Specs/IdentifyOverloads.lean @@ -7,7 +7,7 @@ module public import Strata.Languages.Python.OverloadTable public import Strata.Languages.Python.PythonDialect -import Strata.Languages.Python.Specs.ToLaurel +import Strata.Languages.Core.Factory /-! # Overload Resolution for Python Programs diff --git a/Strata/Languages/Python/Specs/ToLaurel.lean b/Strata/Languages/Python/Specs/ToLaurel.lean index 2f8f07897b..4407a89864 100644 --- a/Strata/Languages/Python/Specs/ToLaurel.lean +++ b/Strata/Languages/Python/Specs/ToLaurel.lean @@ -6,7 +6,6 @@ module public import Strata.Languages.Laurel.Laurel -import Strata.DDM.Format import Strata.Languages.Python.PythonLaurelTypedExpr public import Strata.Languages.Python.Specs.Decls public import Strata.Pipeline.Messages diff --git a/Strata/MetaVerifier.lean b/Strata/MetaVerifier.lean index c841f4c107..910831d9a4 100644 --- a/Strata/MetaVerifier.lean +++ b/Strata/MetaVerifier.lean @@ -5,17 +5,32 @@ -/ module -import Lean.Meta -import Lean.Elab.Tactic - -import Strata.Languages.Core.Verifier import Strata.Transform.LoopElim import Strata.Languages.Core.ObligationExtraction -public import Strata.Languages.C_Simp.Verify -public import Strata.Languages.Boole.Verify -import Strata.DL.Imperative.SMTUtils -public import Strata.DL.SMT.Denote -public import Strata.DL.SMT.Translate +public import Strata.Languages.Boole.Boole +public import Strata.Languages.C_Simp.C_Simp +public import Strata.Languages.Core.SMTEncoder +import Std.Tactic.BVDecide.Normalize.Prop +import Strata.DL.Lambda.Denote.LExprAnnotated +import Strata.DL.SMT.Denote +import Strata.Languages.Boole.Verify +import Strata.Languages.C_Simp.DDMTransform.Translate +import Strata.Languages.C_Simp.Verify +import Strata.Languages.Core.Core +import Strata.Languages.Core.DDMTransform.Translate +import Strata.Languages.Core.ProgramEval + +-- For some reason shake wants to meta import the following +-- while lake itself only requires imports. + +public meta import Strata.DL.SMT.Translate +import Strata.DL.SMT.Translate -- shake: keep +meta import Lean.Meta.Eval +import Lean.Meta.Tactic.Rewrite -- shake: keep +meta import Lean.Meta.Tactic.Rewrite +import Lean.Meta.Tactic.Unfold -- shake: keep +meta import Lean.Meta.Tactic.Unfold +import Lean.Meta.Eval -- shake: keep open Lean hiding Options diff --git a/Strata/Pipeline/Context.lean b/Strata/Pipeline/Context.lean index 408d38819d..e075149b77 100644 --- a/Strata/Pipeline/Context.lean +++ b/Strata/Pipeline/Context.lean @@ -5,7 +5,6 @@ -/ module public import Strata.Pipeline.Messages -import Lean.Data.Json.Printer import all Strata.DDM.Util.String namespace Strata.Pipeline diff --git a/Strata/Pipeline/PyAnalyzeLaurel.lean b/Strata/Pipeline/PyAnalyzeLaurel.lean index 9f5e4f9e68..822657f80c 100644 --- a/Strata/Pipeline/PyAnalyzeLaurel.lean +++ b/Strata/Pipeline/PyAnalyzeLaurel.lean @@ -5,14 +5,14 @@ -/ module -public import Strata.Pipeline.Diagnostic -public import Strata.Util.Statistics public import Strata.Languages.Core.EntryPoint public import Strata.Languages.Core.Verifier import Strata.Languages.Python.PySpecPipeline import Strata.Languages.Python.PyFactory import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator import Strata.SimpleAPI +import Strata.Languages.Core.DDMTransform.ASTtoCST +import Strata.Pipeline.Diagnostic namespace Strata.Pipeline diff --git a/Strata/SimpleAPI.lean b/Strata/SimpleAPI.lean index 449b8e61f7..7a59ef4c1e 100644 --- a/Strata/SimpleAPI.lean +++ b/Strata/SimpleAPI.lean @@ -7,24 +7,26 @@ module public import Strata.Util.IO -public import Strata.Transform.CoreTransform import Strata.Transform.CallElim import Strata.Transform.LoopElim public import Strata.Transform.ProcedureInlining import Strata.Transform.FilterProcedures -import Strata.Transform.IrrelevantAxioms -public import Strata.Languages.Core.Options public import Strata.Languages.Core.Verifier import Strata.Languages.Laurel.LaurelCompilationPipeline import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator -public import Strata.Languages.Python.PySpecPipeline import Strata.Languages.Python.Specs import Strata.Languages.Python.Specs.DDM import Strata.Languages.Python.CorePrelude import Strata.Languages.Python.PythonToCore import Strata.Languages.Python.ReadPython +public import Strata.DDM.Ion +public import Strata.Languages.Laurel.Laurel +public import Strata.Languages.Python.PythonDialect +import Strata.DDM.Elab +import Strata.Languages.Laurel.Grammar.LaurelGrammar +import Strata.Languages.Python.PySpecPipeline /-! ## Simple Strata API diff --git a/Strata/Transform/CallElim.lean b/Strata/Transform/CallElim.lean index 8eb3a07262..bbed70c353 100644 --- a/Strata/Transform/CallElim.lean +++ b/Strata/Transform/CallElim.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.Transform.CoreTransform public import Strata.Languages.Core.PipelinePhase /-! # Call Elimination Transformation -/ diff --git a/Strata/Transform/CallElimCorrect.lean b/Strata/Transform/CallElimCorrect.lean index 5b7c165ca7..2dba595496 100644 --- a/Strata/Transform/CallElimCorrect.lean +++ b/Strata/Transform/CallElimCorrect.lean @@ -5,20 +5,7 @@ -/ module -import Init.Data.List.Basic -import Init.Data.List.Lemmas -public import Strata.Languages.Core.Env -public import Strata.Languages.Core.Identifiers -public import Strata.Languages.Core.Program -public import Strata.Languages.Core.ProgramType -public import Strata.Languages.Core.WF -public import Strata.DL.Lambda.Lambda public import Strata.Transform.CoreTransform -public import Strata.Transform.CallElim -public import Strata.DL.Imperative.CmdSemantics -public import Strata.Languages.Core.StatementSemantics -import Strata.Languages.Core.StatementSemanticsProps -import Strata.DL.Util.ListUtils /-! # Call Elimination Correctness Proof (DEPRECATED) @@ -33,7 +20,7 @@ import Strata.DL.Util.ListUtils -/ namespace CallElimCorrect -open Core Core.Transform CallElim +open Core Core.Transform public section diff --git a/Strata/Transform/CoreSpecification.lean b/Strata/Transform/CoreSpecification.lean index aef7675338..3df3ff9df5 100644 --- a/Strata/Transform/CoreSpecification.lean +++ b/Strata/Transform/CoreSpecification.lean @@ -6,7 +6,6 @@ module public import Strata.Languages.Core.StatementSemantics -public import Strata.Languages.Core.StatementSemanticsProps public import Strata.Transform.Specification public import Strata.Languages.Core.WF diff --git a/Strata/Transform/CoreTransform.lean b/Strata/Transform/CoreTransform.lean index d621676ee0..cd26487211 100644 --- a/Strata/Transform/CoreTransform.lean +++ b/Strata/Transform/CoreTransform.lean @@ -5,10 +5,8 @@ -/ module -public import Strata.Languages.Core.Statement public import Strata.Languages.Core.CallGraph public import Strata.Languages.Core.CoreGen -public import Strata.DL.Util.LabelGen public import Strata.Util.Statistics /-! # Utility functions for program transformation in Strata Core -/ diff --git a/Strata/Transform/DetToKleene.lean b/Strata/Transform/DetToKleene.lean index a4d59777e8..99c9075085 100644 --- a/Strata/Transform/DetToKleene.lean +++ b/Strata/Transform/DetToKleene.lean @@ -5,10 +5,8 @@ -/ module -public import Strata.DL.Imperative.Cmd public import Strata.DL.Imperative.Stmt public import Strata.DL.Imperative.KleeneStmt -public import Strata.Languages.Core.StatementType /-! # Deterministic-to-Kleene Transformation diff --git a/Strata/Transform/DetToKleeneCorrect.lean b/Strata/Transform/DetToKleeneCorrect.lean index a28684733d..c373712f9c 100644 --- a/Strata/Transform/DetToKleeneCorrect.lean +++ b/Strata/Transform/DetToKleeneCorrect.lean @@ -5,11 +5,7 @@ -/ module -public import Strata.DL.Imperative.Stmt -public import Strata.DL.Imperative.StmtSemantics -public import Strata.DL.Imperative.KleeneStmt public import Strata.DL.Imperative.KleeneStmtSemantics -public import Strata.DL.Imperative.KleeneSemanticsProps public import Strata.Transform.DetToKleene public import Strata.Transform.Specification import all Strata.Transform.Specification @@ -18,6 +14,9 @@ import all Strata.DL.Imperative.Stmt import all Strata.DL.Imperative.StmtSemantics import all Strata.DL.Imperative.CmdSemantics import all Strata.DL.Util.Relations +import Std.Tactic.BVDecide.Normalize.Bool +import Std.Tactic.BVDecide.Normalize.Prop +import Strata.DL.Imperative.KleeneSemanticsProps /-! # Deterministic-to-Kleene Transformation Correctness. diff --git a/Strata/Transform/FilterProcedures.lean b/Strata/Transform/FilterProcedures.lean index eb43008220..c3a556abf9 100644 --- a/Strata/Transform/FilterProcedures.lean +++ b/Strata/Transform/FilterProcedures.lean @@ -5,8 +5,8 @@ -/ module -public import Strata.Transform.CoreTransform public import Strata.Languages.Core.PipelinePhase +import Std.Data.HashMap.AdditionalOperations /-! # Erase procedures satisfying specific criteria -/ diff --git a/Strata/Transform/LoopElim.lean b/Strata/Transform/LoopElim.lean index efbee4a8cd..03758bb1f7 100644 --- a/Strata/Transform/LoopElim.lean +++ b/Strata/Transform/LoopElim.lean @@ -5,7 +5,6 @@ -/ module -public import Strata.DL.Imperative.Stmt public import Strata.Languages.Core.PipelinePhase import Strata.Languages.Core.StatementSemantics diff --git a/Strata/Transform/PrecondElim.lean b/Strata/Transform/PrecondElim.lean index e16d42c025..fca5651a93 100644 --- a/Strata/Transform/PrecondElim.lean +++ b/Strata/Transform/PrecondElim.lean @@ -5,14 +5,13 @@ -/ module -public import Strata.Transform.CoreTransform -public import Strata.Transform.TerminationCheck -public import Strata.DL.Lambda.Preconditions -public import Strata.DL.Lambda.TypeFactory public import Strata.Languages.Core.PipelinePhase -public import Strata.Languages.Core.CoreOp import all Strata.DL.Imperative.Stmt -import Strata.Util.DecideProp +public import Strata.Util.DecideProp +import Strata.DL.Lambda.Preconditions +import Strata.Languages.Core.Factory +import Strata.Transform.TerminationCheck +import Strata.Util.Tactics /-! # Partial Function Precondition Elimination diff --git a/Strata/Transform/ProcBodyVerify.lean b/Strata/Transform/ProcBodyVerify.lean index aa68c38a96..058f19a2d3 100644 --- a/Strata/Transform/ProcBodyVerify.lean +++ b/Strata/Transform/ProcBodyVerify.lean @@ -5,9 +5,6 @@ -/ module -public import Strata.Languages.Core.Procedure -public import Strata.Languages.Core.Statement -public import Strata.Languages.Core.Identifiers public import Strata.Transform.CoreTransform public section diff --git a/Strata/Transform/ProcBodyVerifyCorrect.lean b/Strata/Transform/ProcBodyVerifyCorrect.lean index 515f44dee2..b8bb5896a6 100644 --- a/Strata/Transform/ProcBodyVerifyCorrect.lean +++ b/Strata/Transform/ProcBodyVerifyCorrect.lean @@ -7,10 +7,9 @@ module public import Strata.Transform.ProcBodyVerify public import Strata.Transform.CoreSpecification -public import Strata.Languages.Core.WF -public import Strata.Languages.Core.ProcedureWF -import Strata.DL.Util.ListMap -import Strata.DL.Util.List +import Std.Tactic.BVDecide.Normalize.Prop +import Strata.Languages.Core.ProcedureWF +import Strata.Languages.Core.StatementSemanticsProps public section diff --git a/Strata/Transform/ProcedureInlining.lean b/Strata/Transform/ProcedureInlining.lean index 752e626aa6..1665921146 100644 --- a/Strata/Transform/ProcedureInlining.lean +++ b/Strata/Transform/ProcedureInlining.lean @@ -5,15 +5,7 @@ -/ module -import Strata.DL.Util.LabelGen -import Strata.DL.Util.ListUtils -import Strata.Languages.Core.Core -import Strata.Languages.Core.CoreGen -import Strata.Languages.Core.ProgramWF -public import Strata.Languages.Core.Statement -public import Strata.Transform.CoreTransform public import Strata.Languages.Core.PipelinePhase -import Strata.Util.Tactics /-! # Procedure Inlining Transformation -/ diff --git a/Strata/Transform/Specification.lean b/Strata/Transform/Specification.lean index 67f05c5045..370fa650b3 100644 --- a/Strata/Transform/Specification.lean +++ b/Strata/Transform/Specification.lean @@ -8,7 +8,6 @@ module public import Strata.DL.Imperative.StmtSemantics import all Strata.DL.Imperative.CmdSemantics import Strata.DL.Util.ListUtils -import Strata.DL.Imperative.SemanticsProps /-! # Soundness Specification diff --git a/Strata/Transform/StructuredToUnstructured.lean b/Strata/Transform/StructuredToUnstructured.lean index 94b345d25f..77168ca4d1 100644 --- a/Strata/Transform/StructuredToUnstructured.lean +++ b/Strata/Transform/StructuredToUnstructured.lean @@ -5,12 +5,8 @@ -/ module -import Strata.DL.Imperative.PureExpr public import Strata.DL.Imperative.BasicBlock -public import Strata.DL.Imperative.CFGSemantics -import Strata.DL.Imperative.Cmd public import Strata.DL.Imperative.Stmt -import Strata.DL.Lambda.LExpr public import Strata.DL.Util.LabelGen public section diff --git a/Strata/Transform/TerminationCheck.lean b/Strata/Transform/TerminationCheck.lean index ddc8065a7c..2c262f1bf0 100644 --- a/Strata/Transform/TerminationCheck.lean +++ b/Strata/Transform/TerminationCheck.lean @@ -5,10 +5,10 @@ -/ module -public import Strata.Transform.CoreTransform -public import Strata.DL.Lambda.AdtRankAxioms -public import Strata.DL.Lambda.TypeFactory public import Strata.Languages.Core.PipelinePhase +import Strata.DL.Lambda.AdtRankAxioms +import Strata.Languages.Core.Factory +import Strata.Util.Tactics /-! # Termination Checking for Recursive Functions diff --git a/Strata/Util/FileRange.lean b/Strata/Util/FileRange.lean index f112109120..67ccdef735 100644 --- a/Strata/Util/FileRange.lean +++ b/Strata/Util/FileRange.lean @@ -5,7 +5,6 @@ -/ module public import Strata.DDM.Util.SourceRange -public import Lean.Data.Position open Std (Format) diff --git a/Strata/Util/IO.lean b/Strata/Util/IO.lean index 23a5b6cd5c..909ad95b00 100644 --- a/Strata/Util/IO.lean +++ b/Strata/Util/IO.lean @@ -6,12 +6,8 @@ module import Strata.DDM.Elab -import Strata.DDM.Ion -import Strata.DDM.BuiltinDialects public import Strata.DDM.Elab.LoadedDialects import Strata.DDM.Util.Ion -import Strata.DDM.Util.ByteArray -import Strata.DDM.Util.Lean open Lean (Message) diff --git a/Strata/Util/List.lean b/Strata/Util/List.lean index 543a484d2a..90f416c8c6 100644 --- a/Strata/Util/List.lean +++ b/Strata/Util/List.lean @@ -5,7 +5,7 @@ -/ module -public import Std +public import Std.Data.HashMap.Basic /-! # List duplicate detection diff --git a/Strata/Util/Sarif.lean b/Strata/Util/Sarif.lean index a9e8946d9b..1beeb5b921 100644 --- a/Strata/Util/Sarif.lean +++ b/Strata/Util/Sarif.lean @@ -5,9 +5,7 @@ -/ module -public import Lean.Data.Json.Basic -public import Lean.Data.Json.FromToJson -import Lean.Data.Json +public import Lean.Data.Json.FromToJson.Basic public section diff --git a/Strata/Util/Statistics.lean b/Strata/Util/Statistics.lean index a030c8d64f..7a26e30292 100644 --- a/Strata/Util/Statistics.lean +++ b/Strata/Util/Statistics.lean @@ -5,9 +5,10 @@ -/ module -public import Std.Data.HashMap public meta import Lean.Elab.Command -public meta import Lean.Parser +public import Std.Data.HashMap.Basic +public meta import Std.Do.Triple.SpecLemmas +import Lean.Exception /-! # Transform statistics diff --git a/Strata/Util/Tactics.lean b/Strata/Util/Tactics.lean index acb8dd55de..c9b6bf5bed 100644 --- a/Strata/Util/Tactics.lean +++ b/Strata/Util/Tactics.lean @@ -5,7 +5,12 @@ -/ module -public meta import Lean.Elab.Tactic +public meta import Init.Grind.Cases +public meta import Init.Grind.Ext +public meta import Lean.Elab.Tactic.Basic +public meta import Lean.Meta.Tactic.Generalize +public meta import Std.Do -- shake: keep +import Lean.Exception public section /-! diff --git a/StrataMainLib.lean b/StrataMainLib.lean index d697b2aa32..9f345497cd 100644 --- a/StrataMainLib.lean +++ b/StrataMainLib.lean @@ -20,6 +20,7 @@ import Strata.Pipeline.Diagnostic import Strata.Pipeline.PyAnalyzeLaurel import Strata.Languages.Boole.Boole import Strata.Languages.Boole.Verify +import Strata.Languages.C_Simp.DDMTransform.Parse import Strata.Languages.Python.Python import Strata.Languages.Python.Specs.IdentifyOverloads import Strata.Languages.Python.Specs.ToLaurel diff --git a/StrataTest/Backends/CBMC/GOTO/E2E_CoreToGOTO.lean b/StrataTest/Backends/CBMC/GOTO/E2E_CoreToGOTO.lean index 55eb7e676a..e4cc9877de 100644 --- a/StrataTest/Backends/CBMC/GOTO/E2E_CoreToGOTO.lean +++ b/StrataTest/Backends/CBMC/GOTO/E2E_CoreToGOTO.lean @@ -7,6 +7,8 @@ module meta import Strata.Backends.CBMC.CollectSymbols meta import Strata.Backends.CBMC.GOTO.CoreToGOTOPipeline import Strata.DDM.Integration.Lean.HashCommands +import Strata.Languages.Core.DDMTransform.Translate +import Lean.Server.Utils /-! ## End-to-end tests: Core program → GOTO JSON diff --git a/StrataTest/Backends/CBMC/GOTO/LambdaToCProverGOTO.lean b/StrataTest/Backends/CBMC/GOTO/LambdaToCProverGOTO.lean index 4e505fa3b4..f7f52c0608 100644 --- a/StrataTest/Backends/CBMC/GOTO/LambdaToCProverGOTO.lean +++ b/StrataTest/Backends/CBMC/GOTO/LambdaToCProverGOTO.lean @@ -6,6 +6,7 @@ module meta import Strata.Backends.CBMC.GOTO.LambdaToCProverGOTO +import Lean.Server.Utils meta section diff --git a/StrataTest/Backends/CBMC/GOTO/ToCProverGOTO.lean b/StrataTest/Backends/CBMC/GOTO/ToCProverGOTO.lean index 0d563e12a4..d489b7bfaa 100644 --- a/StrataTest/Backends/CBMC/GOTO/ToCProverGOTO.lean +++ b/StrataTest/Backends/CBMC/GOTO/ToCProverGOTO.lean @@ -8,6 +8,7 @@ module meta import all StrataTest.Backends.CBMC.GOTO.LambdaToCProverGOTO meta import all Strata.DL.Imperative.ToCProverGOTO meta import all Strata.Backends.CBMC.GOTO.InstToJson +import all Strata.DL.Lambda.LState meta section diff --git a/StrataTest/Backends/CBMC/SimpleAdd/SimpleAdd.lean b/StrataTest/Backends/CBMC/SimpleAdd/SimpleAdd.lean index b20b610cc3..88c498cfaf 100644 --- a/StrataTest/Backends/CBMC/SimpleAdd/SimpleAdd.lean +++ b/StrataTest/Backends/CBMC/SimpleAdd/SimpleAdd.lean @@ -6,6 +6,7 @@ module import Strata.Backends.CBMC.GOTO.CoreToCProverGOTO +import Strata.DDM.Integration.Lean open Std (ToFormat Format format) ------------------------------------------------------------------------------- diff --git a/StrataTest/DL/Imperative/ArithEval.lean b/StrataTest/DL/Imperative/ArithEval.lean index 8a0246a515..c1b279a63c 100644 --- a/StrataTest/DL/Imperative/ArithEval.lean +++ b/StrataTest/DL/Imperative/ArithEval.lean @@ -5,10 +5,9 @@ -/ module - - import all StrataTest.DL.Imperative.ArithExpr meta import Strata.DL.Imperative.CmdEval +meta import Strata.DL.Util.Map meta section diff --git a/StrataTest/DL/Imperative/ArithType.lean b/StrataTest/DL/Imperative/ArithType.lean index 35b0267bda..baa86a1be1 100644 --- a/StrataTest/DL/Imperative/ArithType.lean +++ b/StrataTest/DL/Imperative/ArithType.lean @@ -7,6 +7,7 @@ module meta import Strata.DL.Imperative.CmdType import all StrataTest.DL.Imperative.ArithExpr +public meta import Strata.DL.Util.Map open Strata diff --git a/StrataTest/DL/Imperative/CFGToCProverGOTO.lean b/StrataTest/DL/Imperative/CFGToCProverGOTO.lean index 3b00a093e7..49d2aeed0c 100644 --- a/StrataTest/DL/Imperative/CFGToCProverGOTO.lean +++ b/StrataTest/DL/Imperative/CFGToCProverGOTO.lean @@ -8,6 +8,7 @@ module meta import Strata.DL.Imperative.CFGToCProverGOTO meta import Strata.Transform.StructuredToUnstructured meta import all StrataTest.Backends.CBMC.GOTO.LambdaToCProverGOTO +import Strata.DL.Lambda.LState meta section diff --git a/StrataTest/DL/Imperative/SMTEncoder.lean b/StrataTest/DL/Imperative/SMTEncoder.lean index eff1c4fff9..40be02e8c1 100644 --- a/StrataTest/DL/Imperative/SMTEncoder.lean +++ b/StrataTest/DL/Imperative/SMTEncoder.lean @@ -7,7 +7,7 @@ module meta import all StrataTest.DL.Imperative.Arith meta import Strata.DL.Imperative.EvalContext -meta import Strata.DL.SMT.SMT +meta import Strata.DL.SMT import Init.Data.String.Extra meta section diff --git a/StrataTest/DL/Lambda/ReflectTests.lean b/StrataTest/DL/Lambda/ReflectTests.lean index f8b1aca928..a5dbfde8a0 100644 --- a/StrataTest/DL/Lambda/ReflectTests.lean +++ b/StrataTest/DL/Lambda/ReflectTests.lean @@ -5,7 +5,9 @@ -/ module -public import Strata.DL.Lambda.Reflect +public import Strata.DL.Lambda.Reflect -- shake: keep +import Lean.Elab.Term.TermElabM +meta import Lean.Meta.Eval /-! ## Tests for Reflect -/ diff --git a/StrataTest/DL/Lambda/TestGen.lean b/StrataTest/DL/Lambda/TestGen.lean index 4e13507279..5844cc7489 100644 --- a/StrataTest/DL/Lambda/TestGen.lean +++ b/StrataTest/DL/Lambda/TestGen.lean @@ -22,9 +22,11 @@ import all Strata.DL.Lambda.LTy public meta import Strata.DL.Lambda.LExprTypeEnv public meta import Strata.DL.Lambda.LExprWF public meta import Strata.DL.Lambda.MetaData - public import StrataTest.DL.Lambda.PlausibleHelpers +import Strata.DL.Lambda.LState +import Strata.DL.Lambda.LExprEval + -- -- Add these if depending on Chamelean for instance generation. -- import Plausible.Chamelean.ArbitrarySizedSuchThat -- import Plausible.Chamelean.DecOpt diff --git a/StrataTest/Languages/B3/DDMFormatTests.lean b/StrataTest/Languages/B3/DDMFormatTests.lean index 3aeed71384..8234abceee 100644 --- a/StrataTest/Languages/B3/DDMFormatTests.lean +++ b/StrataTest/Languages/B3/DDMFormatTests.lean @@ -8,6 +8,7 @@ module meta import Strata.Languages.B3.DDMTransform.ParseCST meta import Strata.Languages.B3.DDMTransform.DefinitionAST meta import Strata.Languages.B3.DDMTransform.Conversion +import Strata.DDM.Integration.Lean.HashCommands meta section diff --git a/StrataTest/Languages/B3/Verifier/TranslationTests.lean b/StrataTest/Languages/B3/Verifier/TranslationTests.lean index f1f9322eed..f7984f32ec 100644 --- a/StrataTest/Languages/B3/Verifier/TranslationTests.lean +++ b/StrataTest/Languages/B3/Verifier/TranslationTests.lean @@ -5,6 +5,7 @@ -/ module +import Strata.DDM.Integration.Lean.HashCommands meta import Strata.Languages.B3.Verifier meta import Strata.Languages.B3.DDMTransform.ParseCST meta import Strata.Languages.B3.DDMTransform.Conversion diff --git a/StrataTest/Languages/B3/Verifier/VerifierTests.lean b/StrataTest/Languages/B3/Verifier/VerifierTests.lean index 6a12863d46..bebe456d7a 100644 --- a/StrataTest/Languages/B3/Verifier/VerifierTests.lean +++ b/StrataTest/Languages/B3/Verifier/VerifierTests.lean @@ -5,6 +5,8 @@ -/ module +import Strata.DDM.Format +import Strata.DDM.Integration.Lean.HashCommands meta import Strata.Languages.B3.Verifier meta import Strata.Languages.B3.DDMTransform.ParseCST meta import Strata.Languages.B3.DDMTransform.Conversion diff --git a/StrataTest/Languages/C_Simp/Examples/Coprime.lean b/StrataTest/Languages/C_Simp/Examples/Coprime.lean index b5918a4340..b5e91ac691 100644 --- a/StrataTest/Languages/C_Simp/Examples/Coprime.lean +++ b/StrataTest/Languages/C_Simp/Examples/Coprime.lean @@ -5,7 +5,6 @@ -/ module -meta import all Strata.Languages.C_Simp.C_Simp meta import all Strata.Languages.C_Simp.Verify import Strata.DDM.Integration.Lean.HashCommands @@ -79,7 +78,7 @@ info: function coprime { while (~Int.Gt i #1) (some i) - [[coprime_invariant_475_492]: #true] + [[coprime_invariant_428_445]: #true] { if (~Bool.And ((~Int.Mod b i) == #0) ((~Int.Mod a i) == #0)) { return := #false diff --git a/StrataTest/Languages/Core/Examples/DDMAxiomsExtraction.lean b/StrataTest/Languages/Core/Examples/DDMAxiomsExtraction.lean index 07d43d5b15..cafb7d7167 100644 --- a/StrataTest/Languages/Core/Examples/DDMAxiomsExtraction.lean +++ b/StrataTest/Languages/Core/Examples/DDMAxiomsExtraction.lean @@ -7,7 +7,7 @@ module meta import Strata.Languages.Core.Verifier - +import Strata.DDM.Integration.Lean.HashCommands meta section @@ -97,307 +97,6 @@ axiom [updatePreserves]: forall m : (Map v k), okk : k, kk : k, vv : v :: (m[kk: #guard_msgs in #eval IO.println examplePgm -/-- -info: #[{ ann := { start := { byteIdx := 323 }, stop := { byteIdx := 330 } }, - name := { dialect := "Core", name := "command_typedecl" }, - args := - ((Array.mkEmpty 2).push (ArgF.ident { start := { byteIdx := 328 }, stop := { byteIdx := 329 } } "k")).push - (ArgF.option { start := { byteIdx := 329 }, stop := { byteIdx := 329 } } none) }, - { ann := { start := { byteIdx := 331 }, stop := { byteIdx := 338 } }, - name := { dialect := "Core", name := "command_typedecl" }, - args := - ((Array.mkEmpty 2).push (ArgF.ident { start := { byteIdx := 336 }, stop := { byteIdx := 337 } } "v")).push - (ArgF.option { start := { byteIdx := 337 }, stop := { byteIdx := 337 } } none) }, - { ann := { start := { byteIdx := 339 }, stop := { byteIdx := 418 } }, - name := { dialect := "Core", name := "command_axiom" }, - args := - ((Array.mkEmpty 2).push - (ArgF.option { start := { byteIdx := 345 }, stop := { byteIdx := 360 } } - (some - (ArgF.op - { ann := { start := { byteIdx := 345 }, stop := { byteIdx := 360 } }, - name := { dialect := "Core", name := "label" }, - args := - (Array.mkEmpty 1).push - (ArgF.ident { start := { byteIdx := 346 }, stop := { byteIdx := 358 } } - "updateSelect") })))).push - (ArgF.expr - (ExprF.app { start := { byteIdx := 361 }, stop := { byteIdx := 417 } } - (ExprF.app { start := { byteIdx := 361 }, stop := { byteIdx := 417 } } - (ExprF.fn { start := { byteIdx := 361 }, stop := { byteIdx := 417 } } - { dialect := "Core", name := "forall" }) - (ArgF.op - { ann := { start := { byteIdx := 368 }, stop := { byteIdx := 392 } }, - name := { dialect := "Core", name := "declPush" }, - args := - ((Array.mkEmpty 2).push - (ArgF.op - { ann := { start := { byteIdx := 368 }, stop := { byteIdx := 385 } }, - name := { dialect := "Core", name := "declPush" }, - args := - ((Array.mkEmpty 2).push - (ArgF.op - { ann := { start := { byteIdx := 368 }, stop := { byteIdx := 378 } }, - name := { dialect := "Core", name := "declAtom" }, - args := - (Array.mkEmpty 1).push - (ArgF.op - { ann := { start := { byteIdx := 368 }, stop := { byteIdx := 378 } }, - name := { dialect := "Core", name := "bind_mk" }, - args := - (((Array.mkEmpty 3).push - (ArgF.ident - { start := { byteIdx := 368 }, - stop := { byteIdx := 369 } } - "m")).push - (ArgF.option - { start := { byteIdx := 371 }, stop := { byteIdx := 371 } } - none)).push - (ArgF.type - (TypeExprF.ident - { start := { byteIdx := 371 }, stop := { byteIdx := 374 } } - { dialect := "Core", name := "Map" } - (((Array.mkEmpty 2).push - (TypeExprF.fvar - { start := { byteIdx := 377 }, - stop := { byteIdx := 378 } } - 1 (Array.mkEmpty 0))).push - (TypeExprF.fvar - { start := { byteIdx := 375 }, - stop := { byteIdx := 376 } } - 0 (Array.mkEmpty 0))))) }) })).push - (ArgF.op - { ann := { start := { byteIdx := 380 }, stop := { byteIdx := 385 } }, - name := { dialect := "Core", name := "bind_mk" }, - args := - (((Array.mkEmpty 3).push - (ArgF.ident - { start := { byteIdx := 380 }, stop := { byteIdx := 382 } } - "kk")).push - (ArgF.option { start := { byteIdx := 384 }, stop := { byteIdx := 384 } } - none)).push - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 384 }, stop := { byteIdx := 385 } } - 0 (Array.mkEmpty 0))) }) })).push - (ArgF.op - { ann := { start := { byteIdx := 387 }, stop := { byteIdx := 392 } }, - name := { dialect := "Core", name := "bind_mk" }, - args := - (((Array.mkEmpty 3).push - (ArgF.ident { start := { byteIdx := 387 }, stop := { byteIdx := 389 } } - "vv")).push - (ArgF.option { start := { byteIdx := 391 }, stop := { byteIdx := 391 } } none)).push - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 391 }, stop := { byteIdx := 392 } } 1 - (Array.mkEmpty 0))) }) })) - (ArgF.expr - (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 417 } } - (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 417 } } - (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 417 } } - (ExprF.fn { start := { byteIdx := 396 }, stop := { byteIdx := 417 } } - { dialect := "Core", name := "equal" }) - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 377 }, stop := { byteIdx := 378 } } 1 (Array.mkEmpty 0)))) - (ArgF.expr - (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 411 } } - (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 411 } } - (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 411 } } - (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 411 } } - (ExprF.fn { start := { byteIdx := 396 }, stop := { byteIdx := 411 } } - { dialect := "Core", name := "map_get" }) - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 375 }, stop := { byteIdx := 376 } } 0 - (Array.mkEmpty 0)))) - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 377 }, stop := { byteIdx := 378 } } 1 - (Array.mkEmpty 0)))) - (ArgF.expr - (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 407 } } - (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 407 } } - (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 407 } } - (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 407 } } - (ExprF.app { start := { byteIdx := 396 }, stop := { byteIdx := 407 } } - (ExprF.fn { start := { byteIdx := 396 }, stop := { byteIdx := 407 } } - { dialect := "Core", name := "map_set" }) - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 375 }, stop := { byteIdx := 376 } } 0 - (Array.mkEmpty 0)))) - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 377 }, stop := { byteIdx := 378 } } 1 - (Array.mkEmpty 0)))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 396 }, stop := { byteIdx := 397 } } 2))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 398 }, stop := { byteIdx := 400 } } 1))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 404 }, stop := { byteIdx := 406 } } 0))))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 408 }, stop := { byteIdx := 410 } } 1))))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 415 }, stop := { byteIdx := 417 } } 0)))))) }, - { ann := { start := { byteIdx := 419 }, stop := { byteIdx := 514 } }, - name := { dialect := "Core", name := "command_axiom" }, - args := - ((Array.mkEmpty 2).push - (ArgF.option { start := { byteIdx := 425 }, stop := { byteIdx := 443 } } - (some - (ArgF.op - { ann := { start := { byteIdx := 425 }, stop := { byteIdx := 443 } }, - name := { dialect := "Core", name := "label" }, - args := - (Array.mkEmpty 1).push - (ArgF.ident { start := { byteIdx := 426 }, stop := { byteIdx := 441 } } - "updatePreserves") })))).push - (ArgF.expr - (ExprF.app { start := { byteIdx := 444 }, stop := { byteIdx := 513 } } - (ExprF.app { start := { byteIdx := 444 }, stop := { byteIdx := 513 } } - (ExprF.fn { start := { byteIdx := 444 }, stop := { byteIdx := 513 } } - { dialect := "Core", name := "forall" }) - (ArgF.op - { ann := { start := { byteIdx := 451 }, stop := { byteIdx := 483 } }, - name := { dialect := "Core", name := "declPush" }, - args := - ((Array.mkEmpty 2).push - (ArgF.op - { ann := { start := { byteIdx := 451 }, stop := { byteIdx := 476 } }, - name := { dialect := "Core", name := "declPush" }, - args := - ((Array.mkEmpty 2).push - (ArgF.op - { ann := { start := { byteIdx := 451 }, stop := { byteIdx := 469 } }, - name := { dialect := "Core", name := "declPush" }, - args := - ((Array.mkEmpty 2).push - (ArgF.op - { - ann := - { start := { byteIdx := 451 }, stop := { byteIdx := 461 } }, - name := { dialect := "Core", name := "declAtom" }, - args := - (Array.mkEmpty 1).push - (ArgF.op - { - ann := - { start := { byteIdx := 451 }, - stop := { byteIdx := 461 } }, - name := { dialect := "Core", name := "bind_mk" }, - args := - (((Array.mkEmpty 3).push - (ArgF.ident - { start := { byteIdx := 451 }, - stop := { byteIdx := 452 } } - "m")).push - (ArgF.option - { start := { byteIdx := 454 }, - stop := { byteIdx := 454 } } - none)).push - (ArgF.type - (TypeExprF.ident - { start := { byteIdx := 454 }, - stop := { byteIdx := 457 } } - { dialect := "Core", name := "Map" } - (((Array.mkEmpty 2).push - (TypeExprF.fvar - { start := { byteIdx := 460 }, - stop := { byteIdx := 461 } } - 1 (Array.mkEmpty 0))).push - (TypeExprF.fvar - { start := { byteIdx := 458 }, - stop := { byteIdx := 459 } } - 0 (Array.mkEmpty 0))))) }) })).push - (ArgF.op - { ann := { start := { byteIdx := 463 }, stop := { byteIdx := 469 } }, - name := { dialect := "Core", name := "bind_mk" }, - args := - (((Array.mkEmpty 3).push - (ArgF.ident - { start := { byteIdx := 463 }, - stop := { byteIdx := 466 } } - "okk")).push - (ArgF.option - { start := { byteIdx := 468 }, stop := { byteIdx := 468 } } - none)).push - (ArgF.type - (TypeExprF.fvar - { start := { byteIdx := 468 }, stop := { byteIdx := 469 } } 0 - (Array.mkEmpty 0))) }) })).push - (ArgF.op - { ann := { start := { byteIdx := 471 }, stop := { byteIdx := 476 } }, - name := { dialect := "Core", name := "bind_mk" }, - args := - (((Array.mkEmpty 3).push - (ArgF.ident - { start := { byteIdx := 471 }, stop := { byteIdx := 473 } } - "kk")).push - (ArgF.option { start := { byteIdx := 475 }, stop := { byteIdx := 475 } } - none)).push - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 475 }, stop := { byteIdx := 476 } } - 0 (Array.mkEmpty 0))) }) })).push - (ArgF.op - { ann := { start := { byteIdx := 478 }, stop := { byteIdx := 483 } }, - name := { dialect := "Core", name := "bind_mk" }, - args := - (((Array.mkEmpty 3).push - (ArgF.ident { start := { byteIdx := 478 }, stop := { byteIdx := 480 } } - "vv")).push - (ArgF.option { start := { byteIdx := 482 }, stop := { byteIdx := 482 } } none)).push - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 482 }, stop := { byteIdx := 483 } } 1 - (Array.mkEmpty 0))) }) })) - (ArgF.expr - (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 513 } } - (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 513 } } - (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 513 } } - (ExprF.fn { start := { byteIdx := 487 }, stop := { byteIdx := 513 } } - { dialect := "Core", name := "equal" }) - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 460 }, stop := { byteIdx := 461 } } 1 (Array.mkEmpty 0)))) - (ArgF.expr - (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 503 } } - (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 503 } } - (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 503 } } - (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 503 } } - (ExprF.fn { start := { byteIdx := 487 }, stop := { byteIdx := 503 } } - { dialect := "Core", name := "map_get" }) - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 458 }, stop := { byteIdx := 459 } } 0 - (Array.mkEmpty 0)))) - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 460 }, stop := { byteIdx := 461 } } 1 - (Array.mkEmpty 0)))) - (ArgF.expr - (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 498 } } - (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 498 } } - (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 498 } } - (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 498 } } - (ExprF.app { start := { byteIdx := 487 }, stop := { byteIdx := 498 } } - (ExprF.fn { start := { byteIdx := 487 }, stop := { byteIdx := 498 } } - { dialect := "Core", name := "map_set" }) - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 458 }, stop := { byteIdx := 459 } } 0 - (Array.mkEmpty 0)))) - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 460 }, stop := { byteIdx := 461 } } 1 - (Array.mkEmpty 0)))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 487 }, stop := { byteIdx := 488 } } 3))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 489 }, stop := { byteIdx := 491 } } 1))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 495 }, stop := { byteIdx := 497 } } 0))))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 499 }, stop := { byteIdx := 502 } } 2))))) - (ArgF.expr - (ExprF.app { start := { byteIdx := 507 }, stop := { byteIdx := 513 } } - (ExprF.app { start := { byteIdx := 507 }, stop := { byteIdx := 513 } } - (ExprF.app { start := { byteIdx := 507 }, stop := { byteIdx := 513 } } - (ExprF.app { start := { byteIdx := 507 }, stop := { byteIdx := 513 } } - (ExprF.fn { start := { byteIdx := 507 }, stop := { byteIdx := 513 } } - { dialect := "Core", name := "map_get" }) - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 458 }, stop := { byteIdx := 459 } } 0 - (Array.mkEmpty 0)))) - (ArgF.type - (TypeExprF.fvar { start := { byteIdx := 460 }, stop := { byteIdx := 461 } } 1 - (Array.mkEmpty 0)))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 507 }, stop := { byteIdx := 508 } } 3))) - (ArgF.expr (ExprF.bvar { start := { byteIdx := 509 }, stop := { byteIdx := 512 } } 2)))))))) }] --/ -#guard_msgs in -#eval examplePgm.commands - /-- info: [LExpr.quant () QuantifierKind.all "m" (some Lambda.LMonoTy.tcons "Map" diff --git a/StrataTest/Languages/Core/Examples/Loops.lean b/StrataTest/Languages/Core/Examples/Loops.lean index 108bbc6fe1..d7bf172e33 100644 --- a/StrataTest/Languages/Core/Examples/Loops.lean +++ b/StrataTest/Languages/Core/Examples/Loops.lean @@ -16,6 +16,7 @@ public import Strata.DL.Imperative.BasicBlock public import Strata.Languages.Core.Statement public import Strata.Languages.Core.Expressions import Strata.DDM.Integration.Lean.HashCommands +import Strata.Languages.Core.StatementSemantics public section namespace Strata diff --git a/StrataTest/Languages/Core/Examples/SubstFvarsCaptureTests.lean b/StrataTest/Languages/Core/Examples/SubstFvarsCaptureTests.lean index cfa0c3b8cc..e97d04b40e 100644 --- a/StrataTest/Languages/Core/Examples/SubstFvarsCaptureTests.lean +++ b/StrataTest/Languages/Core/Examples/SubstFvarsCaptureTests.lean @@ -8,6 +8,7 @@ module meta import Strata.Languages.Core.Verifier meta import Strata.DL.Lambda.Preconditions import Strata.DDM.Integration.Lean.HashCommands +import Strata.Languages.Core.StatementEval meta section /-! # Simultaneous substitution tests (Issue 653) diff --git a/StrataTest/Languages/Core/Examples/TypeDecl.lean b/StrataTest/Languages/Core/Examples/TypeDecl.lean index 74cd11640e..3f6418775f 100644 --- a/StrataTest/Languages/Core/Examples/TypeDecl.lean +++ b/StrataTest/Languages/Core/Examples/TypeDecl.lean @@ -6,6 +6,7 @@ module meta import Strata.Languages.Core.Verifier +import Strata.Languages.Core.DDMTransform.Translate import Strata.DDM.Integration.Lean.HashCommands meta section diff --git a/StrataTest/Languages/Core/Tests/CmdEvalTests.lean b/StrataTest/Languages/Core/Tests/CmdEvalTests.lean index 58440d69ec..eca4199ad5 100644 --- a/StrataTest/Languages/Core/Tests/CmdEvalTests.lean +++ b/StrataTest/Languages/Core/Tests/CmdEvalTests.lean @@ -6,6 +6,7 @@ module meta import Strata.Languages.Core.CmdEval +import Strata.DL.Imperative meta section diff --git a/StrataTest/Languages/Core/Tests/ProcedureTypeTests.lean b/StrataTest/Languages/Core/Tests/ProcedureTypeTests.lean index 67444694a6..df69055dae 100644 --- a/StrataTest/Languages/Core/Tests/ProcedureTypeTests.lean +++ b/StrataTest/Languages/Core/Tests/ProcedureTypeTests.lean @@ -6,6 +6,7 @@ module meta import Strata.Languages.Core.ProcedureType +import Strata.Languages.Core.Factory meta section diff --git a/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean b/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean index edff99d601..2977a8de55 100644 --- a/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean +++ b/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean @@ -6,6 +6,7 @@ module meta import Strata.Languages.Core.Verifier +meta import Strata.Languages.Core.ProcedureEval meta import Strata.Languages.Core.StatementEval import Strata.DDM.Integration.Lean.HashCommands @@ -404,7 +405,7 @@ Proof Obligation: -/ #guard_msgs in #eval do let E := Env.init - let (E, _stats) := eval E + let (E, _stats) := Core.Procedure.eval E { header := {name := "P", typeArgs := [], inputs := [("x", mty[int])], diff --git a/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean b/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean index 69f3c0d53c..6951a03949 100644 --- a/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean +++ b/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean @@ -12,8 +12,7 @@ Laurel programs by comparing the output against expected results. meta import Strata.DDM.Elab meta import Strata.DDM.BuiltinDialects.Init -meta import Strata.Languages.Laurel.Grammar.LaurelGrammar -meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.Grammar meta import Strata.Languages.Laurel.ConstrainedTypeElim meta import Strata.Languages.Laurel.Resolution diff --git a/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean b/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean index a771d0207d..7838a9d83a 100644 --- a/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean +++ b/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean @@ -13,9 +13,9 @@ by comparing the lifted Laurel against expected output. meta import Strata.DDM.Elab meta import Strata.DDM.BuiltinDialects.Init -meta import Strata.Languages.Laurel.Grammar.LaurelGrammar -meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.Grammar meta import Strata.Languages.Laurel.LaurelToCoreTranslator +meta import Strata.Languages.Laurel.LiftImperativeExpressions meta section diff --git a/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean b/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean index f267f79373..82a5109813 100644 --- a/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean +++ b/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean @@ -13,9 +13,9 @@ out of assert and assume conditions, while leaving assignments untouched meta import Strata.DDM.Elab meta import Strata.DDM.BuiltinDialects.Init -meta import Strata.Languages.Laurel.Grammar.LaurelGrammar -meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.Grammar meta import Strata.Languages.Laurel.LaurelToCoreTranslator +meta import Strata.Languages.Laurel.LiftImperativeExpressions meta section diff --git a/StrataTest/Languages/Laurel/TypeAliasElimTest.lean b/StrataTest/Languages/Laurel/TypeAliasElimTest.lean index c1e98d3622..f6c4ff5ae6 100644 --- a/StrataTest/Languages/Laurel/TypeAliasElimTest.lean +++ b/StrataTest/Languages/Laurel/TypeAliasElimTest.lean @@ -18,6 +18,7 @@ meta import Strata.DDM.Elab meta import Strata.DDM.BuiltinDialects.Init meta import Strata.Languages.Laurel.Grammar.LaurelGrammar meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator +meta import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator meta import Strata.Languages.Laurel.TypeAliasElim meta import Strata.Languages.Laurel.Resolution @@ -66,7 +67,7 @@ info: procedure test(x: int) return x; -/ #guard_msgs in -#eval! do +#eval do let result := resolveAndElim chainedProgram printProcs result.staticProcedures @@ -128,7 +129,7 @@ info: procedure compute(a: int, b: bool) return a; -/ #guard_msgs in -#eval! do +#eval do let result := resolveAndElim procSigProgram printProcs result.staticProcedures diff --git a/StrataTest/Languages/Python/PySpecArgTypeTest.lean b/StrataTest/Languages/Python/PySpecArgTypeTest.lean index ebe28f0b47..db6fd6daef 100644 --- a/StrataTest/Languages/Python/PySpecArgTypeTest.lean +++ b/StrataTest/Languages/Python/PySpecArgTypeTest.lean @@ -7,6 +7,7 @@ module meta import all Strata.Languages.Python.PySpecPipeline meta import all Strata.Languages.Python.Specs.DDM +import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator meta section diff --git a/StrataTest/Transform/ANFEncoderTests.lean b/StrataTest/Transform/ANFEncoderTests.lean index 536c93b92e..11323c5ac3 100644 --- a/StrataTest/Transform/ANFEncoderTests.lean +++ b/StrataTest/Transform/ANFEncoderTests.lean @@ -7,8 +7,10 @@ module meta import Strata.Transform.ANFEncoder meta import Strata.Languages.Core.DDMTransform.Translate +meta import Strata.Languages.Core.DDMTransform.ASTtoCST import Strata.DDM.Integration.Lean.HashCommands + meta section namespace Core.ANFEncoder.Tests From 349b1cf4915d3d9357b8de7edcc94d3b9a79f0b5 Mon Sep 17 00:00:00 2001 From: Aaron Tomb Date: Fri, 22 May 2026 08:33:11 -0700 Subject: [PATCH 28/28] Move Boole dialect to the StrataBoole package (#1210) # Move Boole dialect to standalone package Extract the Boole dialect into its own `StrataBoole` Lake package with a dependency on the main `Strata` package. This enables faster incremental builds for Boole-specific work and cleaner separation of concerns. ## Changes - Move `Strata/Languages/Boole/` source files to `StrataBoole/StrataBoole/` - Move Boole test files to `StrataBoole/StrataBooleTest/` - Create `StrataBoole/lakefile.toml` with `Strata` as a dependency - Add `StrataBoole/StrataBooleTest.lean` root module importing all test files - Fix `MetaVerifier.lean` to add required meta imports (`Lean.Meta.Eval`, `Lean.Meta.Tactic.Rewrite`, `Lean.Meta.Tactic.Unfold`) and define `genSMTVCsBoole` as a standalone function for the tactic infrastructure - Update all test imports from `Strata.Languages.Boole.*` to `StrataBoole.*` - Update `#guard_msgs` expected output to reflect shifted source positions - Add CI workflow step for building the `StrataBoole` package - Remove Boole-specific code from the main `Strata` package (`Strata.lean`, `MetaVerifier.lean`, `StrataMainLib.lean`) --- .github/workflows/ci.yml | 3 + Strata.lean | 2 - Strata/MetaVerifier.lean | 18 +-- StrataBoole/.gitignore | 1 + StrataBoole/StrataBoole.lean | 9 ++ .../StrataBoole}/Boole.lean | 2 +- .../StrataBoole}/Grammar.lean | 0 StrataBoole/StrataBoole/MetaVerifier.lean | 118 ++++++++++++++++++ .../StrataBoole}/Verify.lean | 2 +- StrataBoole/StrataBooleTest.lean | 46 +++++++ .../abstract_types_and_stubs.lean | 6 +- .../FeatureRequests/bitvector_ops.lean | 14 +-- .../FeatureRequests/bitvector_proof_mode.lean | 2 +- .../FeatureRequests/choose_operator.lean | 14 ++- .../datatypes_and_selectors.lean | 20 +-- .../FeatureRequests/decreases_metadata.lean | 14 ++- .../FeatureRequests/early_return.lean | 11 +- .../higher_order_encoding.lean | 14 ++- .../FeatureRequests/horner_poly_eval.lean | 6 +- .../FeatureRequests/lambda_closure.lean | 6 +- .../FeatureRequests/map_extensionality.lean | 8 +- .../FeatureRequests/mutual_recursion.lean | 6 +- .../FeatureRequests/nat_int_boundary.lean | 6 +- .../FeatureRequests/opaque_reveal_hide.lean | 6 +- .../FeatureRequests/option_matches.lean | 2 +- .../FeatureRequests/overflow_guard.lean | 18 +-- .../FeatureRequests/reveal_with_fuel.lean | 6 +- .../FeatureRequests/seq_slicing.lean | 2 +- .../FeatureRequests/struct_field_access.lean | 2 +- .../FeatureRequests/trait_spec_methods.lean | 2 +- .../FeatureRequests/widening_casts.lean | 6 +- .../StrataBooleTest}/array_2d.lean | 6 +- .../StrataBooleTest}/array_assignment.lean | 6 +- .../StrataBooleTest}/bit_vectors.lean | 6 +- .../StrataBooleTest}/code_expression.lean | 6 +- .../StrataBooleTest}/demo.lean | 10 +- .../StrataBooleTest}/deterministic.lean | 16 +-- .../StrataBooleTest}/find_max.lean | 15 ++- .../StrataBooleTest}/find_max_verus.lean | 24 ++-- .../StrataBooleTest}/format_program.lean | 2 +- .../function_definitions.lean | 13 +- .../global_readonly_call.lean | 26 ++-- .../StrataBooleTest}/grammar_extensions.lean | 6 +- .../StrataBooleTest}/insertion_sort.lean | 6 +- .../StrataBooleTest}/loop_simple.lean | 6 +- .../procedure_signatures.lean | 2 +- .../square_matrix_multiply.lean | 6 +- .../StrataBooleTest}/stack_array_based.lean | 56 ++++----- .../StrataBooleTest}/string_operators.lean | 32 ++--- .../top_level_block_selection.lean | 6 +- .../verification_coverage.lean | 46 +++---- StrataBoole/lake-manifest.json | 22 ++++ StrataBoole/lakefile.toml | 13 ++ StrataBoole/lean-toolchain | 1 + StrataMainLib.lean | 10 +- 55 files changed, 467 insertions(+), 247 deletions(-) create mode 100644 StrataBoole/.gitignore create mode 100644 StrataBoole/StrataBoole.lean rename {Strata/Languages/Boole => StrataBoole/StrataBoole}/Boole.lean (89%) rename {Strata/Languages/Boole => StrataBoole/StrataBoole}/Grammar.lean (100%) create mode 100644 StrataBoole/StrataBoole/MetaVerifier.lean rename {Strata/Languages/Boole => StrataBoole/StrataBoole}/Verify.lean (99%) create mode 100644 StrataBoole/StrataBooleTest.lean rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/abstract_types_and_stubs.lean (93%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/bitvector_ops.lean (92%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/bitvector_proof_mode.lean (97%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/choose_operator.lean (87%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/datatypes_and_selectors.lean (83%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/decreases_metadata.lean (90%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/early_return.lean (86%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/higher_order_encoding.lean (86%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/horner_poly_eval.lean (92%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/lambda_closure.lean (90%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/map_extensionality.lean (95%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/mutual_recursion.lean (95%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/nat_int_boundary.lean (92%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/opaque_reveal_hide.lean (94%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/option_matches.lean (98%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/overflow_guard.lean (83%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/reveal_with_fuel.lean (94%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/seq_slicing.lean (97%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/struct_field_access.lean (98%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/trait_spec_methods.lean (98%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/FeatureRequests/widening_casts.lean (92%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/array_2d.lean (78%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/array_assignment.lean (83%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/bit_vectors.lean (83%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/code_expression.lean (93%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/demo.lean (93%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/deterministic.lean (78%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/find_max.lean (79%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/find_max_verus.lean (87%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/format_program.lean (97%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/function_definitions.lean (74%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/global_readonly_call.lean (87%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/grammar_extensions.lean (92%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/insertion_sort.lean (90%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/loop_simple.lean (87%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/procedure_signatures.lean (99%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/square_matrix_multiply.lean (94%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/stack_array_based.lean (82%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/string_operators.lean (89%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/top_level_block_selection.lean (83%) rename {StrataTest/Languages/Boole => StrataBoole/StrataBooleTest}/verification_coverage.lean (86%) create mode 100644 StrataBoole/lake-manifest.json create mode 100644 StrataBoole/lakefile.toml create mode 100644 StrataBoole/lean-toolchain diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 6fc9cc26de..b4b3879a73 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -65,6 +65,9 @@ jobs: git diff --exit-code editors/vscode/syntaxes/ editors/emacs/ - name: Build and run strata verify run: lake exe strata verify Examples/SimpleProc.core.st + - name: Build StrataBoole + run: lake build StrataBoole StrataBooleTest + working-directory: StrataBoole - name: Build BoogieToStrata run: dotnet build -warnaserror ${SOLUTION} - name: Test BoogieToStrata diff --git a/Strata.lean b/Strata.lean index e1428c20c5..1d73306335 100644 --- a/Strata.lean +++ b/Strata.lean @@ -38,8 +38,6 @@ import Strata.Transform.Specification /- Strata Languages — additional -/ import Strata.Languages.B3 -import Strata.Languages.Boole.Boole -import Strata.Languages.Boole.Verify import Strata.Languages.C_Simp.C_Simp import Strata.Languages.C_Simp.Verify import Strata.Languages.Core.EntryPoint diff --git a/Strata/MetaVerifier.lean b/Strata/MetaVerifier.lean index 910831d9a4..9e5002df34 100644 --- a/Strata/MetaVerifier.lean +++ b/Strata/MetaVerifier.lean @@ -7,13 +7,11 @@ module import Strata.Transform.LoopElim import Strata.Languages.Core.ObligationExtraction -public import Strata.Languages.Boole.Boole public import Strata.Languages.C_Simp.C_Simp public import Strata.Languages.Core.SMTEncoder import Std.Tactic.BVDecide.Normalize.Prop import Strata.DL.Lambda.Denote.LExprAnnotated import Strata.DL.SMT.Denote -import Strata.Languages.Boole.Verify import Strata.Languages.C_Simp.DDMTransform.Translate import Strata.Languages.C_Simp.Verify import Strata.Languages.Core.Core @@ -98,19 +96,14 @@ def genVCs (program : Strata.C_Simp.Program) (options : Core.VerifyOptions := .d end C_Simp -namespace Boole - -def genVCs (program : Strata.Boole.Program) (gctx : Strata.GlobalContext) (options : Core.VerifyOptions := .default) : Option Core.coreVCs := do - let program ← (Strata.Boole.toCoreProgram program gctx).toOption - Core.genVCs program options - -end Boole - namespace Strata /-- Generate verification conditions for a `Strata.Program` by translating it to the appropriate frontend verifier and collecting its deferred proof obligations. + +Note that this can be extended to new dialects by using +`unsafe/@[implemented_by]` as in `StrataBoole.MetaVerifier`. -/ def genCoreVCs (program : Program) : Option Core.coreVCs := do if program.dialect == "Core" then @@ -119,11 +112,6 @@ def genCoreVCs (program : Program) : Option Core.coreVCs := do else if program.dialect == "C_Simp" then let (program, #[]) := C_Simp.TransM.run default (C_Simp.translateProgram program.commands) | none C_Simp.genVCs program { (default : Core.VerifyOptions) with verbose := .quiet : Core.VerifyOptions } - else if program.dialect == "Boole" then - match Boole.getProgram program with - | .ok booleProgram => - Boole.genVCs booleProgram program.globalContext { (default : Core.VerifyOptions) with verbose := .quiet : Core.VerifyOptions } - | .error _ => none else none diff --git a/StrataBoole/.gitignore b/StrataBoole/.gitignore new file mode 100644 index 0000000000..2b00952692 --- /dev/null +++ b/StrataBoole/.gitignore @@ -0,0 +1 @@ +.lake diff --git a/StrataBoole/StrataBoole.lean b/StrataBoole/StrataBoole.lean new file mode 100644 index 0000000000..be705c09df --- /dev/null +++ b/StrataBoole/StrataBoole.lean @@ -0,0 +1,9 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +import StrataBoole.Boole +import StrataBoole.Grammar +import StrataBoole.MetaVerifier +import StrataBoole.Verify diff --git a/Strata/Languages/Boole/Boole.lean b/StrataBoole/StrataBoole/Boole.lean similarity index 89% rename from Strata/Languages/Boole/Boole.lean rename to StrataBoole/StrataBoole/Boole.lean index e733208d2e..0734f4a729 100644 --- a/Strata/Languages/Boole/Boole.lean +++ b/StrataBoole/StrataBoole/Boole.lean @@ -5,7 +5,7 @@ -/ module -public import Strata.Languages.Boole.Grammar -- shake: keep +public import StrataBoole.Grammar -- shake: keep import Strata.DDM.Integration.Lean.Gen -- shake: keep public section diff --git a/Strata/Languages/Boole/Grammar.lean b/StrataBoole/StrataBoole/Grammar.lean similarity index 100% rename from Strata/Languages/Boole/Grammar.lean rename to StrataBoole/StrataBoole/Grammar.lean diff --git a/StrataBoole/StrataBoole/MetaVerifier.lean b/StrataBoole/StrataBoole/MetaVerifier.lean new file mode 100644 index 0000000000..38ad58cecb --- /dev/null +++ b/StrataBoole/StrataBoole/MetaVerifier.lean @@ -0,0 +1,118 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.MetaVerifier -- shake: keep +public import StrataBoole.Verify +meta import Lean.Meta.Eval +import Lean.Meta.Eval -- shake: keep +import Lean.Meta.Tactic.Rewrite -- shake: keep +meta import Lean.Meta.Tactic.Rewrite +import Lean.Meta.Tactic.Unfold -- shake: keep +meta import Lean.Meta.Tactic.Unfold + +/-! +# Boole MetaVerifier + +Extends `Strata.MetaVerifier` with Boole dialect support for `genCoreVCs` and +`smtVCsCorrect`. Test files in the `StrataBoole` package should import this +module instead of `Strata.MetaVerifier` directly. +-/ + +public section + +namespace Strata.Boole + +def genVCs (program : Strata.Boole.Program) (gctx : Strata.GlobalContext) (options : Core.VerifyOptions := .default) : Option Core.coreVCs := do + let program ← (Strata.Boole.toCoreProgram program gctx).toOption + Core.genVCs program options + +end Strata.Boole + +namespace Strata + +/-- +Generate verification conditions for a `Strata.Program`, with Boole support. +Extends `Strata.genCoreVCs` to handle the Boole dialect. +-/ +def genCoreVCsBoole (program : Program) : Option Core.coreVCs := do + if program.dialect == "Boole" then + match Boole.getProgram program with + | .ok booleProgram => + Boole.genVCs booleProgram program.globalContext { (default : Core.VerifyOptions) with verbose := .quiet : Core.VerifyOptions } + | .error _ => none + else + genCoreVCs program + +/-- +Generate SMT verification conditions for a `Strata.Program`, with Boole support. +-/ +def genSMTVCsBoole (program : Program) : Option SMT.SMTVCs := do + let coreVCs ← genCoreVCsBoole program + toSMTVCs coreVCs + +/-- +State semantic correctness of the SMT verification conditions generated for a +program, with Boole dialect support. +-/ +def smtVCsCorrectBoole (program : Program) : Prop := + match genSMTVCsBoole program with + | some vcs => (denoteQueries vcs).getD False + | none => False + +end Strata + +namespace Strata.Meta + +open Lean hiding Options + +private unsafe def genSMTVCsBooleUnsafe (mv : MVarId) : MetaM (List MVarId) := do + let type ← mv.getType + let some program := type.app1? ``Strata.smtVCsCorrectBoole | throwError "Expected a Strata.smtVCsCorrectBoole goal" + trace[debug] m!"Generating SMT VCs for {program}" + let mv ← Meta.unfoldTarget mv ``Strata.smtVCsCorrectBoole + let ovcs := .app (.const ``Strata.genSMTVCsBoole []) program + let ovcsType := .app (.const ``Option [0]) (.const ``Strata.SMT.SMTVCs []) + let some evcs ← Meta.evalExpr (Option Strata.SMT.SMTVCs) ovcsType ovcs + | throwError "Failed to generate VCs" + trace[debug] m!"Generated {repr evcs}" + let rhs := toExpr (some evcs) + let eqVCs := mkApp3 (.const ``Eq [1]) ovcsType ovcs rhs + let hEQVCs ← nativeDecide eqVCs + let r ← mv.rewrite (← mv.getType) hEQVCs + let mv ← mv.replaceTargetEq r.eNew r.eqProof + let mvs ← evcs.mapM SMT.createGoal + trace[debug] m!"Created {mvs.length} SMT VC goals: {mvs}" + let ps ← mvs.mapM MVarId.getType + let hP := andNIntro (List.zip ps (mvs.map Expr.mvar)) + mv.assign hP + return mvs + +@[implemented_by genSMTVCsBooleUnsafe] +meta opaque genSMTVCsBoole (mv : MVarId) : MetaM (List MVarId) + +end Strata.Meta + +namespace Strata.Tactic + +open Lean Elab Tactic in +/-- +Generate one Lean goal per SMT verification condition in a goal of the form +`Strata.smtVCsCorrectBoole program`. Boole-aware variant of `gen_smt_vcs`. +-/ +syntax (name := genSMTVCsBoole) "gen_smt_vcs_boole" : tactic + +open Lean Elab Tactic in +@[tactic genSMTVCsBoole] meta def evalGenSMTVCsBoole : Tactic := fun stx => do + match stx with + | `(tactic| gen_smt_vcs_boole) => + let mvs ← Meta.genSMTVCsBoole (← Tactic.getMainGoal) + Tactic.replaceMainGoal mvs + | _ => throwUnsupportedSyntax + +end Strata.Tactic + +end -- public section diff --git a/Strata/Languages/Boole/Verify.lean b/StrataBoole/StrataBoole/Verify.lean similarity index 99% rename from Strata/Languages/Boole/Verify.lean rename to StrataBoole/StrataBoole/Verify.lean index 911f096294..40536e4c62 100644 --- a/Strata/Languages/Boole/Verify.lean +++ b/StrataBoole/StrataBoole/Verify.lean @@ -5,7 +5,7 @@ -/ module -public import Strata.Languages.Boole.Boole +public import StrataBoole.Boole public import Strata.Languages.Core.Verifier import Strata.Languages.Core.Core import Strata.Util.Tactics diff --git a/StrataBoole/StrataBooleTest.lean b/StrataBoole/StrataBooleTest.lean new file mode 100644 index 0000000000..06eefaa8af --- /dev/null +++ b/StrataBoole/StrataBooleTest.lean @@ -0,0 +1,46 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +import StrataBooleTest.array_2d +import StrataBooleTest.array_assignment +import StrataBooleTest.bit_vectors +import StrataBooleTest.code_expression +import StrataBooleTest.demo +import StrataBooleTest.deterministic +import StrataBooleTest.find_max +import StrataBooleTest.find_max_verus +import StrataBooleTest.format_program +import StrataBooleTest.function_definitions +import StrataBooleTest.global_readonly_call +import StrataBooleTest.grammar_extensions +import StrataBooleTest.insertion_sort +import StrataBooleTest.loop_simple +import StrataBooleTest.procedure_signatures +import StrataBooleTest.square_matrix_multiply +import StrataBooleTest.stack_array_based +import StrataBooleTest.string_operators +import StrataBooleTest.top_level_block_selection +import StrataBooleTest.verification_coverage +import StrataBooleTest.FeatureRequests.abstract_types_and_stubs +import StrataBooleTest.FeatureRequests.bitvector_ops +import StrataBooleTest.FeatureRequests.bitvector_proof_mode +import StrataBooleTest.FeatureRequests.choose_operator +import StrataBooleTest.FeatureRequests.datatypes_and_selectors +import StrataBooleTest.FeatureRequests.decreases_metadata +import StrataBooleTest.FeatureRequests.early_return +import StrataBooleTest.FeatureRequests.higher_order_encoding +import StrataBooleTest.FeatureRequests.horner_poly_eval +import StrataBooleTest.FeatureRequests.lambda_closure +import StrataBooleTest.FeatureRequests.map_extensionality +import StrataBooleTest.FeatureRequests.mutual_recursion +import StrataBooleTest.FeatureRequests.nat_int_boundary +import StrataBooleTest.FeatureRequests.opaque_reveal_hide +import StrataBooleTest.FeatureRequests.option_matches +import StrataBooleTest.FeatureRequests.overflow_guard +import StrataBooleTest.FeatureRequests.reveal_with_fuel +import StrataBooleTest.FeatureRequests.seq_slicing +import StrataBooleTest.FeatureRequests.struct_field_access +import StrataBooleTest.FeatureRequests.trait_spec_methods +import StrataBooleTest.FeatureRequests.widening_casts diff --git a/StrataTest/Languages/Boole/FeatureRequests/abstract_types_and_stubs.lean b/StrataBoole/StrataBooleTest/FeatureRequests/abstract_types_and_stubs.lean similarity index 93% rename from StrataTest/Languages/Boole/FeatureRequests/abstract_types_and_stubs.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/abstract_types_and_stubs.lean index 803eca6087..39e6d22e1f 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/abstract_types_and_stubs.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/abstract_types_and_stubs.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -55,6 +55,6 @@ spec { #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" abstractTypesAndStubsSeed -example : Strata.smtVCsCorrect abstractTypesAndStubsSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole abstractTypesAndStubsSeed := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/FeatureRequests/bitvector_ops.lean b/StrataBoole/StrataBooleTest/FeatureRequests/bitvector_ops.lean similarity index 92% rename from StrataTest/Languages/Boole/FeatureRequests/bitvector_ops.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/bitvector_ops.lean index 2bb64eb7fd..3f8036cd64 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/bitvector_ops.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/bitvector_ops.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -46,8 +46,8 @@ spec { #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" bitvectorOpsSeed (options := .quiet) -example : Strata.smtVCsCorrect bitvectorOpsSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole bitvectorOpsSeed := by + gen_smt_vcs_boole all_goals (first | grind | decide) -- Exercises ~, ^, >>, << (bit extraction, conditional swap, nibble ops). @@ -81,8 +81,8 @@ spec { #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" bitvectorShiftXorSeed (options := .quiet) -example : Strata.smtVCsCorrect bitvectorShiftXorSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole bitvectorShiftXorSeed := by + gen_smt_vcs_boole all_goals (first | grind | decide) -- Exercises >>s (arithmetic/signed right shift): vacated bits are filled with @@ -107,6 +107,6 @@ spec { #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" bitvectorSShrSeed (options := .quiet) -example : Strata.smtVCsCorrect bitvectorSShrSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole bitvectorSShrSeed := by + gen_smt_vcs_boole all_goals (first | grind | decide) diff --git a/StrataTest/Languages/Boole/FeatureRequests/bitvector_proof_mode.lean b/StrataBoole/StrataBooleTest/FeatureRequests/bitvector_proof_mode.lean similarity index 97% rename from StrataTest/Languages/Boole/FeatureRequests/bitvector_proof_mode.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/bitvector_proof_mode.lean index 44219536b6..d1b7294095 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/bitvector_proof_mode.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/bitvector_proof_mode.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata diff --git a/StrataTest/Languages/Boole/FeatureRequests/choose_operator.lean b/StrataBoole/StrataBooleTest/FeatureRequests/choose_operator.lean similarity index 87% rename from StrataTest/Languages/Boole/FeatureRequests/choose_operator.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/choose_operator.lean index 52a7a0724e..cb3e1e9fcb 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/choose_operator.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/choose_operator.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -48,13 +48,15 @@ spec { }; #end -/-- info: -Obligation: choose_seed_ensures_1_1077 +/-- +info: +Obligation: choose_seed_ensures_1_1082 Property: assert -Result: ✅ pass-/ +Result: ✅ pass +-/ #guard_msgs in #eval Strata.Boole.verify "cvc5" chooseOperatorSeed (options :=.quiet) -example : Strata.smtVCsCorrect chooseOperatorSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole chooseOperatorSeed := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/FeatureRequests/datatypes_and_selectors.lean b/StrataBoole/StrataBooleTest/FeatureRequests/datatypes_and_selectors.lean similarity index 83% rename from StrataTest/Languages/Boole/FeatureRequests/datatypes_and_selectors.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/datatypes_and_selectors.lean index a2ad320a41..146321c578 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/datatypes_and_selectors.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/datatypes_and_selectors.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -48,16 +48,17 @@ spec { }; #end -/-- info: -Obligation: assert_1_1159 +/-- +info: +Obligation: assert_1_1164 Property: assert Result: ✅ pass -Obligation: assert_assert_2_1190_calls_OptionInt..val_0 +Obligation: assert_assert_2_1195_calls_OptionInt..val_0 Property: assert Result: ✅ pass -Obligation: assert_2_1190 +Obligation: assert_2_1195 Property: assert Result: ✅ pass @@ -65,12 +66,13 @@ Obligation: set_ok_calls_OptionInt..val_0 Property: assert Result: ✅ pass -Obligation: datatype_selector_seed_ensures_0_1103 +Obligation: datatype_selector_seed_ensures_0_1108 Property: assert -Result: ✅ pass-/ +Result: ✅ pass +-/ #guard_msgs in #eval Strata.Boole.verify "cvc5" datatypeSelectorsSeed (options := .quiet) -example : Strata.smtVCsCorrect datatypeSelectorsSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole datatypeSelectorsSeed := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/FeatureRequests/decreases_metadata.lean b/StrataBoole/StrataBooleTest/FeatureRequests/decreases_metadata.lean similarity index 90% rename from StrataTest/Languages/Boole/FeatureRequests/decreases_metadata.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/decreases_metadata.lean index dbb14255ab..66221dfb7d 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/decreases_metadata.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/decreases_metadata.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -57,7 +57,8 @@ spec { }; #end -/-- info: +/-- +info: Obligation: entry_invariant_0_0 Property: assert Result: ✅ pass @@ -74,12 +75,13 @@ Obligation: arbitrary_iter_maintain_invariant_0_1 Property: assert Result: ✅ pass -Obligation: loop_measure_seed_ensures_1_1174 +Obligation: loop_measure_seed_ensures_1_1179 Property: assert -Result: ✅ pass-/ +Result: ✅ pass +-/ #guard_msgs in #eval Strata.Boole.verify "cvc5" decreasesMetadataSeed (options:=.quiet) -example : Strata.smtVCsCorrect decreasesMetadataSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole decreasesMetadataSeed := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/FeatureRequests/early_return.lean b/StrataBoole/StrataBooleTest/FeatureRequests/early_return.lean similarity index 86% rename from StrataTest/Languages/Boole/FeatureRequests/early_return.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/early_return.lean index acef8f5b9e..03da210783 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/early_return.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/early_return.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -39,14 +39,15 @@ spec { }; #end -/-- info: -Obligation: abs_seed_ensures_0_797 +/-- +info: +Obligation: abs_seed_ensures_0_802 Property: assert Result: ✅ pass -/ #guard_msgs in #eval Strata.Boole.verify "cvc5" earlyReturnSeed (options := .quiet) -example : Strata.smtVCsCorrect earlyReturnSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole earlyReturnSeed := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/FeatureRequests/higher_order_encoding.lean b/StrataBoole/StrataBooleTest/FeatureRequests/higher_order_encoding.lean similarity index 86% rename from StrataTest/Languages/Boole/FeatureRequests/higher_order_encoding.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/higher_order_encoding.lean index ce9c2f9570..a229db44ea 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/higher_order_encoding.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/higher_order_encoding.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -42,13 +42,15 @@ spec { }; #end -/-- info: -Obligation: higher_order_seed_ensures_0_983 +/-- +info: +Obligation: higher_order_seed_ensures_0_988 Property: assert -Result: ✅ pass-/ +Result: ✅ pass +-/ #guard_msgs in #eval Strata.Boole.verify "cvc5" higherOrderSeed (options:=.quiet) -example : Strata.smtVCsCorrect higherOrderSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole higherOrderSeed := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/FeatureRequests/horner_poly_eval.lean b/StrataBoole/StrataBooleTest/FeatureRequests/horner_poly_eval.lean similarity index 92% rename from StrataTest/Languages/Boole/FeatureRequests/horner_poly_eval.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/horner_poly_eval.lean index c8a553b957..53b60e0b02 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/horner_poly_eval.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/horner_poly_eval.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier ------------------------------------------------------------ namespace Strata @@ -57,6 +57,6 @@ spec #guard_msgs in #eval Strata.Boole.verify "cvc5" hornerPgm (options := .quiet) -example : Strata.smtVCsCorrect hornerPgm := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole hornerPgm := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/FeatureRequests/lambda_closure.lean b/StrataBoole/StrataBooleTest/FeatureRequests/lambda_closure.lean similarity index 90% rename from StrataTest/Languages/Boole/FeatureRequests/lambda_closure.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/lambda_closure.lean index 4a131e5342..9d445ad559 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/lambda_closure.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/lambda_closure.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -54,6 +54,6 @@ procedure use_lambda() returns () #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" lambdaClosureSeed -example : Strata.smtVCsCorrect lambdaClosureSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole lambdaClosureSeed := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/FeatureRequests/map_extensionality.lean b/StrataBoole/StrataBooleTest/FeatureRequests/map_extensionality.lean similarity index 95% rename from StrataTest/Languages/Boole/FeatureRequests/map_extensionality.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/map_extensionality.lean index e5406a653b..554d7eb7d3 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/map_extensionality.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/map_extensionality.lean @@ -4,8 +4,8 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier -import Strata.Languages.Boole.Verify +import StrataBoole.MetaVerifier +import StrataBoole.Verify open Strata open Lambda @@ -53,8 +53,8 @@ spec { #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" mapExtensionalitySeed -example : Strata.smtVCsCorrect mapExtensionalitySeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole mapExtensionalitySeed := by + gen_smt_vcs_boole all_goals intro Map inst select a b hPointwise i exact hPointwise i diff --git a/StrataTest/Languages/Boole/FeatureRequests/mutual_recursion.lean b/StrataBoole/StrataBooleTest/FeatureRequests/mutual_recursion.lean similarity index 95% rename from StrataTest/Languages/Boole/FeatureRequests/mutual_recursion.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/mutual_recursion.lean index 548cb37a50..17a4e985c2 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/mutual_recursion.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/mutual_recursion.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -67,8 +67,8 @@ spec { #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" mutualRecursionSeed -example : Strata.smtVCsCorrect mutualRecursionSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole mutualRecursionSeed := by + gen_smt_vcs_boole all_goals (try grind) -- Still open: mutual recursion over int requires a decreases clause. diff --git a/StrataTest/Languages/Boole/FeatureRequests/nat_int_boundary.lean b/StrataBoole/StrataBooleTest/FeatureRequests/nat_int_boundary.lean similarity index 92% rename from StrataTest/Languages/Boole/FeatureRequests/nat_int_boundary.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/nat_int_boundary.lean index c049a99945..fe9e9cf79e 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/nat_int_boundary.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/nat_int_boundary.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -51,6 +51,6 @@ spec { #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" natIntBoundarySeed -example : Strata.smtVCsCorrect natIntBoundarySeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole natIntBoundarySeed := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/FeatureRequests/opaque_reveal_hide.lean b/StrataBoole/StrataBooleTest/FeatureRequests/opaque_reveal_hide.lean similarity index 94% rename from StrataTest/Languages/Boole/FeatureRequests/opaque_reveal_hide.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/opaque_reveal_hide.lean index e3ed888a99..6a6eb71553 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/opaque_reveal_hide.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/opaque_reveal_hide.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -60,6 +60,6 @@ procedure opaque_reveal_hide_seed(x: int) returns () #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" opaqueRevealHideSeed -example : Strata.smtVCsCorrect opaqueRevealHideSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole opaqueRevealHideSeed := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/FeatureRequests/option_matches.lean b/StrataBoole/StrataBooleTest/FeatureRequests/option_matches.lean similarity index 98% rename from StrataTest/Languages/Boole/FeatureRequests/option_matches.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/option_matches.lean index 1035da7573..4930a7d76e 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/option_matches.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/option_matches.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata diff --git a/StrataTest/Languages/Boole/FeatureRequests/overflow_guard.lean b/StrataBoole/StrataBooleTest/FeatureRequests/overflow_guard.lean similarity index 83% rename from StrataTest/Languages/Boole/FeatureRequests/overflow_guard.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/overflow_guard.lean index 264b8bae5f..7e5fc81b24 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/overflow_guard.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/overflow_guard.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -46,21 +46,23 @@ spec { }; #end -/-- info: -Obligation: assert_6_1175 +/-- +info: +Obligation: assert_6_1180 Property: assert Result: ✅ pass -Obligation: overflow_guard_seed_ensures_4_1112 +Obligation: overflow_guard_seed_ensures_4_1117 Property: assert Result: ✅ pass -Obligation: overflow_guard_seed_ensures_5_1134 +Obligation: overflow_guard_seed_ensures_5_1139 Property: assert -Result: ✅ pass-/ +Result: ✅ pass +-/ #guard_msgs in #eval Strata.Boole.verify "cvc5" overflowGuardSeed (options := .quiet) -example : Strata.smtVCsCorrect overflowGuardSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole overflowGuardSeed := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/FeatureRequests/reveal_with_fuel.lean b/StrataBoole/StrataBooleTest/FeatureRequests/reveal_with_fuel.lean similarity index 94% rename from StrataTest/Languages/Boole/FeatureRequests/reveal_with_fuel.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/reveal_with_fuel.lean index d41a37e3bd..ce5ea8a59d 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/reveal_with_fuel.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/reveal_with_fuel.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -61,6 +61,6 @@ spec { #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" revealWithFuelSeed -example : Strata.smtVCsCorrect revealWithFuelSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole revealWithFuelSeed := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/FeatureRequests/seq_slicing.lean b/StrataBoole/StrataBooleTest/FeatureRequests/seq_slicing.lean similarity index 97% rename from StrataTest/Languages/Boole/FeatureRequests/seq_slicing.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/seq_slicing.lean index e69a0d205c..606bfba32d 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/seq_slicing.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/seq_slicing.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata diff --git a/StrataTest/Languages/Boole/FeatureRequests/struct_field_access.lean b/StrataBoole/StrataBooleTest/FeatureRequests/struct_field_access.lean similarity index 98% rename from StrataTest/Languages/Boole/FeatureRequests/struct_field_access.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/struct_field_access.lean index b263203015..2b6a4febde 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/struct_field_access.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/struct_field_access.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata diff --git a/StrataTest/Languages/Boole/FeatureRequests/trait_spec_methods.lean b/StrataBoole/StrataBooleTest/FeatureRequests/trait_spec_methods.lean similarity index 98% rename from StrataTest/Languages/Boole/FeatureRequests/trait_spec_methods.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/trait_spec_methods.lean index 6ba4d1f467..923c7cba2f 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/trait_spec_methods.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/trait_spec_methods.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata diff --git a/StrataTest/Languages/Boole/FeatureRequests/widening_casts.lean b/StrataBoole/StrataBooleTest/FeatureRequests/widening_casts.lean similarity index 92% rename from StrataTest/Languages/Boole/FeatureRequests/widening_casts.lean rename to StrataBoole/StrataBooleTest/FeatureRequests/widening_casts.lean index 8ce2ca7f1e..5b9e44060a 100644 --- a/StrataTest/Languages/Boole/FeatureRequests/widening_casts.lean +++ b/StrataBoole/StrataBooleTest/FeatureRequests/widening_casts.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -48,8 +48,8 @@ spec { #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" wideningCastsSeed -example : Strata.smtVCsCorrect wideningCastsSeed := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole wideningCastsSeed := by + gen_smt_vcs_boole all_goals intro Map inst n bv32_to_int_u select v hNonneg hn i hi exact hNonneg (select v i) diff --git a/StrataTest/Languages/Boole/array_2d.lean b/StrataBoole/StrataBooleTest/array_2d.lean similarity index 78% rename from StrataTest/Languages/Boole/array_2d.lean rename to StrataBoole/StrataBooleTest/array_2d.lean index b40e988876..980a752cee 100644 --- a/StrataTest/Languages/Boole/array_2d.lean +++ b/StrataBoole/StrataBooleTest/array_2d.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -24,6 +24,6 @@ procedure array_2d_write_read(i: int, j: int, v: int) returns () #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" array_2d -example : Strata.smtVCsCorrect array_2d := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole array_2d := by + gen_smt_vcs_boole all_goals grind diff --git a/StrataTest/Languages/Boole/array_assignment.lean b/StrataBoole/StrataBooleTest/array_assignment.lean similarity index 83% rename from StrataTest/Languages/Boole/array_assignment.lean rename to StrataBoole/StrataBooleTest/array_assignment.lean index d8c870255b..504d5460c3 100644 --- a/StrataTest/Languages/Boole/array_assignment.lean +++ b/StrataBoole/StrataBooleTest/array_assignment.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -36,6 +36,6 @@ procedure matrix_transpose (A: Matrix, m: int, n: int) returns (B: Matrix) #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" matrix_transpose_example -theorem matrix_transpose_smt_vcs_correct : Strata.smtVCsCorrect matrix_transpose_example := by - gen_smt_vcs +theorem matrix_transpose_smt_vcs_correct : Strata.smtVCsCorrectBoole matrix_transpose_example := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/bit_vectors.lean b/StrataBoole/StrataBooleTest/bit_vectors.lean similarity index 83% rename from StrataTest/Languages/Boole/bit_vectors.lean rename to StrataBoole/StrataBooleTest/bit_vectors.lean index 0b567ab526..c07976ee28 100644 --- a/StrataTest/Languages/Boole/bit_vectors.lean +++ b/StrataBoole/StrataBooleTest/bit_vectors.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier private def bit_vectors := #strata @@ -37,6 +37,6 @@ spec { #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" bit_vectors -example : Strata.smtVCsCorrect bit_vectors := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole bit_vectors := by + gen_smt_vcs_boole all_goals grind diff --git a/StrataTest/Languages/Boole/code_expression.lean b/StrataBoole/StrataBooleTest/code_expression.lean similarity index 93% rename from StrataTest/Languages/Boole/code_expression.lean rename to StrataBoole/StrataBooleTest/code_expression.lean index 722df809cd..15369bc56c 100644 --- a/StrataTest/Languages/Boole/code_expression.lean +++ b/StrataBoole/StrataBooleTest/code_expression.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -70,6 +70,6 @@ procedure D(a : (Map int T), n : int) returns () #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" code_expression -example : Strata.smtVCsCorrect code_expression := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole code_expression := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/demo.lean b/StrataBoole/StrataBooleTest/demo.lean similarity index 93% rename from StrataTest/Languages/Boole/demo.lean rename to StrataBoole/StrataBooleTest/demo.lean index 0d0b710e00..c50a0aa9cf 100644 --- a/StrataTest/Languages/Boole/demo.lean +++ b/StrataBoole/StrataBooleTest/demo.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -36,11 +36,11 @@ spec { open Strata.SMT -theorem loopSimple_smtVCsCorrect : smtVCsCorrect loopSimple := by - gen_smt_vcs +theorem loopSimple_smtVCsCorrectBoole : smtVCsCorrectBoole loopSimple := by + gen_smt_vcs_boole all_goals (try grind) -/-- info: 'loopSimple_smtVCsCorrect' depends on axioms: [propext, +/-- info: 'loopSimple_smtVCsCorrectBoole' depends on axioms: [propext, Classical.choice, Lean.ofReduceBool, Lean.trustCompiler, @@ -97,4 +97,4 @@ theorem loopSimple_smtVCsCorrect : smtVCsCorrect loopSimple := by Core.bv8SafeUNegFunc._native.native_decide.ax_1✝, Core.bv8SafeUSubFunc._native.native_decide.ax_1✝]-/ #guard_msgs in -#print axioms loopSimple_smtVCsCorrect +#print axioms loopSimple_smtVCsCorrectBoole diff --git a/StrataTest/Languages/Boole/deterministic.lean b/StrataBoole/StrataBooleTest/deterministic.lean similarity index 78% rename from StrataTest/Languages/Boole/deterministic.lean rename to StrataBoole/StrataBooleTest/deterministic.lean index c45c756007..a5f1a55315 100644 --- a/StrataTest/Languages/Boole/deterministic.lean +++ b/StrataBoole/StrataBooleTest/deterministic.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -44,17 +44,19 @@ procedure Check(x1:int, x2:int) returns () #end -/-- info: -Obligation: Foo_ensures_0_251 +/-- +info: +Obligation: Foo_ensures_0_256 Property: assert Result: ✅ pass -Obligation: assert_1_557 +Obligation: assert_1_562 Property: assert -Result: ✅ pass-/ +Result: ✅ pass +-/ #guard_msgs in #eval Strata.Boole.verify "cvc5" deterministic (options := .quiet) -example : Strata.smtVCsCorrect deterministic := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole deterministic := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/find_max.lean b/StrataBoole/StrataBooleTest/find_max.lean similarity index 79% rename from StrataTest/Languages/Boole/find_max.lean rename to StrataBoole/StrataBooleTest/find_max.lean index 3e28f93b5d..01fe508750 100644 --- a/StrataTest/Languages/Boole/find_max.lean +++ b/StrataBoole/StrataBooleTest/find_max.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -33,7 +33,9 @@ spec }; #end -/-- info: Obligation: entry_invariant_0_0 +/-- +info: +Obligation: entry_invariant_0_0 Property: assert Result: ✅ pass @@ -49,12 +51,13 @@ Obligation: arbitrary_iter_maintain_invariant_0_1 Property: assert Result: ✅ pass -Obligation: FindMax_ensures_1_313 +Obligation: FindMax_ensures_1_318 Property: assert -Result: ✅ pass-/ +Result: ✅ pass +-/ #guard_msgs in #eval Strata.Boole.verify "cvc5" find_max_program (options := .quiet) -theorem find_max_program_smt_vcs_correct : Strata.smtVCsCorrect find_max_program := by - gen_smt_vcs +theorem find_max_program_smt_vcs_correct : Strata.smtVCsCorrectBoole find_max_program := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/find_max_verus.lean b/StrataBoole/StrataBooleTest/find_max_verus.lean similarity index 87% rename from StrataTest/Languages/Boole/find_max_verus.lean rename to StrataBoole/StrataBooleTest/find_max_verus.lean index 24f04fab89..e03d69de3b 100644 --- a/StrataTest/Languages/Boole/find_max_verus.lean +++ b/StrataBoole/StrataBooleTest/find_max_verus.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -93,8 +93,9 @@ spec { }; #end -/-- info: -Obligation: witnessOccurs_ensures_2_1229 +/-- +info: +Obligation: witnessOccurs_ensures_2_1234 Property: assert Result: ✅ pass @@ -122,28 +123,29 @@ Obligation: arbitrary_iter_maintain_invariant_0_2 Property: assert Result: ✅ pass -Obligation: assert_7_1950 +Obligation: assert_7_1955 Property: assert Result: ✅ pass -Obligation: callElimAssert_witnessOccurs_requires_0_1166_4 +Obligation: callElimAssert_witnessOccurs_requires_0_1171_4 Property: assert Result: ✅ pass -Obligation: callElimAssert_witnessOccurs_requires_1_1198_5 +Obligation: callElimAssert_witnessOccurs_requires_1_1203_5 Property: assert Result: ✅ pass -Obligation: findMax_ensures_5_1448 +Obligation: findMax_ensures_5_1453 Property: assert Result: ✅ pass -Obligation: findMax_ensures_6_1508 +Obligation: findMax_ensures_6_1513 Property: assert -Result: ✅ pass-/ +Result: ✅ pass +-/ #guard_msgs in #eval Strata.Boole.verify "cvc5" findMax (options := .quiet) -example : Strata.smtVCsCorrect findMax := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole findMax := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/format_program.lean b/StrataBoole/StrataBooleTest/format_program.lean similarity index 97% rename from StrataTest/Languages/Boole/format_program.lean rename to StrataBoole/StrataBooleTest/format_program.lean index 88e4602842..d5795f41b3 100644 --- a/StrataTest/Languages/Boole/format_program.lean +++ b/StrataBoole/StrataBooleTest/format_program.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.Languages.Boole.Verify +import StrataBoole.Verify import Strata.DDM.Elab /-! diff --git a/StrataTest/Languages/Boole/function_definitions.lean b/StrataBoole/StrataBooleTest/function_definitions.lean similarity index 74% rename from StrataTest/Languages/Boole/function_definitions.lean rename to StrataBoole/StrataBooleTest/function_definitions.lean index f9ecc4d9fb..2ae6568afc 100644 --- a/StrataTest/Languages/Boole/function_definitions.lean +++ b/StrataBoole/StrataBooleTest/function_definitions.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -31,12 +31,15 @@ spec { #end -/-- info: Obligation: test_ensures_0_318 +/-- +info: +Obligation: test_ensures_0_323 Property: assert -Result: ✅ pass-/ +Result: ✅ pass +-/ #guard_msgs in #eval Strata.Boole.verify "cvc5" function_definitions (options := .quiet) -example : Strata.smtVCsCorrect function_definitions := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole function_definitions := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/global_readonly_call.lean b/StrataBoole/StrataBooleTest/global_readonly_call.lean similarity index 87% rename from StrataTest/Languages/Boole/global_readonly_call.lean rename to StrataBoole/StrataBooleTest/global_readonly_call.lean index a0445f8753..5e60a48d37 100644 --- a/StrataTest/Languages/Boole/global_readonly_call.lean +++ b/StrataBoole/StrataBooleTest/global_readonly_call.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier /-! Test that read-only globals are correctly threaded through procedure headers @@ -141,41 +141,41 @@ spec { VCs: -Label: inc_ensures_1_2418 +Label: inc_ensures_1_2423 Property: assert Assumptions: -inc_requires_0_2400: z@1 > 0 +inc_requires_0_2405: z@1 > 0 Obligation: true -Label: callElimAssert_inc_requires_0_2400_6 +Label: callElimAssert_inc_requires_0_2405_6 Property: assert Assumptions: -main_caller_requires_2_2534: z@3 == 10 -main_caller_requires_3_2554: g@3 == 0 +main_caller_requires_2_2539: z@3 == 10 +main_caller_requires_3_2559: g@3 == 0 Obligation: z@3 > 0 -Label: main_caller_ensures_4_2573 +Label: main_caller_ensures_4_2578 Property: assert Assumptions: -main_caller_requires_2_2534: z@3 == 10 -main_caller_requires_3_2554: g@3 == 0 -callElimAssume_inc_ensures_1_2418_7: g@5 == g@3 + 5 + z@5 +main_caller_requires_2_2539: z@3 == 10 +main_caller_requires_3_2559: g@3 == 0 +callElimAssume_inc_ensures_1_2423_7: g@5 == g@3 + 5 + z@5 Obligation: g@5 == 15 --- info: -Obligation: inc_ensures_1_2418 +Obligation: inc_ensures_1_2423 Property: assert Result: ✅ pass -Obligation: callElimAssert_inc_requires_0_2400_6 +Obligation: callElimAssert_inc_requires_0_2405_6 Property: assert Result: ✅ pass -Obligation: main_caller_ensures_4_2573 +Obligation: main_caller_ensures_4_2578 Property: assert Result: ❓ unknown Model: diff --git a/StrataTest/Languages/Boole/grammar_extensions.lean b/StrataBoole/StrataBooleTest/grammar_extensions.lean similarity index 92% rename from StrataTest/Languages/Boole/grammar_extensions.lean rename to StrataBoole/StrataBooleTest/grammar_extensions.lean index 5d8f3337e4..200360ea77 100644 --- a/StrataTest/Languages/Boole/grammar_extensions.lean +++ b/StrataBoole/StrataBooleTest/grammar_extensions.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -90,6 +90,6 @@ procedure test_arrays () returns () #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" grammarExtensions -example : Strata.smtVCsCorrect grammarExtensions := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole grammarExtensions := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/insertion_sort.lean b/StrataBoole/StrataBooleTest/insertion_sort.lean similarity index 90% rename from StrataTest/Languages/Boole/insertion_sort.lean rename to StrataBoole/StrataBooleTest/insertion_sort.lean index 9c734c2082..b5f5605fff 100644 --- a/StrataTest/Languages/Boole/insertion_sort.lean +++ b/StrataBoole/StrataBooleTest/insertion_sort.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -53,6 +53,6 @@ spec #guard_msgs (drop info) in #eval Strata.Boole.verify "cvc5" insertionSortPgm -example : Strata.smtVCsCorrect insertionSortPgm := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole insertionSortPgm := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/loop_simple.lean b/StrataBoole/StrataBooleTest/loop_simple.lean similarity index 87% rename from StrataTest/Languages/Boole/loop_simple.lean rename to StrataBoole/StrataBooleTest/loop_simple.lean index 0a07e49930..f116cc1709 100644 --- a/StrataTest/Languages/Boole/loop_simple.lean +++ b/StrataBoole/StrataBooleTest/loop_simple.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -53,6 +53,6 @@ Result: ✅ pass-/ open Strata.SMT -theorem loop_simple_smt_vcs_correct : smtVCsCorrect loop_simple_program := by - gen_smt_vcs +theorem loop_simple_smt_vcs_correct : smtVCsCorrectBoole loop_simple_program := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/procedure_signatures.lean b/StrataBoole/StrataBooleTest/procedure_signatures.lean similarity index 99% rename from StrataTest/Languages/Boole/procedure_signatures.lean rename to StrataBoole/StrataBooleTest/procedure_signatures.lean index 744111a23c..a0ecaf635e 100644 --- a/StrataTest/Languages/Boole/procedure_signatures.lean +++ b/StrataBoole/StrataBooleTest/procedure_signatures.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier /-! Test accepted and rejected procedure signature forms in Boole. diff --git a/StrataTest/Languages/Boole/square_matrix_multiply.lean b/StrataBoole/StrataBooleTest/square_matrix_multiply.lean similarity index 94% rename from StrataTest/Languages/Boole/square_matrix_multiply.lean rename to StrataBoole/StrataBooleTest/square_matrix_multiply.lean index fd07b73fee..2564c7eacc 100644 --- a/StrataTest/Languages/Boole/square_matrix_multiply.lean +++ b/StrataBoole/StrataBooleTest/square_matrix_multiply.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier namespace Strata @@ -103,6 +103,6 @@ Result: ✅ pass -/ #guard_msgs in #eval Strata.Boole.verify "cvc5" squareMatrixMult (options := .quiet) -example : Strata.smtVCsCorrect squareMatrixMult := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole squareMatrixMult := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/stack_array_based.lean b/StrataBoole/StrataBooleTest/stack_array_based.lean similarity index 82% rename from StrataTest/Languages/Boole/stack_array_based.lean rename to StrataBoole/StrataBooleTest/stack_array_based.lean index 9af09256a0..bcd6fbeecc 100644 --- a/StrataTest/Languages/Boole/stack_array_based.lean +++ b/StrataBoole/StrataBooleTest/stack_array_based.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier ------------------------------------------------------------ namespace Strata @@ -169,21 +169,21 @@ spec { VCs: -Label: StackInit_ensures_1_1066 +Label: StackInit_ensures_1_1071 Property: assert Assumptions: -StackInit_requires_0_1015: cap@1 >= 0 +StackInit_requires_0_1020: cap@1 >= 0 Obligation: true -Label: StackInit_ensures_2_1086 +Label: StackInit_ensures_2_1091 Property: assert Assumptions: -StackInit_requires_0_1015: cap@1 >= 0 +StackInit_requires_0_1020: cap@1 >= 0 Obligation: true -Label: StackEmpty_ensures_3_1205 +Label: StackEmpty_ensures_3_1210 Property: assert Assumptions: : if top@3 == 0 then top@3 == 0 else true @@ -191,7 +191,7 @@ Assumptions: Obligation: if top@3 == 0 then true else false ==> top@3 == 0 -Label: StackEmpty_ensures_4_1233 +Label: StackEmpty_ensures_4_1238 Property: assert Assumptions: : if top@3 == 0 then top@3 == 0 else true @@ -199,82 +199,82 @@ Assumptions: Obligation: top@3 == 0 ==> if top@3 == 0 then true else false -Label: Push_ensures_6_1494 +Label: Push_ensures_6_1499 Property: assert Assumptions: -Push_requires_5_1443: top@4 < n@4 +Push_requires_5_1448: top@4 < n@4 Obligation: true -Label: Push_ensures_7_1525 +Label: Push_ensures_7_1530 Property: assert Assumptions: -Push_requires_5_1443: top@4 < n@4 +Push_requires_5_1448: top@4 < n@4 Obligation: (S@3[top@4 + 1:=x@1])[top@4 + 1] == x@1 -Label: Push_ensures_8_1583 +Label: Push_ensures_8_1588 Property: assert Assumptions: -Push_requires_5_1443: top@4 < n@4 +Push_requires_5_1448: top@4 < n@4 Obligation: forall __q0 : int :: 1 <= __q0 && __q0 <= top@4 ==> (S@3[top@4 + 1:=x@1])[__q0] == S@3[__q0] -Label: Pop_ensures_10_1840 +Label: Pop_ensures_10_1845 Property: assert Assumptions: -Pop_requires_9_1803: top@6 > 0 +Pop_requires_9_1808: top@6 > 0 Obligation: true -Label: Pop_ensures_11_1871 +Label: Pop_ensures_11_1876 Property: assert Assumptions: -Pop_requires_9_1803: top@6 > 0 +Pop_requires_9_1808: top@6 > 0 Obligation: true --- info: -Obligation: StackInit_ensures_1_1066 +Obligation: StackInit_ensures_1_1071 Property: assert Result: ✅ pass -Obligation: StackInit_ensures_2_1086 +Obligation: StackInit_ensures_2_1091 Property: assert Result: ✅ pass -Obligation: StackEmpty_ensures_3_1205 +Obligation: StackEmpty_ensures_3_1210 Property: assert Result: ✅ pass -Obligation: StackEmpty_ensures_4_1233 +Obligation: StackEmpty_ensures_4_1238 Property: assert Result: ✅ pass -Obligation: Push_ensures_6_1494 +Obligation: Push_ensures_6_1499 Property: assert Result: ✅ pass -Obligation: Push_ensures_7_1525 +Obligation: Push_ensures_7_1530 Property: assert Result: ✅ pass -Obligation: Push_ensures_8_1583 +Obligation: Push_ensures_8_1588 Property: assert Result: ✅ pass -Obligation: Pop_ensures_10_1840 +Obligation: Pop_ensures_10_1845 Property: assert Result: ✅ pass -Obligation: Pop_ensures_11_1871 +Obligation: Pop_ensures_11_1876 Property: assert Result: ✅ pass -/ #guard_msgs in #eval Strata.Boole.verify "cvc5" stackArrayPgm -example : Strata.smtVCsCorrect stackArrayPgm := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole stackArrayPgm := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/string_operators.lean b/StrataBoole/StrataBooleTest/string_operators.lean similarity index 89% rename from StrataTest/Languages/Boole/string_operators.lean rename to StrataBoole/StrataBooleTest/string_operators.lean index 441ca693b4..30bf034d08 100644 --- a/StrataTest/Languages/Boole/string_operators.lean +++ b/StrataBoole/StrataBooleTest/string_operators.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier namespace Strata @@ -118,49 +118,51 @@ procedure main() returns () { #end - /-- info: -Obligation: assert_19_3035 + /-- +info: +Obligation: assert_19_3040 Property: assert Result: ✅ pass -Obligation: assert_20_3077 +Obligation: assert_20_3082 Property: assert Result: ✅ pass -Obligation: assert_21_3125 +Obligation: assert_21_3130 Property: assert Result: ✅ pass -Obligation: assert_22_3159 +Obligation: assert_22_3164 Property: assert Result: ✅ pass -Obligation: assert_23_3206 +Obligation: assert_23_3211 Property: assert Result: ✅ pass -Obligation: assert_24_3242 +Obligation: assert_24_3247 Property: assert Result: ✅ pass -Obligation: assert_25_3272 +Obligation: assert_25_3277 Property: assert Result: ✅ pass -Obligation: assert_26_3302 +Obligation: assert_26_3307 Property: assert Result: ✅ pass -Obligation: assert_27_3332 +Obligation: assert_27_3337 Property: assert Result: ✅ pass -Obligation: assert_28_3386 +Obligation: assert_28_3391 Property: assert -Result: ✅ pass-/ +Result: ✅ pass +-/ #guard_msgs in #eval Strata.Boole.verify "cvc5" basicOp (options := .quiet) -theorem basicOp_smt_vcs_correct : Strata.smtVCsCorrect basicOp := by - gen_smt_vcs +theorem basicOp_smt_vcs_correct : Strata.smtVCsCorrectBoole basicOp := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/top_level_block_selection.lean b/StrataBoole/StrataBooleTest/top_level_block_selection.lean similarity index 83% rename from StrataTest/Languages/Boole/top_level_block_selection.lean rename to StrataBoole/StrataBooleTest/top_level_block_selection.lean index 7f7aab3cc8..9d14b29b2c 100644 --- a/StrataTest/Languages/Boole/top_level_block_selection.lean +++ b/StrataBoole/StrataBooleTest/top_level_block_selection.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -36,6 +36,6 @@ Result: ✅ pass (proceduresToVerify := (some [Strata.Boole.topLevelBlockProcedureName])) (options := .quiet) -example : Strata.smtVCsCorrect topLevelBlockSelection := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole topLevelBlockSelection := by + gen_smt_vcs_boole all_goals (try grind) diff --git a/StrataTest/Languages/Boole/verification_coverage.lean b/StrataBoole/StrataBooleTest/verification_coverage.lean similarity index 86% rename from StrataTest/Languages/Boole/verification_coverage.lean rename to StrataBoole/StrataBooleTest/verification_coverage.lean index 885d9e287b..f65c06197e 100644 --- a/StrataTest/Languages/Boole/verification_coverage.lean +++ b/StrataBoole/StrataBooleTest/verification_coverage.lean @@ -4,7 +4,7 @@ SPDX-License-Identifier: Apache-2.0 OR MIT -/ -import Strata.MetaVerifier +import StrataBoole.MetaVerifier open Strata @@ -161,12 +161,13 @@ spec #end -/-- info: -Obligation: assert_2_406 +/-- +info: +Obligation: assert_2_411 Property: assert Result: ✅ pass -Obligation: assert_3_509 +Obligation: assert_3_514 Property: assert Result: ✅ pass @@ -194,68 +195,69 @@ Obligation: arbitrary_iter_maintain_invariant_0_2 Property: assert Result: ✅ pass -Obligation: sum_ensures_5_652 +Obligation: sum_ensures_5_657 Property: assert Result: ✅ pass -Obligation: assert_10_1185 +Obligation: assert_10_1190 Property: assert Result: ✅ pass -Obligation: assert_12_1419 +Obligation: assert_12_1424 Property: assert Result: ✅ pass -Obligation: assert_16_1684 +Obligation: assert_16_1689 Property: assert Result: ✅ pass -Obligation: assert_18_1820 +Obligation: assert_18_1825 Property: assert Result: ✅ pass -Obligation: testEnsuresCallee_ensures_20_1983 +Obligation: testEnsuresCallee_ensures_20_1988 Property: assert Result: ✅ pass -Obligation: testEnsuresCallee_ensures_21_2025 +Obligation: testEnsuresCallee_ensures_21_2030 Property: assert Result: ✅ pass -Obligation: callElimAssert_testEnsuresCallee_requires_19_1941_7 +Obligation: callElimAssert_testEnsuresCallee_requires_19_1946_7 Property: assert Result: ✅ pass -Obligation: callElimAssert_testEnsuresCallee_requires_19_1941_2 +Obligation: callElimAssert_testEnsuresCallee_requires_19_1946_2 Property: assert Result: ✅ pass -Obligation: assert_24_2458 +Obligation: assert_24_2463 Property: assert Result: ✅ pass -Obligation: testEnsuresCaller_ensures_23_2219 +Obligation: testEnsuresCaller_ensures_23_2224 Property: assert Result: ✅ pass -Obligation: obviouslyUnconstrainedCode_ensures_27_2723 +Obligation: obviouslyUnconstrainedCode_ensures_27_2728 Property: assert Result: ✅ pass -Obligation: contradictoryEnsuresClause_ensures_29_3049 +Obligation: contradictoryEnsuresClause_ensures_29_3054 Property: assert Result: ✅ pass -Obligation: callElimAssert_contradictoryEnsuresClause_requires_28_2979_12 +Obligation: callElimAssert_contradictoryEnsuresClause_requires_28_2984_12 Property: assert Result: ✅ pass -Obligation: usesSomeInteger_ensures_32_3711 +Obligation: usesSomeInteger_ensures_32_3716 Property: assert -Result: ✅ pass-/ +Result: ✅ pass +-/ #guard_msgs in #eval Strata.Boole.verify "cvc5" verification_coverage (options := .quiet) -example : Strata.smtVCsCorrect verification_coverage := by - gen_smt_vcs +example : Strata.smtVCsCorrectBoole verification_coverage := by + gen_smt_vcs_boole all_goals grind diff --git a/StrataBoole/lake-manifest.json b/StrataBoole/lake-manifest.json new file mode 100644 index 0000000000..ece503ad20 --- /dev/null +++ b/StrataBoole/lake-manifest.json @@ -0,0 +1,22 @@ +{"version": "1.1.0", + "packagesDir": ".lake/packages", + "packages": + [{"type": "path", + "scope": "", + "name": "Strata", + "manifestFile": "lake-manifest.json", + "inherited": false, + "dir": "..", + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/plausible.git", + "type": "git", + "subDir": null, + "scope": "", + "rev": "4bdad1f417437e3331492708ce8320aec350280a", + "name": "plausible", + "manifestFile": "lake-manifest.json", + "inputRev": "bump_to_v4.29.0-rc8", + "inherited": true, + "configFile": "lakefile.toml"}], + "name": "StrataBoole", + "lakeDir": ".lake"} diff --git a/StrataBoole/lakefile.toml b/StrataBoole/lakefile.toml new file mode 100644 index 0000000000..8c41aee1a9 --- /dev/null +++ b/StrataBoole/lakefile.toml @@ -0,0 +1,13 @@ +name = "StrataBoole" +version = "0.1.0" +defaultTargets = ["StrataBoole"] + +[[require]] +name = "Strata" +path = ".." + +[[lean_lib]] +name = "StrataBoole" + +[[lean_lib]] +name = "StrataBooleTest" diff --git a/StrataBoole/lean-toolchain b/StrataBoole/lean-toolchain new file mode 100644 index 0000000000..33e0c08893 --- /dev/null +++ b/StrataBoole/lean-toolchain @@ -0,0 +1 @@ +leanprover/lean4:v4.29.1 diff --git a/StrataMainLib.lean b/StrataMainLib.lean index 9f345497cd..e836df93d0 100644 --- a/StrataMainLib.lean +++ b/StrataMainLib.lean @@ -18,8 +18,6 @@ import Strata.Languages.B3.Verifier.Program import Strata.Languages.Laurel.LaurelCompilationPipeline import Strata.Pipeline.Diagnostic import Strata.Pipeline.PyAnalyzeLaurel -import Strata.Languages.Boole.Boole -import Strata.Languages.Boole.Verify import Strata.Languages.C_Simp.DDMTransform.Parse import Strata.Languages.Python.Python import Strata.Languages.Python.Specs.IdentifyOverloads @@ -138,7 +136,6 @@ def buildDialectFileMap (pflags : ParsedFlags) : IO Strata.DialectFileMap := do |>.addDialect! Strata.Python.Python |>.addDialect! Strata.Python.Specs.DDM.PythonSpecs |>.addDialect! Strata.Core - |>.addDialect! Strata.Boole |>.addDialect! Strata.Laurel.Laurel |>.addDialect! Strata.smtReservedKeywordsDialect |>.addDialect! Strata.SMTCore @@ -318,7 +315,6 @@ private def readStrataProgram (file : String) let inputCtx := Lean.Parser.mkInputContext text (Strata.Util.displayName file) let dctx := Elab.LoadedDialects.builtin let dctx := dctx.addDialect! Core - let dctx := dctx.addDialect! Boole let dctx := dctx.addDialect! C_Simp let dctx := dctx.addDialect! B3CST let leanEnv ← Lean.mkEmptyEnvironment 0 @@ -1296,8 +1292,6 @@ def verifyCommand (mkDischarge : Core.MkDischargeFn := Core.mkDischargeFn) : Com if opts.typeCheckOnly then let ans := if file.endsWith ".csimp.st" then C_Simp.typeCheck pgm opts - else if pgm.dialect == "Boole" then - Boole.typeCheck pgm opts else typeCheck inputCtx pgm opts match ans with @@ -1331,7 +1325,9 @@ def verifyCommand (mkDischarge : Core.MkDischargeFn := Core.mkDischargeFn) : Com IO.println s!" {marker} {desc}" pure #[] else if pgm.dialect == "Boole" then - Boole.verify opts.solver pgm inputCtx proceduresToVerify opts + -- TODO: this will be restored once StrataMainLib is in a separate + -- package that can depend on the StrataBoole package. + throw <| IO.Error.userError "Boole dialect support requires the StrataBoole package" else verify pgm inputCtx proceduresToVerify opts (mkDischarge := mkDischarge) catch e =>