diff --git a/.gitignore b/.gitignore index 3776616d98..9f5babd9ab 100644 --- a/.gitignore +++ b/.gitignore @@ -12,4 +12,5 @@ vcs/*.smt2 *.py.ion *.py.ion.core.st -Strata.code-workspace \ No newline at end of file +Strata.code-workspace +Build/ \ No newline at end of file diff --git a/Examples/StringTest.laurel.st b/Examples/StringTest.laurel.st index a2674aba5a..2b6d087d32 100644 --- a/Examples/StringTest.laurel.st +++ b/Examples/StringTest.laurel.st @@ -1,6 +1,7 @@ procedure testString() returns (result: string) requires true + opaque { var message: string := "Hello, World!"; return message @@ -9,6 +10,7 @@ requires true procedure testStringConcat() returns (result: string) requires true + opaque { var hello: string := "Hello"; var world: string := "World"; diff --git a/Strata/DDM/Format.lean b/Strata/DDM/Format.lean index 613a726135..4d97f30839 100644 --- a/Strata/DDM/Format.lean +++ b/Strata/DDM/Format.lean @@ -453,7 +453,7 @@ private partial def ArgF.mformatM {α} : ArgF α → FormatM PrecFormat if z : entries.size = 0 then pure (.atom .nil) else do - let f i q s := return s ++ "; " ++ (← entries[i].mformatM).format + let f i q s := return s ++ ";\n" ++ (← entries[i].mformatM).format let a := (← entries[0].mformatM).format .atom <$> entries.size.foldlM f (start := 1) a diff --git a/Strata/Languages/Core/Factory.lean b/Strata/Languages/Core/Factory.lean index ef99656a5b..36c9006028 100644 --- a/Strata/Languages/Core/Factory.lean +++ b/Strata/Languages/Core/Factory.lean @@ -42,6 +42,7 @@ def KnownLTys : LTys := t[real], t[Triggers], t[TriggerGroup], + t[errorVoid], -- Note: t[bv] elaborates to (.forAll [] .tcons "bitvec" ). -- We can simply add the following here. t[∀n. bitvec n], 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/ContractPass.lean b/Strata/Languages/Laurel/ContractPass.lean new file mode 100644 index 0000000000..914192d108 --- /dev/null +++ b/Strata/Languages/Laurel/ContractPass.lean @@ -0,0 +1,343 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.Languages.Laurel.MapStmtExpr + +/-! +## Contract Pass (Laurel → Laurel) + +Removes pre- and postconditions from all procedures and replaces them with +explicit precondition/postcondition helper procedures, assumptions, and +assertions. + +For each procedure with contracts: +- Generate a precondition procedure (`foo$pre`) returning the conjunction of preconditions. +- Generate a postcondition procedure (`foo$post`) that takes all inputs and all + outputs as parameters and returns the conjunction of postconditions. It is + marked as functional and does not call the original procedure. +- Insert `assume foo$pre(inputs)` at the start of the body. +- Insert `assert foo$post(inputs, outputs)` at the end of the body. + +For each call to a contracted procedure: +- Assign all input arguments to temporary variables before the call. +- Insert `assert foo$pre(temps)` before the call (precondition check). +- After the call, insert `assume foo$post(temps, outputs)` (postcondition assumption). +-/ + +namespace Strata.Laurel + +public section + +private def mkMd (e : StmtExpr) : StmtExprMd := { val := e, source := none } +private def mkVarMd (v : Variable) : VariableMd := { val := v, source := none } + +/-- Build a conjunction of expressions. Returns `LiteralBool true` for an empty list. -/ +private def conjoin (exprs : List StmtExprMd) : StmtExprMd := + match exprs with + | [] => mkMd (.LiteralBool true) + | [e] => e + | e :: rest => rest.foldl (fun acc x => + mkMd (.PrimitiveOp .And [acc, x])) e + +/-- Name for the precondition helper procedure. -/ +def preCondProcName (procName : String) : String := s!"{procName}$pre" + +/-- Name for the postcondition helper procedure. -/ +def postCondProcName (procName : String) : String := s!"{procName}$post" + +/-- Get postconditions from a procedure body. -/ +private def getPostconditions (body : Body) : List Condition := + match body with + | .Opaque postconds _ _ => postconds + | .Abstract postconds => postconds + | _ => [] + +/-- Build a call expression. -/ +private def mkCall (callee : String) (args : List StmtExprMd) : StmtExprMd := + mkMd (.StaticCall (mkId callee) args) + +/-- Convert parameters to identifier expressions. -/ +private def paramsToArgs (params : List Parameter) : List StmtExprMd := + params.map fun p => mkMd (.Var (.Local p.name)) + +/-- Build a helper function that returns the conjunction of the given conditions. -/ +private def mkConditionProc (name : String) (params : List Parameter) + (conditions : List Condition) : Procedure := + { name := mkId name + inputs := params + outputs := [⟨mkId "$result", { val := .TBool, source := none }⟩] + preconditions := [] + decreases := none + isFunctional := true + body := .Transparent (conjoin (conditions.map (·.condition))) } + +/-- Build a postcondition function that takes all inputs and all outputs as + parameters and returns the conjunction of postconditions. The function is + marked as functional and does not call the original procedure. + + For a procedure `foo(a, b) returns (x, y)` with postcondition `P(a, b, x, y)`, + generates: + ``` + function foo$post(a, b, x, y) returns ($result : bool) { + P(a, b, x, y) + } + ``` +-/ +private def mkPostConditionProc (name : String) + (inputParams : List Parameter) (outputParams : List Parameter) + (conditions : List Condition) : Procedure := + let allParams := inputParams ++ outputParams + { name := mkId name + inputs := allParams + outputs := [⟨mkId "$result", { val := .TBool, source := none }⟩] + preconditions := [] + decreases := none + isFunctional := true + body := .Transparent (conjoin (conditions.map (·.condition))) } + +/-- Extract a combined summary from a list of conditions. -/ +private def combinedSummary (clauses : List Condition) : Option String := + let summaries := clauses.filterMap (·.summary) + match summaries with + | [] => none + | [s] => some s + | ss => some (String.intercalate ", " ss) + +/-- Information about a procedure's contracts. -/ +private structure ContractInfo where + hasPreCondition : Bool + hasPostCondition : Bool + preName : String + postName : String + preSummary : Option String + postSummary : Option String + inputParams : List Parameter + outputParams : List Parameter + +/-- Collect contract info for all procedures with contracts. -/ +private def collectContractInfo (procs : List Procedure) : Std.HashMap String ContractInfo := + procs.foldl (fun m proc => + let postconds := getPostconditions proc.body + let hasPre := !proc.preconditions.isEmpty + let hasPost := !postconds.isEmpty + if hasPre || hasPost then + m.insert proc.name.text { + hasPreCondition := hasPre + hasPostCondition := hasPost + preName := preCondProcName proc.name.text + postName := postCondProcName proc.name.text + preSummary := combinedSummary proc.preconditions + postSummary := combinedSummary postconds + inputParams := proc.inputs + outputParams := proc.outputs + } + else m) {} + +/-- Transform a procedure body to add assume/assert for its own contracts. -/ +private def transformProcBody (proc : Procedure) (info : ContractInfo) : Body := + let inputArgs := paramsToArgs proc.inputs + let postconds := getPostconditions proc.body + let preAssume : List StmtExprMd := + if info.hasPreCondition then + let preSrc := match proc.preconditions.head? with + | some pc => pc.condition.source + | none => none + [⟨.Assume (mkCall info.preName inputArgs), preSrc⟩] + else [] + let postAssert : List StmtExprMd := + if info.hasPostCondition then + postconds.map fun pc => + let summary := pc.summary.getD "postcondition" + ⟨.Assert { condition := pc.condition, summary := some summary }, pc.condition.source⟩ + else [] + match proc.body with + | .Transparent body => + .Transparent ⟨.Block (preAssume ++ [body] ++ postAssert) none, body.source⟩ + | .Opaque _ (some impl) _ => + .Opaque [] (some ⟨.Block (preAssume ++ [impl] ++ postAssert) none, impl.source⟩) [] + | .Opaque _ none mods => + .Opaque [] none mods + | .Abstract _ => + .Abstract [] + | b => b + +/-- Generate temporary variable assignments for input arguments at a call site. + Returns (temp declarations+assignments, temp variable references). + Uses the parameter types from the procedure's contract info so that + resolution can type-check the generated temporaries. + `callIdx` distinguishes multiple calls to the same procedure. -/ +private def mkTempAssignments (args : List StmtExprMd) (calleeName : String) + (inputParams : List Parameter) (callIdx : Nat) (src : Option FileRange) + : List StmtExprMd × List StmtExprMd := + let indexed := args.zipIdx + let decls := indexed.map fun (arg, i) => + let tempName := s!"${calleeName}${callIdx}$arg{i}" + let paramType := match inputParams[i]? with + | some p => p.type + | none => { val := .Unknown, source := none } + let param : Parameter := { name := mkId tempName, type := paramType } + ⟨StmtExpr.Assign [mkVarMd (.Declare param)] arg, src⟩ + let refs := indexed.map fun (_, i) => + let tempName := s!"${calleeName}${callIdx}$arg{i}" + mkMd (.Var (.Local (mkId tempName))) + (decls, refs) + +/-- Rewrite a single statement that may be a call to a contracted procedure. + Returns a list of statements (the original plus any inserted assert/assume). + Takes and returns a call counter for generating unique temp variable names. + When `isFunctional` is true, precondition checks use `assume` instead of + `assert` since asserts are not supported in functions during Core translation. + + At call sites: + 1. Assign input arguments to temporary variables. + 2. Assert precondition using temps. + 3. Execute the call using temps as arguments. + 4. Assume postcondition using temps + output variables. -/ +private def rewriteStmt (contractInfoMap : Std.HashMap String ContractInfo) + (isFunctional : Bool) (callCounter : Nat) (e : StmtExprMd) : List StmtExprMd × Nat := + let src := e.source + let mkWithSrc (se : StmtExpr) : StmtExprMd := ⟨se, src⟩ + match e.val with + | .Assign targets (.mk (.StaticCall callee args) callSrc) => + match contractInfoMap.get? callee.text with + | some info => + let (tempDecls, tempRefs) := mkTempAssignments args callee.text info.inputParams callCounter src + let callWithTemps : StmtExprMd := ⟨.Assign targets ⟨.StaticCall callee tempRefs, callSrc⟩, src⟩ + let preCheck := if info.hasPreCondition then + if isFunctional then + [mkWithSrc (.Assume (mkCall info.preName tempRefs))] + else + [mkWithSrc (.Assert { condition := mkCall info.preName tempRefs, summary := some (info.preSummary.getD "precondition") })] + else [] + -- After the call, assume postcondition with temps (inputs) + output variables + let outputArgs := targets.filterMap fun t => + match t.val with + | .Local name => some (mkMd (.Var (.Local name))) + | .Declare param => some (mkMd (.Var (.Local param.name))) + | _ => none + let postAssume := if info.hasPostCondition + then [mkWithSrc (.Assume (mkCall info.postName (tempRefs ++ outputArgs)))] else [] + (tempDecls ++ preCheck ++ [callWithTemps] ++ postAssume, callCounter + 1) + | none => ([e], callCounter) + | .StaticCall callee args => + match contractInfoMap.get? callee.text with + | some info => + let (tempDecls, tempRefs) := mkTempAssignments args callee.text info.inputParams callCounter src + let preCheck := if info.hasPreCondition then + if isFunctional then + [mkWithSrc (.Assume (mkCall info.preName tempRefs))] + else + [mkWithSrc (.Assert { condition := mkCall info.preName tempRefs, summary := some (info.preSummary.getD "precondition") })] + else [] + -- For bare calls with postconditions, capture outputs in temp variables + -- so we can pass them to the $post function. + let (callStmt, postAssume) := + if info.hasPostCondition && !info.outputParams.isEmpty then + let outputTempDecls := info.outputParams.zipIdx.map fun (p, i) => + let tempName := s!"${callee.text}${callCounter}$out{i}" + mkVarMd (.Declare { name := mkId tempName, type := p.type }) + let callWithOutputs : StmtExprMd := + ⟨.Assign outputTempDecls ⟨.StaticCall callee tempRefs, src⟩, src⟩ + let outputRefs := info.outputParams.zipIdx.map fun (_, i) => + let tempName := s!"${callee.text}${callCounter}$out{i}" + mkMd (.Var (.Local (mkId tempName))) + let assume := [mkWithSrc (.Assume (mkCall info.postName (tempRefs ++ outputRefs)))] + (callWithOutputs, assume) + else + (mkWithSrc (.StaticCall callee tempRefs), []) + (tempDecls ++ preCheck ++ [callStmt] ++ postAssume, callCounter + 1) + | none => ([e], callCounter) + | _ => ([e], callCounter) + +/-- Rewrite call sites in a statement/expression tree. Processes Block children + at the statement level to avoid interfering with expression-level calls. -/ +private def rewriteCallSites (contractInfoMap : Std.HashMap String ContractInfo) + (isFunctional : Bool) (expr : StmtExprMd) : StmtExprMd := + let (result, _) := StateT.run (s := (0 : Nat)) <| + mapStmtExprM (m := StateM Nat) (fun e => do + match e.val with + | .Block stmts label => + let mut newStmts : List StmtExprMd := [] + let mut counter ← get + for stmt in stmts do + let (expanded, counter') := rewriteStmt contractInfoMap isFunctional counter stmt + newStmts := newStmts ++ expanded + counter := counter' + set counter + if newStmts.length == stmts.length then return e + else return ⟨.Block newStmts label, e.source⟩ + | _ => return e) expr + -- Handle top-level non-Block statements (e.g., bare Assign or StaticCall) + let (expanded, _) := rewriteStmt contractInfoMap isFunctional 0 result + match expanded with + | [single] => single + | many => mkMd (.Block many none) + +/-- Rewrite call sites in all bodies of a procedure. -/ +private def rewriteCallSitesInProc (contractInfoMap : Std.HashMap String ContractInfo) + (proc : Procedure) : Procedure := + let rw := rewriteCallSites contractInfoMap proc.isFunctional + match proc.body with + | .Transparent body => + { proc with body := .Transparent (rw body) } + | .Opaque posts impl mods => + let body := Body.Opaque (posts.map (·.mapCondition rw)) (impl.map rw) (mods.map rw) + { proc with body := body } + | _ => proc + +/-- Build an axiom expression from `invokeOn` trigger and ensures clauses. + Produces `∀ p1, ∀ p2, ..., ∀ pn :: { trigger } (ensures1 && ensures2 && ...)`. + The trigger controls when the SMT solver instantiates the axiom. -/ +private def mkInvokeOnAxiom (params : List Parameter) (trigger : StmtExprMd) + (postconds : List Condition) : StmtExprMd := + let body := conjoin (postconds.map (·.condition)) + -- Wrap in nested Forall from last param (innermost) to first (outermost). + -- The trigger is placed on the innermost quantifier. + params.foldr (init := (body, true)) (fun p (acc, isInnermost) => + let trig := if isInnermost then some trigger else none + (mkMd (.Quantifier .Forall p trig acc), false)) |>.1 + +/-- Run the contract pass on a Laurel program. + All procedures with contracts are transformed. -/ +def contractPass (program : Program) : Program := + let contractInfoMap := collectContractInfo program.staticProcedures + + -- Generate helper procedures for all procedures with contracts + let helperProcs := program.staticProcedures.flatMap fun proc => + let postconds := getPostconditions proc.body + let preProc := + if proc.preconditions.isEmpty then [] + else [mkConditionProc (preCondProcName proc.name.text) proc.inputs proc.preconditions] + let postProc := + if postconds.isEmpty then [] + else [mkPostConditionProc (postCondProcName proc.name.text) + proc.inputs proc.outputs postconds] + preProc ++ postProc + + -- Transform procedures: strip contracts, add assume/assert, rewrite call sites + let transformedProcs := program.staticProcedures.map fun proc => + let proc := match proc.invokeOn with + | some trigger => + let postconds := getPostconditions proc.body + if postconds.isEmpty then { proc with invokeOn := none } + else { proc with + axioms := [mkInvokeOnAxiom proc.inputs trigger postconds] + invokeOn := none } + | none => proc + let proc := match contractInfoMap.get? proc.name.text with + | some info => + { proc with + preconditions := [] + body := transformProcBody proc info } + | none => proc + -- Rewrite call sites in the procedure body + rewriteCallSitesInProc contractInfoMap proc + + { program with staticProcedures := helperProcs ++ transformedProcs } + +end -- public section +end Strata.Laurel diff --git a/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean b/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean index 2df59b8ceb..98b642012d 100644 --- a/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean +++ b/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean @@ -27,16 +27,21 @@ program Laurel; datatype LaurelResolutionErrorPlaceholder {} datatype Float64IsNotSupportedYet {} +datatype LaurelUnit { MkLaurelUnit() } + +// And then we can remove the datatype Box as well +// And remove the hacky filter in HeapParameterization +datatype Box { MkBox() } // The types for these Map functions are incorrect. // We'll fix them when Laurel supports polymorphism -function select(map: int, key: int) : int +function select(map: int, key: int) : Box external; -function update(map: int, key: int, value: int) : int +function update(map: int, key: int, value: int) : Box external; -function const(value: int) : int +function const(value: int) : Box external; #end diff --git a/Strata/Languages/Laurel/CoreGroupingAndOrdering.lean b/Strata/Languages/Laurel/CoreGroupingAndOrdering.lean index f75057d88f..9efe14f0cf 100644 --- a/Strata/Languages/Laurel/CoreGroupingAndOrdering.lean +++ b/Strata/Languages/Laurel/CoreGroupingAndOrdering.lean @@ -5,9 +5,10 @@ -/ module -public import Strata.Languages.Laurel.Laurel +public import Strata.Languages.Laurel.TransparencyPass import Strata.DL.Lambda.LExpr import Strata.DDM.Util.Graph.Tarjan +import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator /-! ## Grouping and Ordering for Core Translation @@ -15,8 +16,6 @@ import Strata.DDM.Util.Graph.Tarjan Utilities for computing the grouping and topological ordering of Laurel declarations before they are emitted as Strata Core declarations. -- `groupDatatypesByScc` — groups mutually recursive datatypes into SCC groups - using Tarjan's SCC algorithm. - `computeSccDecls` — builds the procedure call graph, runs Tarjan's SCC algorithm, and returns each SCC as a list of procedures paired with a flag indicating whether the SCC is recursive. The result is in reverse topological @@ -90,7 +89,7 @@ def collectStaticCallNames (expr : StmtExprMd) : List String := | .InstanceCall t _ args => collectStaticCallNames t ++ args.flatMap (fun a => collectStaticCallNames a) | .Old v | .Fresh v | .Assume v => collectStaticCallNames v - | .Assert ⟨cond, _summary⟩ => collectStaticCallNames cond + | .Assert ⟨cond, _summary, _⟩ => collectStaticCallNames cond | .ProveBy v p => collectStaticCallNames v ++ collectStaticCallNames p | .ReferenceEquals l r => collectStaticCallNames l ++ collectStaticCallNames r | .AsType t _ | .IsType t _ => collectStaticCallNames t @@ -113,27 +112,24 @@ Build the procedure call graph, run Tarjan's SCC algorithm, and return each SCC as a list of procedures paired with a flag indicating whether the SCC is recursive. Results are in reverse topological order: dependencies before dependents. -Procedures with an `invokeOn` trigger are placed as early as possible — before -unrelated procedures without one — by stably partitioning them first before building +Procedures with axioms are placed as early as possible — before +unrelated procedures without them — by stably partitioning them first before building the graph. Tarjan then naturally assigns them lower indices, causing them to appear earlier in the output. - -External procedures are excluded. -/ -public def computeSccDecls (program : Program) : List (List Procedure × Bool) := - -- External procedures are completely ignored (not translated to Core). - -- Stable partition: procedures with invokeOn come first, preserving relative +public def computeSccDecls (program : UnorderedCoreWithLaurelTypes) : List (List Procedure × Bool) := + -- Stable partition: procedures with axioms come first, preserving relative -- order within each group. Tarjan then places them earlier in the topological output. - let (withInvokeOn, withoutInvokeOn) := - (program.staticProcedures.filter (fun p => !p.body.isExternal)) - |>.partition (fun p => p.invokeOn.isSome) - let nonExternal : List Procedure := withInvokeOn ++ withoutInvokeOn + let allProcs := program.functions ++ program.coreProcedures + let (withAxioms, withoutAxioms) := + allProcs.partition (fun p => !p.axioms.isEmpty) + let orderedProcs : List Procedure := withAxioms ++ withoutAxioms - -- Build a call-graph over all non-external procedures. + -- Build a call-graph over all procedures. -- An edge proc → callee means proc's body/contracts contain a StaticCall to callee. - let nonExternalArr : Array Procedure := nonExternal.toArray + let procsArr : Array Procedure := orderedProcs.toArray let nameToIdx : Std.HashMap String Nat := - nonExternalArr.foldl (fun (acc : Std.HashMap String Nat × Nat) proc => + procsArr.foldl (fun (acc : Std.HashMap String Nat × Nat) proc => (acc.1.insert proc.name.text acc.2, acc.2 + 1)) ({}, 0) |>.1 -- Collect all callee names from a procedure's body and contracts. @@ -145,13 +141,14 @@ public def computeSccDecls (program : Program) : List (List Procedure × Bool) : | _ => [] let contractExprs : List StmtExprMd := proc.preconditions.map (·.condition) ++ - proc.invokeOn.toList + proc.invokeOn.toList ++ + proc.axioms (bodyExprs ++ contractExprs).flatMap collectStaticCallNames -- Build the OutGraph for Tarjan. - let n := nonExternalArr.size + let n := procsArr.size let graph : Strata.OutGraph n := - nonExternalArr.foldl (fun (acc : Strata.OutGraph n × Nat) proc => + procsArr.foldl (fun (acc : Strata.OutGraph n × Nat) proc => let callerIdx := acc.2 let g := acc.1 let callees := procCallees proc @@ -167,7 +164,7 @@ public def computeSccDecls (program : Program) : List (List Procedure × Bool) : sccs.toList.filterMap fun scc => let procs := scc.toList.filterMap fun idx => - nonExternalArr[idx.val]? + procsArr[idx.val]? if procs.isEmpty then none else let isRecursive := procs.length > 1 || (match scc.toList.head? with @@ -176,60 +173,85 @@ public def computeSccDecls (program : Program) : List (List Procedure × Bool) : some (procs, isRecursive) /-- -A single declaration in an ordered Laurel program. Declarations are in +A single declaration in a CoreWithLaurelTypes program. Declarations are in dependency order (dependencies before dependents). -/ public inductive OrderedDecl where - /-- A group of functions (single non-recursive, or mutually recursive). -/ - | procs (procs : List Procedure) (isRecursive : Bool) + /-- A group of functions (single non-recursive, or mutually recursive). + Invariant: `funcs.length > 1 → isRecursive = true`. -/ + | funcs (funcs : List Procedure) (isRecursive : Bool) + /-- A single (non-functional) procedure. -/ + | procedure (procedure : Procedure) /-- A group of (possibly mutually recursive) datatypes. -/ | datatypes (dts : List DatatypeDefinition) /-- A named constant. -/ | constant (c : Constant) /-- -A Laurel program whose declarations have been grouped and topologically ordered. -Produced by `orderProgram` from a `Program`. +A program whose declarations have been grouped and topologically ordered, +using Laurel types. Produced by `orderFunctionsAndProofs` from a +`UnorderedCoreWithLaurelTypes`. -/ -public structure OrderedLaurel where +public structure CoreWithLaurelTypes where decls : List OrderedDecl -/-- -Group mutually recursive datatypes into SCC groups using Tarjan's SCC algorithm. -Returns groups in topological order (dependencies before dependents). --/ -public def groupDatatypesByScc (program : Program) : List (List DatatypeDefinition) := - let laurelDatatypes := program.types.filterMap fun td => match td with - | .Datatype dt => some dt - | _ => none - let n := laurelDatatypes.length - if n == 0 then [] else - let nameToIdx : Std.HashMap String Nat := - laurelDatatypes.foldlIdx (fun m i dt => m.insert dt.name.text i) {} - let edges : List (Nat × Nat) := - laurelDatatypes.foldlIdx (fun acc i dt => - (datatypeRefs dt).filterMap nameToIdx.get? |>.foldl (fun acc j => (j, i) :: acc) acc) [] - let g := OutGraph.ofEdges! n edges - let dtsArr := laurelDatatypes.toArray - OutGraph.tarjan g |>.toList.filterMap fun comp => - let members := comp.toList.filterMap fun idx => dtsArr[idx]? - if members.isEmpty then none else some members +open Std (Format ToFormat) -/-- -Group procedures into SCC groups and wrap them as `OrderedDecl.procs`. --/ -public def groupProcsByScc (program : Program) : List OrderedDecl := - (computeSccDecls program).map fun (procs, isRecursive) => - OrderedDecl.procs procs isRecursive +public section + +def formatOrderedDecl : OrderedDecl → Format + | .funcs funcs _ => Format.joinSep (funcs.map ToFormat.format) "\n\n" + | .procedure proc => ToFormat.format proc + | .datatypes dts => Format.joinSep (dts.map ToFormat.format) "\n\n" + | .constant c => ToFormat.format c + +instance : ToFormat OrderedDecl where + format := formatOrderedDecl + +def formatCoreWithLaurelTypes (p : CoreWithLaurelTypes) : Format := + Format.joinSep (p.decls.map formatOrderedDecl) "\n\n" + +instance : ToFormat CoreWithLaurelTypes where + format := formatCoreWithLaurelTypes + +end -- public section /-- -Produce an `OrderedLaurel` from a `Program` by grouping and ordering -procedures via SCC, collecting datatypes, and constants. +Produce a `CoreWithLaurelTypes` from a `UnorderedCoreWithLaurelTypes` by +computing a combined ordering of functions and proofs using the call graph, +then collecting datatypes and constants. + +Functions are grouped into SCCs (for mutual recursion). Proofs are emitted +as individual `procedure` decls. Both participate in the topological ordering +so that axioms are available to functions that need them. -/ -public def orderProgram (program : Program) : OrderedLaurel := - let datatypeDecls := (groupDatatypesByScc program).map OrderedDecl.datatypes +public def orderFunctionsAndProofs (program : UnorderedCoreWithLaurelTypes) : CoreWithLaurelTypes := + let datatypeDecls := (groupDatatypesByScc' program).map OrderedDecl.datatypes let constantDecls := program.constants.map OrderedDecl.constant - let procDecls := groupProcsByScc program - { decls := datatypeDecls ++ constantDecls ++ procDecls } + let funcNames : Std.HashSet String := + program.functions.foldl (fun s p => s.insert p.name.text) {} + let orderedDecls := (computeSccDecls program).flatMap fun (procs, isRecursive) => + -- Split the SCC into functions and proofs + let (funcs, proofs) := procs.partition (fun p => funcNames.contains p.name.text) + let funcDecl := if funcs.isEmpty then [] else [OrderedDecl.funcs funcs isRecursive] + let proofDecls := proofs.map OrderedDecl.procedure + funcDecl ++ proofDecls + { decls := datatypeDecls ++ constantDecls ++ orderedDecls } +where + /-- Group datatypes from a UnorderedCoreWithLaurelTypes by SCC. -/ + groupDatatypesByScc' (program : UnorderedCoreWithLaurelTypes) : List (List DatatypeDefinition) := + let laurelDatatypes := program.datatypes + let n := laurelDatatypes.length + if n == 0 then [] else + let nameToIdx : Std.HashMap String Nat := + laurelDatatypes.foldlIdx (fun m i dt => m.insert dt.name.text i) {} + let edges : List (Nat × Nat) := + laurelDatatypes.foldlIdx (fun acc i dt => + (datatypeRefs dt).filterMap nameToIdx.get? |>.foldl (fun acc j => (j, i) :: acc) acc) [] + let g := OutGraph.ofEdges! n edges + let dtsArr := laurelDatatypes.toArray + OutGraph.tarjan g |>.toList.filterMap fun comp => + let members := comp.toList.filterMap fun idx => dtsArr[idx]? + if members.isEmpty then none else some members end Strata.Laurel diff --git a/Strata/Languages/Laurel/DesugarShortCircuit.lean b/Strata/Languages/Laurel/DesugarShortCircuit.lean index 6f4e9c5218..107a623c68 100644 --- a/Strata/Languages/Laurel/DesugarShortCircuit.lean +++ b/Strata/Languages/Laurel/DesugarShortCircuit.lean @@ -26,7 +26,7 @@ public section private def bare (v : StmtExpr) : StmtExprMd := ⟨v, none⟩ /-- Local rewrite of a single short-circuit node. Recursion is handled by `mapStmtExpr`. -/ -private def desugarShortCircuitNode (model : SemanticModel) (expr : StmtExprMd) : StmtExprMd := +private def desugarShortCircuitNode (imperativeCallees : List String) (expr : StmtExprMd) : StmtExprMd := let source := expr.source match expr.val with | .PrimitiveOp op args => @@ -35,12 +35,12 @@ private def desugarShortCircuitNode (model : SemanticModel) (expr : StmtExprMd) -- short-circuits converted to IfThenElse). The check still works because -- `containsAssignmentOrImperativeCall` recurses into IfThenElse. | .AndThen, [a, b] | .Implies, [a, b] => - if containsAssignmentOrImperativeCall model b then + if containsAssignmentOrImperativeCall imperativeCallees b then let elseVal := match op with | .AndThen => false | _ => true ⟨.IfThenElse a b (some (bare (.LiteralBool elseVal))), source⟩ else expr | .OrElse, [a, b] => - if containsAssignmentOrImperativeCall model b then + if containsAssignmentOrImperativeCall imperativeCallees b then ⟨.IfThenElse a (bare (.LiteralBool true)) (some b), source⟩ else expr | _, _ => expr @@ -48,7 +48,9 @@ private def desugarShortCircuitNode (model : SemanticModel) (expr : StmtExprMd) /-- Desugar short-circuit operators in a program. -/ def desugarShortCircuit (model : SemanticModel) (program : Program) : Program := - mapProgram (mapStmtExpr (desugarShortCircuitNode model)) program + let imperativeCallees := program.staticProcedures.filter (fun p => !p.isFunctional) + |>.map (fun p => p.name.text) + mapProgram (mapStmtExpr (desugarShortCircuitNode imperativeCallees)) program end -- public section end Strata.Laurel diff --git a/Strata/Languages/Laurel/EliminateMultipleOutputs.lean b/Strata/Languages/Laurel/EliminateMultipleOutputs.lean new file mode 100644 index 0000000000..ae932c9b7e --- /dev/null +++ b/Strata/Languages/Laurel/EliminateMultipleOutputs.lean @@ -0,0 +1,166 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.Languages.Laurel.TransparencyPass + +/-! +# Eliminate Multiple Outputs + +Transforms bodiless functions with multiple outputs into functions that return +a single synthesized result datatype. Call sites are rewritten to destructure +the result using the generated accessors. + +This pass operates on `UnorderedCoreWithLaurelTypes → UnorderedCoreWithLaurelTypes`. +-/ + +namespace Strata.Laurel + +public section + + +private def mkMd (e : StmtExpr) : StmtExprMd := { val := e, source := none } +private def mkVarMd (v : Variable) : VariableMd := { val := v, source := none } +private def mkTy (t : HighType) : HighTypeMd := { val := t, source := none } + +/-- Info about a function whose multiple outputs have been collapsed into a result datatype. -/ +private structure MultiOutInfo where + funcName : String + resultTypeName : String + constructorName : String + /-- Original output parameters (name, type). -/ + outputs : List Parameter + /-- Number of input parameters (used to detect implicit heap args at call sites). -/ + inputCount : Nat + +/-- Identify bodiless functions with multiple outputs and build info records. -/ +private def collectMultiOutFunctions (funcs : List Procedure) : List MultiOutInfo := + funcs.filterMap fun f => + if f.outputs.length > 1 && !f.body.isTransparent then + some { + funcName := f.name.text + resultTypeName := s!"{f.name.text}$result" + constructorName := s!"{f.name.text}$result$mk" + outputs := f.outputs + inputCount := f.inputs.length + } + else none + +/-- Generate a result datatype for a multi-output function. -/ +private def mkResultDatatype (info : MultiOutInfo) : DatatypeDefinition := + let args := info.outputs.zipIdx.map fun (p, i) => + { name := mkId s!"out{i}", type := p.type : Parameter } + { name := mkId info.resultTypeName + typeArgs := [] + constructors := [{ name := mkId info.constructorName, args := args }] } + +/-- Transform a multi-output function to return the result datatype. -/ +private def transformFunction (info : MultiOutInfo) (proc : Procedure) : Procedure := + let resultOutput : Parameter := + { name := mkId "$result", type := mkTy (.UserDefined (mkId info.resultTypeName)) } + { proc with outputs := [resultOutput] } + +/-- Destructor name for field `outN` of the result datatype. -/ +private def destructorName (info : MultiOutInfo) (idx : Nat) : String := + s!"{info.resultTypeName}..out{idx}" + +/-- Check whether a statement is an Assume node. -/ +private def isAssume (stmt : StmtExprMd) : Bool := + match stmt.val with + | .Assume _ => true + | _ => false + +/-- Rewrite a single multi-output Assign into a temp declaration + destructuring + assignments. Any `Assume` statements from `following` that appear immediately + after the call are collected and placed after the destructuring assignments, + so they observe the post-call variable values. + Returns the rewritten statements and the number of consumed following statements. -/ +private def rewriteAssign (infoMap : Std.HashMap String MultiOutInfo) + (targets : List VariableMd) (callee : Identifier) (args : List StmtExprMd) + (callSrc : Option FileRange) + (following : List StmtExprMd) (counter : Nat) : Option (List StmtExprMd × Nat) := + match infoMap.get? callee.text with + | some info => + if targets.length ≤ info.outputs.length then + let tempName := s!"${callee.text}$temp{counter}" + let fullArgs := args + let tempDecl := mkMd (.Assign [mkVarMd (.Declare ⟨mkId tempName, mkTy (.UserDefined (mkId info.resultTypeName))⟩)] + ⟨.StaticCall callee fullArgs, callSrc⟩) + let assigns := targets.zipIdx.map fun (tgt, i) => + mkMd (.Assign [tgt] + (mkMd (.StaticCall (mkId (destructorName info i)) + [mkMd (.Var (.Local (mkId tempName)))]))) + -- Collect any Assume statements that immediately follow the call. + -- These are placed after the destructuring assignments so they + -- observe the post-call values of output variables. + let assumes := following.takeWhile isAssume + let consumed := assumes.length + some (tempDecl :: assigns ++ assumes, consumed) + else none + | none => none + +/-- Rewrite a statement list, replacing multi-output call patterns. + When a multi-output Assign is followed by Assume statements (inserted by + the contract pass), the Assumes are placed after the destructuring + assignments so they reference post-call variable values. -/ +private def rewriteStmts (infoMap : Std.HashMap String MultiOutInfo) + (stmts : List StmtExprMd) : List StmtExprMd := + let rec go (remaining : List StmtExprMd) (acc : List StmtExprMd) (counter : Nat) : List StmtExprMd := + match remaining with + | [] => acc.reverse + | stmt :: rest => + match stmt.val with + | .Assign targets ⟨.StaticCall callee args, callSrc⟩ => + match rewriteAssign infoMap targets callee args callSrc rest counter with + | some (expanded, consumed) => go (rest.drop consumed) (expanded.reverse ++ acc) (counter + 1) + | none => go rest (stmt :: acc) counter + | _ => go rest (stmt :: acc) counter + termination_by remaining.length + go stmts [] 0 + +/-- Rewrite blocks in a StmtExprMd tree to handle multi-output calls. -/ +private def rewriteExpr (infoMap : Std.HashMap String MultiOutInfo) + (expr : StmtExprMd) : StmtExprMd := + mapStmtExpr (fun e => + match e.val with + | .Block stmts label => ⟨.Block (rewriteStmts infoMap stmts) label, e.source⟩ + | _ => e) expr + +/-- Rewrite all procedure bodies. -/ +private def rewriteProcedure (infoMap : Std.HashMap String MultiOutInfo) + (proc : Procedure) : Procedure := + match proc.body with + | .Transparent b => + -- Wrap in a block so rewriteStmts can process top-level statements + let wrapped := mkMd (.Block [b] none) + let rewritten := rewriteExpr infoMap wrapped + { proc with body := .Transparent rewritten } + | .Opaque posts (some impl) mods => + let wrapped := mkMd (.Block [impl] none) + let rewritten := rewriteExpr infoMap wrapped + { proc with body := .Opaque posts (some rewritten) mods } + | _ => proc + +/-- Eliminate multiple outputs from a UnorderedCoreWithLaurelTypes. -/ +def eliminateMultipleOutputs (program : UnorderedCoreWithLaurelTypes) + : UnorderedCoreWithLaurelTypes := + let infos := collectMultiOutFunctions program.functions + if infos.isEmpty then program else + let infoMap : Std.HashMap String MultiOutInfo := + infos.foldl (fun m info => m.insert info.funcName info) {} + let newDatatypes := infos.map mkResultDatatype + let functions := program.functions.map fun f => + match infoMap.get? f.name.text with + | some info => rewriteProcedure infoMap (transformFunction info f) + | none => rewriteProcedure infoMap f + let coreProcedures := program.coreProcedures.map fun p => rewriteProcedure infoMap p + { program with + functions := functions + coreProcedures := coreProcedures + datatypes := program.datatypes ++ newDatatypes } + +end -- public section +end Strata.Laurel diff --git a/Strata/Languages/Laurel/EliminateReturnStatements.lean b/Strata/Languages/Laurel/EliminateReturnStatements.lean new file mode 100644 index 0000000000..61baa300a1 --- /dev/null +++ b/Strata/Languages/Laurel/EliminateReturnStatements.lean @@ -0,0 +1,67 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.Languages.Laurel.MapStmtExpr + +/-! +# Eliminate Return Statements + +Replaces `return` statements in imperative procedure bodies with assignments +to the output parameters followed by an `exit` to a labelled block that wraps +the entire body. This ensures that code placed after the body block (e.g., +postcondition assertions inserted by the contract pass) is always reached. + +This pass should run after `EliminateReturnsInExpression` (which handles +functional/expression-position returns) and before the contract pass. +-/ + +namespace Strata.Laurel + +public section + +private def returnLabel : String := "$return" + + + +private def mkMd (e : StmtExpr) : StmtExprMd := { val := e, source := none } +private def mkVarMd (v : Variable) : VariableMd := { val := v, source := none } + +/-- Replace `Return val` with `output := val; exit "$return"` (or just `exit` + for valueless returns). Uses `mapStmtExpr` for bottom-up traversal. -/ +private def replaceReturn (outputs : List Parameter) (expr : StmtExprMd) : StmtExprMd := + mapStmtExpr (fun e => + match e.val with + | .Return (some val) => + match outputs with + | [out] => + let assign := mkMd (.Assign [mkVarMd (.Local out.name)] val) + let exit := mkMd (.Exit returnLabel) + ⟨.Block [assign, exit] none, e.source⟩ + | _ => mkMd (.Exit returnLabel) + | .Return none => mkMd (.Exit returnLabel) + | _ => e) expr + +/-- Transform a single procedure: wrap body in a labelled block and replace returns. -/ +private def eliminateReturnStmts (proc : Procedure) : Procedure := + match proc.body with + | .Opaque postconds (some impl) mods => + let impl' := replaceReturn proc.outputs impl + let wrapped := mkMd (.Block [impl'] (some returnLabel)) + { proc with body := .Opaque postconds (some wrapped) mods } + | .Transparent body => + let body' := replaceReturn proc.outputs body + let wrapped := mkMd (.Block [body'] (some returnLabel)) + { proc with body := .Transparent wrapped } + | _ => proc + +/-- Transform a program by eliminating return statements in all procedure bodies. -/ +def eliminateReturnStatements (program : Program) : Program := + { program with staticProcedures := program.staticProcedures.map eliminateReturnStmts } + +end -- public section + +end Strata.Laurel diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean index 02e2159643..c185d90edc 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean @@ -9,7 +9,7 @@ module -- Laurel dialect definition, loaded from LaurelGrammar.st -- 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. +-- Last grammar change: block format uses indent(2) with leading spaces for vertical layout. public import Strata.DDM.Integration.Lean public meta import Strata.DDM.Integration.Lean diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st index b81b0d8b11..5ddc8609f5 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st @@ -106,8 +106,8 @@ op ifThenElse (cond: StmtExpr, thenBranch: StmtExpr, elseBranch: Option ElseBran op assert (cond : StmtExpr, errorMessage: Option ErrorSummary) : StmtExpr => @[prec(0)] "assert " cond:0 errorMessage:0; op assume (cond : StmtExpr) : StmtExpr => @[prec(0)] "assume " cond:0; op return (value : StmtExpr) : StmtExpr => @[prec(0)] "return " value:0; -op block (stmts : SemicolonSepBy StmtExpr) : StmtExpr => @[prec(1000)] "{ " stmts " }"; -op labelledBlock (stmts : SemicolonSepBy StmtExpr, label : Ident) : StmtExpr => @[prec(1000)] "{ " stmts " }" label; +op block (stmts : SemicolonSepBy StmtExpr) : StmtExpr => @[prec(1000)] "{\n " indent(2, stmts) "\n}"; +op labelledBlock (stmts : SemicolonSepBy StmtExpr, label : Ident) : StmtExpr => @[prec(1000)] "{\n " indent(2, stmts) "\n}" label; op exit (label : Ident) : StmtExpr => @[prec(0)] "exit " label; // While loops diff --git a/Strata/Languages/Laurel/HeapParameterization.lean b/Strata/Languages/Laurel/HeapParameterization.lean index fecaf5350c..0f99750037 100644 --- a/Strata/Languages/Laurel/HeapParameterization.lean +++ b/Strata/Languages/Laurel/HeapParameterization.lean @@ -84,7 +84,7 @@ def collectExpr (expr : StmtExpr) : StateM AnalysisResult Unit := do | .Assigned n => collectExprMd n | .Old v => collectExprMd v | .Fresh v => collectExprMd v - | .Assert ⟨c, _⟩ => collectExprMd c + | .Assert ⟨c, _, _⟩ => collectExprMd c | .Assume c => collectExprMd c | .ProveBy v p => collectExprMd v; collectExprMd p | .ContractOf _ f => collectExprMd f @@ -315,7 +315,11 @@ where let isLast := idx == n - 1 let s' ← recurse s (isLast && valueUsed) let rest' ← processStmts (idx + 1) rest - pure (s' :: rest') + -- Flatten unlabeled blocks returned by recurse so that + -- Declare targets remain in the enclosing scope. + match s'.val with + | .Block innerStmts none => pure (innerStmts ++ rest') + | _ => pure (s' :: rest') termination_by sizeOf remaining let stmts' ← processStmts 0 stmts return ⟨ .Block stmts' label, source ⟩ @@ -429,8 +433,8 @@ where | .Assigned n => return ⟨ .Assigned (← recurse n), source ⟩ | .Old v => return ⟨ .Old (← recurse v), source ⟩ | .Fresh v => return ⟨ .Fresh (← recurse v), source ⟩ - | .Assert ⟨condExpr, summary⟩ => - return ⟨ .Assert { condition := ← recurse condExpr, summary }, source ⟩ + | .Assert ⟨condExpr, summary, free⟩ => + return ⟨ .Assert { condition := ← recurse condExpr, summary, free }, 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 ⟩ @@ -561,10 +565,17 @@ def heapParameterization (model: SemanticModel) (program : Program) : Program := ([], state1) -- Generate Box datatype from all constructors used during transformation let boxDatatype : TypeDefinition := - .Datatype { name := "Box", typeArgs := [], constructors := state2.usedBoxConstructors } + .Datatype { + name := "Box", typeArgs := [], constructors := state2.usedBoxConstructors } + + let types := fieldDatatype :: boxDatatype :: heapConstants.types ++ + -- The filter is a hack to deal with another hack, + -- the box that was added in CoreDefinitionsForLaurel.lean + -- because Laurel does not support polymorphism yet + types'.filter (fun td => td.name.text != "Box") { program with staticProcedures := heapConstants.staticProcedures ++ procs', - types := fieldDatatype :: boxDatatype :: heapConstants.types ++ types' } + types } end Strata.Laurel diff --git a/Strata/Languages/Laurel/InferHoleTypes.lean b/Strata/Languages/Laurel/InferHoleTypes.lean index d56ad86881..c184995e35 100644 --- a/Strata/Languages/Laurel/InferHoleTypes.lean +++ b/Strata/Languages/Laurel/InferHoleTypes.lean @@ -139,9 +139,10 @@ private def inferExpr (expr : StmtExprMd) (expectedType : HighTypeMd) : InferHol | some d => pure (some (← inferExpr d (⟨ .TInt, source ⟩))) | none => pure none return ⟨.While (← inferExpr cond ⟨ .TBool, source ⟩) (← invs.mapM (inferExpr · ⟨ .TBool, source ⟩)) dec' (← inferExpr body ⟨ .TVoid, source⟩), source⟩ - | .Assert ⟨condExpr, summary⟩ => - return ⟨.Assert { condition := ← inferExpr condExpr ⟨ .TBool, source ⟩, summary }, source⟩ - | .Assume cond => return ⟨.Assume (← inferExpr cond ⟨ .TBool, source ⟩), source⟩ + | .Assert ⟨condExpr, summary, free⟩ => + return ⟨.Assert { condition := ← inferExpr condExpr ⟨ .TBool, source ⟩, summary, free }, source⟩ + | .Assume cond => + return ⟨.Assume (← inferExpr cond ⟨ .TBool, source ⟩), source⟩ | .Return (some retExpr) => return ⟨.Return (some (← inferExpr retExpr (← get).currentOutputType)), source⟩ | .Old v => return ⟨.Old (← inferExpr v expectedType), source⟩ @@ -170,6 +171,7 @@ private def inferProcedure (proc : Procedure) : InferHoleM Procedure := do /-- Annotate every `.Hole` in the program with a type inferred from context. +Returns the updated program and any diagnostics (e.g. holes whose type could not be inferred). -/ def inferHoleTypes (model : SemanticModel) (program : Program) : Program × List DiagnosticModel × Statistics := let initState : InferHoleState := { model := model, currentOutputType := { val := .Unknown, source := none }} diff --git a/Strata/Languages/Laurel/InlineLocalVariablesInExpressions.lean b/Strata/Languages/Laurel/InlineLocalVariablesInExpressions.lean new file mode 100644 index 0000000000..0e311bdc11 --- /dev/null +++ b/Strata/Languages/Laurel/InlineLocalVariablesInExpressions.lean @@ -0,0 +1,83 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.Languages.Laurel.MapStmtExpr +public import Strata.Languages.Laurel.TransparencyPass +import Strata.Util.Tactics + +/-! +# Inline Local Variables in Expression Position + +Replaces local variable declarations in functional procedure bodies with +direct substitution of the initializer into the remaining statements of +the block. This eliminates `LocalVariable` nodes from expression contexts +so the Core translator does not need to handle let-bindings in expressions. + +Example: +``` +function f() returns (r: int) { + var x: int := 1; + var y: int := x + 1; + y +} +``` +becomes: +``` +function f() returns (r: int) { + 0 + 1 +} +``` +-/ + +namespace Strata.Laurel + +public section + +/-- Substitute all occurrences of local variable `name` with `replacement` in `expr`. -/ +private def substIdentifier (name : Identifier) (replacement : StmtExprMd) (expr : StmtExprMd) + : StmtExprMd := + mapStmtExpr (fun e => + match e.val with + | .Var (.Local n) => if n == name then replacement else e + | _ => e) expr + +/-- Inline initialized local variables in a block, substituting their + initializers into the remaining statements. Non-Assign/Declare + statements are kept as-is. -/ +private def inlineLocalsInStmts (stmts : List StmtExprMd) : List StmtExprMd := + match stmts with + | [] => [] + | ⟨.Assign [⟨.Declare parameter, _⟩] initializer, _⟩ :: rest => + let rest' := rest.map (substIdentifier parameter.name initializer) + inlineLocalsInStmts rest' + | s :: rest => s :: inlineLocalsInStmts rest +termination_by stmts.length + +/-- Rewrite a single node: if it is a Block, inline any LocalVariable + declarations. Recursion into children is handled by `mapStmtExpr`. -/ +private def inlineLocalsNode (expr : StmtExprMd) : StmtExprMd := + match expr.val with + | .Block stmts label => + let stmts' := inlineLocalsInStmts stmts + match stmts' with + | [single] => single + | _ => ⟨.Block stmts' label, expr.source⟩ + | _ => expr + +/-- Apply local-variable inlining to all functional procedure bodies. -/ +def inlineLocalVariablesInExpressions (program : UnorderedCoreWithLaurelTypes) : UnorderedCoreWithLaurelTypes := + { program with functions := program.functions.map fun proc => + match proc.body with + | .Transparent body => + { proc with body := .Transparent (mapStmtExpr inlineLocalsNode body) } + | .Opaque postconds (some impl) modif => + { proc with body := .Opaque postconds (some (mapStmtExpr inlineLocalsNode impl)) modif } + | _ => proc + } + +end -- public section +end Strata.Laurel diff --git a/Strata/Languages/Laurel/Laurel.lean b/Strata/Languages/Laurel/Laurel.lean index a5cd11439c..a192f6d50c 100644 --- a/Strata/Languages/Laurel/Laurel.lean +++ b/Strata/Languages/Laurel/Laurel.lean @@ -200,6 +200,9 @@ structure Procedure : Type where whose body is the ensures clause universally quantified over the procedure's inputs, with this expression as the SMT trigger. -/ invokeOn : Option (AstNode StmtExpr) := none + /-- Axioms to emit alongside this procedure. Populated by the contract pass from + `invokeOn` and ensures clauses. -/ + axioms : List (AstNode StmtExpr) := [] /-- A typed parameter for a procedure. @@ -219,6 +222,11 @@ structure Condition where condition : AstNode StmtExpr /-- Optional human-readable summary describing the property being checked. -/ summary : Option String := none + /-- When `true`, this condition is *free*: assumed but not checked. + A free precondition is assumed by the implementation but not asserted at + call sites. A free postcondition is assumed upon return from calls but + not checked on exit from implementations. -/ + free : Bool := false /-- The body of a procedure. A body can be transparent (with a visible diff --git a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean index c6984120fe..4c3a5387e7 100644 --- a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean +++ b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean @@ -8,8 +8,12 @@ module public import Strata.Languages.Laurel.LaurelToCoreTranslator import Strata.Languages.Laurel.DesugarShortCircuit import Strata.Languages.Laurel.EliminateReturnsInExpression +import Strata.Languages.Laurel.EliminateReturnStatements import Strata.Languages.Laurel.EliminateValueReturns +import Strata.Languages.Laurel.InlineLocalVariablesInExpressions import Strata.Languages.Laurel.ConstrainedTypeElim +import Strata.Languages.Laurel.ContractPass +import Strata.Languages.Laurel.EliminateMultipleOutputs import Strata.Languages.Laurel.TypeAliasElim import Strata.Languages.Core.Verifier import Strata.Util.Profile @@ -24,9 +28,10 @@ to Strata Core. The pipeline is: 1. Prepend core definitions for Laurel. 2. Run a sequence of Laurel-to-Laurel lowering passes (resolution, heap parameterization, type hierarchy, modifies clauses, hole inference, - desugaring, lifting, constrained type elimination). -3. Group and order declarations into an `OrderedLaurel`. -4. Translate the `OrderedLaurel` to a `Core.Program`. + desugaring, lifting, constrained type elimination, contract pass). +3. Run the transparency pass to produce an `UnorderedCoreWithLaurelTypes`. +4. Group and order declarations into a `CoreWithLaurelTypes`. +5. Translate the `CoreWithLaurelTypes` to a `Core.Program`. -/ open Core (VCResult VCResults VerifyOptions) @@ -124,7 +129,7 @@ private def laurelPipeline : Array LaurelPass := #[ (desugarShortCircuit m p, [], {}) }, { name := "LiftExpressionAssignments" run := fun p m => - (liftExpressionAssignments m p, [], {}) }, + (liftExpressionAssignments p m [], [], {}) }, { name := "EliminateReturns" needsResolves := true run := fun p _m => @@ -184,8 +189,90 @@ private def runLaurelPasses (options : LaurelTranslateOptions) (program : Progra model := result.model emit pass.name "laurel.st" program + program := eliminateReturnStatements program + emit "EliminateReturnStatements" "laurel.st" program + + -- Capture resolution error count before contractPass so we only detect + -- errors introduced by contractPass itself, not by earlier passes. + let preContractResolutionErrorCount := (resolve program (some model)).errors.size + + program := contractPass program + emit "contractPass" "core.st" program + + -- Check if contractPass introduced new resolution errors. + let finalResolutionErrors := (resolve program (some model)).errors + let newResolutionErrors : List DiagnosticModel := + if finalResolutionErrors.size > preContractResolutionErrorCount then + let newCount := finalResolutionErrors.size - preContractResolutionErrorCount + let firstNew := finalResolutionErrors.toList.drop preContractResolutionErrorCount + |>.head?.map (·.message) |>.getD "unknown" + [DiagnosticModel.fromMessage + s!"Strata bug: {newCount} new resolution error(s) introduced by pipeline passes. First new error: {firstNew}" + DiagnosticType.StrataBug] + else [] + + allDiags := allDiags ++ newResolutionErrors return (program, model, allDiags, allStats) +/-- +Convert an `UnorderedCoreWithLaurelTypes` to a flat `Program` suitable for +resolution and program-level passes. Composite types from the original Laurel +program are included so that references to composite types resolve correctly. +-/ +private def toProgram (uc : UnorderedCoreWithLaurelTypes) (laurelProgram : Program) + : Program := + { staticProcedures := uc.functions ++ uc.coreProcedures, + staticFields := [], + types := uc.datatypes.map TypeDefinition.Datatype ++ + -- Hack to compensate for references to composite types not having been updated yet. + laurelProgram.types.filter (fun t => match t with | .Composite _ => true | _ => false), + constants := uc.constants } + +/-- +Reconstruct an `UnorderedCoreWithLaurelTypes` from a resolved `Program`, +preserving the structure of the original `UnorderedCoreWithLaurelTypes`. +-/ +private def fromResolvedProgram (resolvedProgram : Program) + (_original : UnorderedCoreWithLaurelTypes) : UnorderedCoreWithLaurelTypes := + let resolvedProcs := resolvedProgram.staticProcedures + let resolvedDatatypes := resolvedProgram.types.filterMap fun td => + match td with | .Datatype dt => some dt | _ => none + { functions := resolvedProcs.filter (·.isFunctional) + coreProcedures := resolvedProcs.filter (!·.isFunctional) + datatypes := resolvedDatatypes + constants := resolvedProgram.constants } + +/-- +Resolve an `UnorderedCoreWithLaurelTypes` by converting to a flat `Program`, +running the resolution pass, and reconstructing the result. Returns the +resolved `UnorderedCoreWithLaurelTypes` and the `SemanticModel`. +-/ +def resolveUnorderedCore (uc : UnorderedCoreWithLaurelTypes) + (laurelProgram : Program) (existingModel : Option SemanticModel := none) + : UnorderedCoreWithLaurelTypes × SemanticModel := + let fnProgram := toProgram uc laurelProgram + let fnResolveResult := resolve fnProgram existingModel + (fromResolvedProgram fnResolveResult.program uc, fnResolveResult.model) + +/-- +Apply `liftExpressionAssignments` to the core (non-functional) procedures in an +`UnorderedCoreWithLaurelTypes`. Only procedures whose names appear in the core +procedure list are transformed; functions are left unchanged. +-/ +def liftImperativeExpressionsInCore (uc : UnorderedCoreWithLaurelTypes) + (model : SemanticModel) : UnorderedCoreWithLaurelTypes := + let imperativeCallees := uc.coreProcedures.map (·.name.text) + if imperativeCallees.isEmpty then uc + else + let allProcs := uc.functions ++ uc.coreProcedures + let liftedProgram := liftExpressionAssignments + { staticProcedures := allProcs, staticFields := [], types := [], constants := [] } + model imperativeCallees + let liftedProcs := liftedProgram.staticProcedures + { uc with + functions := liftedProcs.filter (·.isFunctional) + coreProcedures := liftedProcs.filter (!·.isFunctional) } + /-- Translate Laurel Program to Core Program, also returning the lowered Laurel program. @@ -195,24 +282,47 @@ Laurel-to-Laurel pass is written to `{prefix}.{n}.{passName}.laurel.st`. def translateWithLaurel (options : LaurelTranslateOptions) (program : Program) : IO TranslateResultWithLaurel := runPipelineM options.keepAllFilesPrefix do - let (program, model, passDiags, stats) ← runLaurelPasses options program - let ordered := orderProgram program - - -- This early return is a simple way to protect against duplicative errors. Without this return, - -- resolution errors reported by Laurel would also be reported by Core. - -- There might be better solution that allows getting some resolution errors from Laurel and some verification errors from Core, - -- but that would need more consideration. - if passDiags.any (·.type != .Warning) then - return (none, passDiags, program, stats) - - let initState : TranslateState := { model := model, overflowChecks := options.overflowChecks } + let (program, model, passDiags, stats) ← runLaurelPasses options program + let unorderedCore := transparencyPass program + emit "transparencyPass" "core.st" unorderedCore + let unorderedCore := eliminateMultipleOutputs unorderedCore + let unorderedCore := inlineLocalVariablesInExpressions unorderedCore + + -- Resolve so that identifiers introduced by earlier passes get uniqueIds. + let (unorderedCore, fnModel) := resolveUnorderedCore unorderedCore program (some model) + + -- Lift imperative expressions in the proof procedures. + let unorderedCore := liftImperativeExpressionsInCore unorderedCore fnModel + emit "secondLiftingPass" "core.st" unorderedCore + + -- Re-resolve after lifting so that freshly introduced variables (e.g. $cndtn_N) + -- created by liftExpressionAssignments also get uniqueIds in the model. + let (unorderedCore, fnModel) := resolveUnorderedCore unorderedCore program (some fnModel) + + let coreWithLaurelTypes := orderFunctionsAndProofs unorderedCore + -- This early return is a simple way to protect against duplicative errors. Without this return, + -- resolution errors reported by Laurel would also be reported by Core. + -- There might be better solution that allows getting some resolution errors from Laurel and some verification errors from Core, + -- but that would need more consideration. + if ! passDiags.isEmpty then + return (none, passDiags, program, stats) + else + emit "CoreWithLaurelTypes" "core.st" coreWithLaurelTypes + let initState : TranslateState := { model := fnModel, overflowChecks := options.overflowChecks } let (coreProgramOption, translateState) := - runTranslateM initState (translateLaurelToCore options program ordered) - if let some coreProgram := coreProgramOption then - emit "CoreProgram" "core.st" coreProgram - let mut allDiagnostics := passDiags ++ translateState.diagnostics + runTranslateM initState (translateLaurelToCore options program coreWithLaurelTypes) + -- Because of the duplication between functions and proofs, this translation is liable to create duplicate diagnostics + -- User errors should be checked in an earlier phase, and all dumb translation errors are Strata bugs + let mut allDiagnostics := translateState.diagnostics.eraseDups + if translateState.coreDiagnostics.length > 0 && allDiagnostics.isEmpty then + -- The program was suppressed but no diagnostics explain why — report the core diagnostics + -- that have a known source location (those without one are not actionable for the user). + allDiagnostics := allDiagnostics ++ translateState.coreDiagnostics + + if coreProgramOption.isSome then + emit "Core" "core.st" coreProgramOption.get! let coreProgramOption := - if translateState.coreProgramHasSuperfluousErrors then none else coreProgramOption + if !translateState.coreDiagnostics.isEmpty then none else coreProgramOption return (coreProgramOption, allDiagnostics, program, stats) /-- diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index 1a9c78e081..5448992c87 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -32,7 +32,7 @@ import Strata.Languages.Laurel.ConstrainedTypeElim import Strata.Util.Tactics open Core (VCResult VCResults VerifyOptions) -open Core (intAddOp intSubOp intMulOp intSafeDivOp intSafeModOp intSafeDivTOp intSafeModTOp intNegOp intLtOp intLeOp intGtOp intGeOp boolAndOp boolOrOp boolNotOp boolImpliesOp strConcatOp) +open Core (intAddOp intSubOp intMulOp intDivOp intSafeDivOp intModOp intSafeModOp intDivTOp intSafeDivTOp intModTOp intSafeModTOp intNegOp intLtOp intLeOp intGtOp intGeOp boolAndOp boolOrOp boolNotOp boolImpliesOp strConcatOp) open Core (realAddOp realSubOp realMulOp realDivOp realNegOp realLtOp realLeOp realGtOp realGeOp) namespace Strata.Laurel @@ -62,8 +62,16 @@ structure TranslateState where model : SemanticModel /-- Overflow check configuration -/ overflowChecks : Core.OverflowChecks := {} - /-- Do not process the produces Core program, since it has superfluous errors -/ - coreProgramHasSuperfluousErrors: Bool := false + /-- Diagnostics that indicate the Core program should not be processed further. + When non-empty, the produced Core program is suppressed. Each entry records + why the program was deemed invalid so that if no other diagnostics explain + the suppression, these can be surfaced to the user. -/ + coreDiagnostics : List DiagnosticModel := [] + /-- When `true`, use safe division (`intSafeDivOp`) and safe datatype selectors + (with preconditions). When `false`, use unsafe division (`intDivOp`) and + unsafe datatype selectors (without preconditions). + Set to `true` for proof procedures and `false` for functions. -/ + proof : Bool := false /-- The translation monad: state over Except, allowing both accumulated diagnostics and hard failures -/ @[expose] abbrev TranslateM := OptionT (StateM TranslateState) @@ -72,8 +80,28 @@ structure TranslateState where def emitDiagnostic (d : DiagnosticModel) : TranslateM Unit := modify fun s => { s with diagnostics := s.diagnostics ++ [d] } -private def invalidCoreType : TranslateM LMonoTy := do - modify fun s => { s with coreProgramHasSuperfluousErrors := true } +/-- Adjust a datatype selector (destructor) name based on the `proof` flag. + Destructor names contain `..` (e.g. `IntList..head`, `IntList..head!`). + Tester names also contain `..` but start with `is` after the separator. + - `proof = true` → use safe selectors (strip `!` suffix) + - `proof = false` → use unsafe selectors (add `!` suffix) -/ +private def adjustSelectorName (name : String) (proof : Bool) : String := + -- Only adjust destructor names (contain ".." but are not testers) + match name.splitOn ".." with + | [_, suffix] => + if suffix.startsWith "is" then name -- tester, leave unchanged + else if proof then + name + -- Safe: strip trailing "!" + -- if name.endsWith "!" then (name.dropEnd 1).toString else name + else + -- Unsafe: add trailing "!" if not already present + if name.endsWith "!" then name else name ++ "!" + | _ => name -- not a destructor name, leave unchanged + +private def invalidCoreType (source : Option FileRange) (reason : String) : TranslateM LMonoTy := do + modify fun s => { s with coreDiagnostics := s.coreDiagnostics ++ + [diagnosticFromSource source reason DiagnosticType.StrataBug] } return .tcons s!"LaurelResolutionErrorPlaceholder" [] /- @@ -97,15 +125,15 @@ def translateType (ty : HighTypeMd) : TranslateM LMonoTy := do | some (.datatypeDefinition dt) => return .tcons dt.name.text [] | some (.datatypeConstructor typeName _) => return .tcons typeName.text [] | _ => do -- resolution should have already emitted a diagnostic - modify fun s => { s with coreProgramHasSuperfluousErrors := true } + modify fun s => { s with coreDiagnostics := s.coreDiagnostics ++ + [diagnosticFromSource ty.source s!"UserDefined type could not be resolved to a composite or datatype" DiagnosticType.StrataBug] } return .tcons "Composite" [] | .TCore s => return .tcons s [] | .TReal => return LMonoTy.real - | .MultiValuedExpr _ => invalidCoreType - | .Unknown => invalidCoreType + | .MultiValuedExpr _ => invalidCoreType ty.source "MultiValuedExpr type encountered during Core translation" + | .Unknown => invalidCoreType ty.source "Unknown type encountered during Core translation" | _ => do - emitDiagnostic (diagnosticFromSource ty.source "cannot translate type to Core: not supported yet" DiagnosticType.StrataBug) - invalidCoreType + invalidCoreType ty.source s!"cannot translate type to Core: not supported yet" termination_by ty.val decreasing_by all_goals (first | (cases elementType; term_by_mem) | (cases keyType; term_by_mem) | (cases valueType; term_by_mem)) @@ -117,9 +145,6 @@ def lookupType (name : Identifier) : TranslateM LMonoTy := do def runTranslateM (s : TranslateState) (m : TranslateM α) : (Option α × TranslateState) := m s -def returnNone: TranslateM α := - StateT.pure none - /-- Allocate a fresh unique ID. -/ private def freshId : TranslateM Nat := do let s ← get @@ -130,7 +155,7 @@ private def freshId : TranslateM Nat := do /-- Throw a hard diagnostic error, aborting the current translation -/ def throwExprDiagnostic (d : DiagnosticModel): TranslateM Core.Expression.Expr := do emitDiagnostic d - modify fun s => { s with coreProgramHasSuperfluousErrors := true } + modify fun s => { s with coreDiagnostics := s.coreDiagnostics ++ [d] } let id ← freshId return LExpr.fvar () (⟨s!"DUMMY_VAR_{id}", ()⟩) none @@ -153,6 +178,7 @@ def translateExpr (expr : StmtExprMd) let s ← get let model := s.model let md := astNodeToCoreMd expr + let proof := (← get).proof let disallowed (source : Option FileRange) (msg : String) : TranslateM Core.Expression.Expr := do if isPureContext then throwExprDiagnostic $ diagnosticFromSource source msg @@ -209,10 +235,10 @@ def translateExpr (expr : StmtExprMd) | .Add => return binOp (if isReal then realAddOp else intAddOp) | .Sub => return binOp (if isReal then realSubOp else intSubOp) | .Mul => return binOp (if isReal then realMulOp else intMulOp) - | .Div => return binOp (if isReal then realDivOp else intSafeDivOp) - | .Mod => return binOp intSafeModOp - | .DivT => return binOp intSafeDivTOp - | .ModT => return binOp intSafeModTOp + | .Div => return binOp (if isReal then realDivOp else if proof then intSafeDivOp else intDivOp) + | .Mod => return binOp (if (← get).proof then intSafeModOp else intModOp) + | .DivT => return binOp (if (← get).proof then intSafeDivTOp else intDivTOp) + | .ModT => return binOp (if (← get).proof then intSafeModTOp else intModTOp) | .Lt => return binOp (if isReal then realLtOp else intLtOp) | .Leq => return binOp (if isReal then realLeOp else intLeOp) | .Gt => return binOp (if isReal then realGtOp else intGtOp) @@ -237,9 +263,10 @@ def translateExpr (expr : StmtExprMd) | .StaticCall callee args => -- In a pure context, only Core functions (not procedures) are allowed if isPureContext && !model.isFunction callee then - disallowed expr.source "calls to procedures are not supported in functions or contracts" + disallowed expr.source s!"calls to procedures are not supported in functions or contracts. Callee: {callee}" else - let fnOp : Core.Expression.Expr := .op () ⟨callee.text, ()⟩ none + let calleeName := adjustSelectorName callee.text (← get).proof + let fnOp : Core.Expression.Expr := .op () ⟨calleeName, ()⟩ none args.attach.foldlM (fun acc ⟨arg, _⟩ => do let re ← translateExpr arg boundVars isPureContext return .app () acc re) fnOp @@ -316,8 +343,9 @@ 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.getFileRange md with + | some fileRange => s!"({fileRange.range.start})" + | none => "(generated)" def defaultExprForType (ty : HighTypeMd) : TranslateM Core.Expression.Expr := do match ty.val with @@ -339,14 +367,15 @@ private def exprAsUnusedInit (expr : StmtExprMd) (md : Imperative.MetaData Core. : TranslateM (List Core.Statement) := do let coreExpr ← translateExpr expr let id ← freshId + let model := (← get).model let ident : Core.CoreIdent := ⟨s!"$unused_{id}", ()⟩ - let tyVarName := s!"$__ty_unused_{id}" - let coreType := LTy.forAll [tyVarName] (.ftvar tyVarName) + let ty ← translateType (computeExprType model expr) + let coreType := LTy.forAll [] ty return [Core.Statement.init ident coreType (.det coreExpr) md] def throwStmtDiagnostic (d : DiagnosticModel): TranslateM (List Core.Statement) := do emitDiagnostic d - modify fun s => { s with coreProgramHasSuperfluousErrors := true } + modify fun s => { s with coreDiagnostics := s.coreDiagnostics ++ [d] } return [] /-- @@ -494,8 +523,9 @@ def translateStmt (stmt : StmtExprMd) | none => return [.exit (some "$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 } + let d := md.toDiagnostic "Return statement with value should have been eliminated by EliminateValueReturns pass" DiagnosticType.StrataBug + emitDiagnostic d + modify fun s => { s with coreDiagnostics := s.coreDiagnostics ++ [d] } return [.exit (some "$body") md] | .While cond invariants decreasesExpr body => let condExpr ← translateExpr cond @@ -531,7 +561,8 @@ private def translateChecks (checks : List Condition) (labelBase : String) let md := match check.summary with | some msg => baseMd.pushElem Imperative.MetaData.propertySummary (.msg msg) | none => baseMd - let c : Core.Procedure.Check := { expr := checkExpr, md } + let attr := if check.free then Core.Procedure.CheckAttr.Free else .Default + let c : Core.Procedure.Check := { expr := checkExpr, attr, md } return (label, c)) /-- @@ -713,35 +744,31 @@ def translateDatatypeDefinition (dt : DatatypeDefinition) abbrev TranslateResult := (Option Core.Program) × (List DiagnosticModel) /-- -Translate an `OrderedLaurel` program to a `Core.Program`. +Translate a `CoreWithLaurelTypes` program to a `Core.Program`. The `program` parameter is the lowered Laurel program, used for type definitions. -/ -def translateLaurelToCore (options: LaurelTranslateOptions) (program : Program) (ordered : OrderedLaurel): TranslateM Core.Program := do +def translateLaurelToCore (options: LaurelTranslateOptions) (program : Program) (ordered : CoreWithLaurelTypes): TranslateM Core.Program := do let coreDecls ← ordered.decls.flatMapM fun - | .procs procs isRecursive => do - -- For each SCC, determine if it is purely functional or contains procedures. - let isFuncSCC := procs.all (·.isFunctional) - if isFuncSCC then - let funcs ← procs.mapM (translateProcedureToFunction options isRecursive) - if isRecursive then - let coreFuncs := funcs.filterMap (fun d => match d with - | .func f _ => some f - | _ => none) - return [Core.Decl.recFuncBlock coreFuncs mdWithUnknownLoc] - else - return funcs + | .funcs funcs isRecursive => do + modify fun s => { s with proof := false } + let nonExternal := funcs.filter (fun p => !p.body.isExternal) + let coreFuncs ← nonExternal.mapM (translateProcedureToFunction options isRecursive) + if isRecursive then + let coreFuncValues := coreFuncs.filterMap (fun d => match d with + | .func f _ => some f + | _ => none) + return [Core.Decl.recFuncBlock coreFuncValues mdWithUnknownLoc] else - let procDecls ← procs.flatMapM fun proc => do - let procDecl ← translateProcedure proc - -- Turn free postconditions into axioms placed right behind the related procedure - let axiomDecls : List Core.Decl ← match proc.invokeOn with - | none => pure [] - | some trigger => do - let axDecl? ← translateInvokeOnAxiom proc trigger - pure axDecl?.toList - return [Core.Decl.proc procDecl (identifierToCoreMd proc.name)] ++ axiomDecls - return procDecls + return coreFuncs + | .procedure proc => do + modify fun s => { s with proof := true } + let procDecl ← translateProcedure proc + -- Translate axioms (populated by the contract pass from invokeOn + ensures) + let axiomDecls ← proc.axioms.mapM fun ax => do + let coreExpr ← translateExpr ax [] (isPureContext := true) + return Core.Decl.ax { name := s!"invokeOn_{proc.name.text}", e := coreExpr } (identifierToCoreMd proc.name) + return [Core.Decl.proc procDecl (identifierToCoreMd proc.name)] ++ axiomDecls | .datatypes dts => do let ldatatypes ← dts.mapM translateDatatypeDefinition return [Core.Decl.type (.data ldatatypes) mdWithUnknownLoc] @@ -764,6 +791,7 @@ def translateLaurelToCore (options: LaurelTranslateOptions) (program : Program) emitDiagnostic $ diagnosticFromSource proc.name.source s!"Instance procedure '{proc.name.text}' on composite type '{ct.name.text}' is not yet supported" DiagnosticType.NotYetImplemented + pure { decls := coreDecls } end -- public section diff --git a/Strata/Languages/Laurel/LiftImperativeExpressions.lean b/Strata/Languages/Laurel/LiftImperativeExpressions.lean index 7c63b6870f..d2f70eae80 100644 --- a/Strata/Languages/Laurel/LiftImperativeExpressions.lean +++ b/Strata/Languages/Laurel/LiftImperativeExpressions.lean @@ -82,6 +82,8 @@ structure LiftState where condCounter : Nat := 0 /-- All procedures in the program, used to look up return types of imperative calls -/ procedures : List Procedure := [] + /-- Names of callees whose calls should be treated as imperative (lifted) -/ + imperativeCallees : List String := [] @[expose] abbrev LiftM := StateM LiftState @@ -102,7 +104,7 @@ private def freshTempFor (varName : Identifier) : LiftM Identifier := do private def freshCondVar : LiftM Identifier := do let n := (← get).condCounter modify fun s => { s with condCounter := n + 1 } - return s!"$c_{n}" + return s!"$cndtn_{n}" private def prepend (stmt : StmtExprMd) : LiftM Unit := modify fun s => { s with prependedStmts := stmt :: s.prependedStmts } @@ -111,24 +113,16 @@ private def onlyKeepSideEffectStmtsAndLast (stmts : List StmtExprMd) : LiftM (Li match stmts with | [] => return [] | _ => + -- return stmts let last := stmts.getLast! let nonLast ← stmts.dropLast.flatMapM (fun s => match s.val with | .Var (.Declare ..) | .Assign ([⟨.Declare .., _⟩]) _ => do - -- This addPrepend is a hack to work around Core not having let expressions - -- Otherwise we could keep them in the block - prepend s - pure [] - | .Assert _ => do - -- Hack to work around Core not supporting assert expressions - -- Otherwise we could keep them in the block - prepend s - pure [] - | .Assume _ => do - -- Hack to work around Core not supporting assume expressions - -- Otherwise we could keep them in the block - prepend s - pure [] + pure [s] + -- | .Assert _ => do + -- pure [s] + -- | .Assume _ => do + -- pure [s] /- Any other impure StmtExpr, like .Assign, .Exit or .Return, @@ -157,22 +151,53 @@ private def computeType (expr : StmtExprMd) : LiftM HighTypeMd := do let s ← get return computeExprType s.model expr -/-- Check if an expression contains any assignments (recursively). -/ -def containsAssignment (expr : StmtExprMd) : Bool := +/-- Check if an expression contains any assignments or imperative calls (recursively). -/ +def containsAssignmentOrImperativeCall (imperativeCallees : List String) (expr : StmtExprMd) : Bool := match expr with | AstNode.mk val _ => match val with | .Assign .. => true - | .StaticCall _ args => args.attach.any (fun x => containsAssignment x.val) - | .PrimitiveOp _ args => args.attach.any (fun x => containsAssignment x.val) - | .Block stmts _ => stmts.attach.any (fun x => containsAssignment x.val) + | .StaticCall name args1 => + imperativeCallees.contains name.text || + args1.attach.any (fun x => containsAssignmentOrImperativeCall imperativeCallees x.val) + | .PrimitiveOp _ args2 => args2.attach.any (fun x => containsAssignmentOrImperativeCall imperativeCallees x.val) + | .Block stmts _ => stmts.attach.any (fun x => containsAssignmentOrImperativeCall imperativeCallees x.val) | .IfThenElse cond th el => - containsAssignment cond || containsAssignment th || - match el with | some e => containsAssignment e | none => false + containsAssignmentOrImperativeCall imperativeCallees cond || + containsAssignmentOrImperativeCall imperativeCallees th || + match el with | some e => containsAssignmentOrImperativeCall imperativeCallees e | none => false + | .Assume cond => containsAssignmentOrImperativeCall imperativeCallees cond + | .Assert cond => containsAssignmentOrImperativeCall imperativeCallees cond.condition + | .InstanceCall target _ args => + containsAssignmentOrImperativeCall imperativeCallees target || + args.attach.any (fun x => containsAssignmentOrImperativeCall imperativeCallees x.val) + | .Quantifier _ _ trigger body => + containsAssignmentOrImperativeCall imperativeCallees body || + match trigger with | some t => containsAssignmentOrImperativeCall imperativeCallees t | none => false + | .Old value => containsAssignmentOrImperativeCall imperativeCallees value + | .Fresh value => containsAssignmentOrImperativeCall imperativeCallees value + | .ProveBy value proof => + containsAssignmentOrImperativeCall imperativeCallees value || + containsAssignmentOrImperativeCall imperativeCallees proof + | .ReferenceEquals lhs rhs => + containsAssignmentOrImperativeCall imperativeCallees lhs || + containsAssignmentOrImperativeCall imperativeCallees rhs + | .PureFieldUpdate target _ newValue => + containsAssignmentOrImperativeCall imperativeCallees target || + containsAssignmentOrImperativeCall imperativeCallees newValue + | .AsType target _ => containsAssignmentOrImperativeCall imperativeCallees target + | .IsType target _ => containsAssignmentOrImperativeCall imperativeCallees target + | .Assigned name => containsAssignmentOrImperativeCall imperativeCallees name + | .ContractOf _ func => containsAssignmentOrImperativeCall imperativeCallees func + | .Return (some v) => containsAssignmentOrImperativeCall imperativeCallees v | _ => false termination_by expr decreasing_by - all_goals ((try cases x); simp_all; try term_by_mem) + all_goals (try cases x) + all_goals (try simp_all) + all_goals (try have := Condition.sizeOf_condition_lt ‹_›) + all_goals (try term_by_mem) + all_goals omega /-- Check if an expression contains any non-functional procedure calls (recursively). -/ def containsImperativeCall (model : SemanticModel) (expr : StmtExprMd) : Bool := @@ -195,10 +220,6 @@ def containsImperativeCall (model : SemanticModel) (expr : StmtExprMd) : Bool := decreasing_by all_goals ((try cases x); simp_all; try term_by_mem) -/-- Check if an expression contains any assignments or non-functional procedure calls (recursively). -/ -def containsAssignmentOrImperativeCall (model : SemanticModel) (expr : StmtExprMd) : Bool := - containsAssignment expr || containsImperativeCall model expr - /-- Shared logic for lifting an assignment in expression position: prepends the assignment, creates before-snapshots for all targets, @@ -272,9 +293,10 @@ def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do | .StaticCall callee args => let model := (← get).model + let imperativeCallees := (← get).imperativeCallees let seqArgs ← args.reverse.mapM transformExpr let seqCall := ⟨.StaticCall callee seqArgs.reverse, source⟩ - if model.isFunction callee then + if !imperativeCallees.contains callee.text then return seqCall else -- Imperative call in expression position: lift to an assignment. @@ -291,19 +313,26 @@ def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do | [single] => pure single.type | _ => computeType expr let liftedCall := [ - ⟨.Var (.Declare ⟨callResultVar, callResultType⟩), source⟩, - ⟨.Assign [⟨.Local callResultVar, source⟩] seqCall, source⟩ + ⟨ (.Var (.Declare ⟨callResultVar, callResultType⟩)), source ⟩, + ⟨.Assign [⟨ .Local callResultVar, source⟩] seqCall, source⟩ ] modify fun s => { s with prependedStmts := s.prependedStmts ++ liftedCall} return bare (.Var (.Local callResultVar)) | .IfThenElse cond thenBranch elseBranch => - let model := (← get).model - let thenHasAssign := containsAssignmentOrImperativeCall model thenBranch + let imperativeCallees := (← get).imperativeCallees + let thenHasAssign := containsAssignmentOrImperativeCall imperativeCallees thenBranch let elseHasAssign := match elseBranch with - | some e => containsAssignmentOrImperativeCall model e + | some e => containsAssignmentOrImperativeCall imperativeCallees e | none => false if thenHasAssign || elseHasAssign then + + -- Infer type from the ORIGINAL then-branch (not the transformed one), + -- because the transformed expression may reference freshly generated + -- variables (e.g. $c_2) that don't exist in the SemanticModel yet. + let condType ← computeType thenBranch + let needsCondVar := condType.val != .TVoid + -- Lift the entire if-then-else. Introduce a fresh variable for the result. let condVar ← freshCondVar let seqCond ← transformExpr cond @@ -314,25 +343,24 @@ def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do modify fun s => { s with prependedStmts := [], subst := [] } let seqThen ← transformExpr thenBranch let thenPrepends ← takePrepends - let thenBlock := bare (.Block (thenPrepends ++ [⟨.Assign [⟨ .Local condVar, source⟩] seqThen, source⟩]) none) + let assignStmts := if needsCondVar then [⟨.Assign [⟨ .Local condVar, source⟩] seqThen, source⟩] else [] + let thenBlock := bare (.Block (thenPrepends ++ assignStmts) none) -- Process else-branch from scratch modify fun s => { s with prependedStmts := [], subst := [] } let seqElse ← match elseBranch with | some e => do let se ← transformExpr e let elsePrepends ← takePrepends - pure (some (bare (.Block (elsePrepends ++ [⟨.Assign [⟨ .Local condVar, source⟩] se, source⟩]) none))) + let assignStmts: List StmtExprMd := if needsCondVar then [⟨.Assign [⟨ .Local condVar, source⟩] se, source⟩] else []; + pure (some (bare (.Block (elsePrepends ++ assignStmts) none))) | none => pure none -- Restore outer state modify fun s => { s with subst := savedSubst, prependedStmts := savedPrepends } - -- Infer type from the ORIGINAL then-branch (not the transformed one), - -- because the transformed expression may reference freshly generated - -- variables (e.g. $c_2) that don't exist in the SemanticModel yet. - let condType ← computeType thenBranch -- IfThenElse added first (cons puts it deeper), then declaration (cons puts it on top) -- Output order: declaration, then if-then-else prepend (⟨.IfThenElse seqCond thenBlock seqElse, source⟩) - prepend (bare (.Var (.Declare ⟨condVar, condType⟩))) + if needsCondVar then + prepend (bare (.Var (.Declare ⟨condVar, condType⟩))) return bare (.Var (.Local condVar)) else -- No assignments in branches — recurse normally @@ -358,10 +386,85 @@ def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do else return expr + | .Assume cond => + let seqCond ← transformExpr cond + prepend ⟨.Assume seqCond, source⟩ + default + + | .Assert cond => + let seqCondExpr ← transformExpr cond.condition + prepend ⟨.Assert { cond with condition := seqCondExpr }, source⟩ + default + + | .Return (some retExpr) => + let seqRet ← transformExpr retExpr + return ⟨.Return (some seqRet), source⟩ + + | .While cond invs dec body => + let seqCond ← transformExpr cond + let seqInvs ← invs.mapM transformExpr + let seqDec ← match dec with + | some d => pure (some (← transformExpr d)) + | none => pure none + let seqBody ← transformExpr body + return ⟨.While seqCond seqInvs seqDec seqBody, source⟩ + + | .PureFieldUpdate target fieldName newValue => + let seqTarget ← transformExpr target + let seqNewValue ← transformExpr newValue + return ⟨.PureFieldUpdate seqTarget fieldName seqNewValue, source⟩ + + | .ReferenceEquals lhs rhs => + let seqRhs ← transformExpr rhs + let seqLhs ← transformExpr lhs + return ⟨.ReferenceEquals seqLhs seqRhs, source⟩ + + | .AsType target ty => + let seqTarget ← transformExpr target + return ⟨.AsType seqTarget ty, source⟩ + + | .IsType target ty => + let seqTarget ← transformExpr target + return ⟨.IsType seqTarget ty, source⟩ + + | .InstanceCall target callee args => + let seqArgs ← args.reverse.mapM transformExpr + let seqTarget ← transformExpr target + return ⟨.InstanceCall seqTarget callee seqArgs.reverse, source⟩ + + | .Quantifier mode param trigger body => + let seqBody ← transformExpr body + let seqTrigger ← match trigger with + | some t => pure (some (← transformExpr t)) + | none => pure none + return ⟨.Quantifier mode param seqTrigger seqBody, source⟩ + + | .Old value => + let seqValue ← transformExpr value + return ⟨.Old seqValue, source⟩ + + | .Fresh value => + let seqValue ← transformExpr value + return ⟨.Fresh seqValue, source⟩ + + | .Assigned name => + let seqName ← transformExpr name + return ⟨.Assigned seqName, source⟩ + + | .ProveBy value proof => + let seqValue ← transformExpr value + let seqProof ← transformExpr proof + return ⟨.ProveBy seqValue seqProof, source⟩ + + | .ContractOf ty func => + let seqFunc ← transformExpr func + return ⟨.ContractOf ty seqFunc, source⟩ + | _ => return expr termination_by (sizeOf expr, 0) decreasing_by - all_goals (simp_all; try term_by_mem) + all_goals (simp_all; try have := Condition.sizeOf_condition_lt ‹_›; try term_by_mem) + all_goals (apply Prod.Lex.left; try term_by_mem; try omega) /-- Process a statement, handling any assignments in its sub-expressions. @@ -373,25 +476,23 @@ def transformStmt (stmt : StmtExprMd) : LiftM (List StmtExprMd) := do 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 + -- But nondeterministic holes need to be lifted. + -- if containsNondetHole cond.condition && !containsAssignmentOrImperativeCall (← get).model cond.condition then let seqCond ← transformExpr cond.condition let prepends ← takePrepends modify fun s => { s with subst := [] } return prepends ++ [⟨.Assert { cond with condition := seqCond }, source⟩] - else - return [stmt] + -- else + -- 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 containsNondetHole cond && !containsAssignmentOrImperativeCall (← get).model cond then let seqCond ← transformExpr cond let prepends ← takePrepends modify fun s => { s with subst := [] } return prepends ++ [⟨.Assume seqCond, source⟩] - else - return [stmt] + -- else + -- return [stmt] | .Block stmts metadata => let seqStmts ← stmts.mapM transformStmt @@ -407,8 +508,8 @@ def transformStmt (stmt : StmtExprMd) : LiftM (List StmtExprMd) := do | AstNode.mk value _ => match _: value with | .StaticCall callee args => - let model := (← get).model - if model.isFunction callee then + let imperativeCallees := (← get).imperativeCallees + if !imperativeCallees.contains callee.text then let seqValue ← transformExpr valueMd let prepends ← takePrepends modify fun s => { s with subst := [] } @@ -464,6 +565,10 @@ def transformStmt (stmt : StmtExprMd) : LiftM (List StmtExprMd) := do modify fun s => { s with subst := [] } return prepends ++ [⟨.Return (some seqRet), source⟩] + | .PrimitiveOp name args => + let seqArgs ← args.mapM transformExpr + let prepends ← takePrepends + return prepends ++ [⟨.PrimitiveOp name seqArgs, source⟩] | _ => return [stmt] termination_by (sizeOf stmt, 0) @@ -494,10 +599,15 @@ def transformProcedure (proc : Procedure) : LiftM Procedure := do /-- Transform a program to lift all assignments that occur in an expression context. +When `procedureNames` is non-empty, only procedures whose name appears in the +list are transformed; all others are left unchanged. When `procedureNames` is +empty, no procedures are transformed. -/ -def liftExpressionAssignments (model: SemanticModel) (program : Program) : Program := - let initState : LiftState := { model := model } - let (seqProcedures, _) := (program.staticProcedures.mapM transformProcedure).run initState +def liftExpressionAssignments (program : Program) + (model : SemanticModel) (imperativeCallees : List String) : Program := + let initState : LiftState := { model := model, imperativeCallees := imperativeCallees } + let transform := program.staticProcedures.mapM transformProcedure + let (seqProcedures, _) := transform.run initState { program with staticProcedures := seqProcedures } end -- public section diff --git a/Strata/Languages/Laurel/MapStmtExpr.lean b/Strata/Languages/Laurel/MapStmtExpr.lean index e3892bae93..270838214e 100644 --- a/Strata/Languages/Laurel/MapStmtExpr.lean +++ b/Strata/Languages/Laurel/MapStmtExpr.lean @@ -116,13 +116,14 @@ def mapProcedureBodiesM [Monad m] (f : StmtExprMd → m StmtExprMd) (proc : Proc | .External => return proc /-- Apply a monadic transformation to all `StmtExprMd` nodes in a procedure - (preconditions, decreases, body, and invokeOn). -/ + (preconditions, decreases, body, invokeOn, and axioms). -/ def mapProcedureM [Monad m] (f : StmtExprMd → m StmtExprMd) (proc : Procedure) : m Procedure := do let proc ← mapProcedureBodiesM f proc return { proc with preconditions := ← proc.preconditions.mapM (·.mapM f) decreases := ← proc.decreases.mapM f - invokeOn := ← proc.invokeOn.mapM f } + invokeOn := ← proc.invokeOn.mapM f + axioms := ← proc.axioms.mapM f } /-- Apply a monadic transformation to procedure bodies in a program. Does **not** traverse preconditions, decreases, or invokeOn — use diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index 16bcf1333f..2f960e4f7a 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -164,8 +164,15 @@ structure SemanticModel where def SemanticModel.get (model: SemanticModel) (iden: Identifier): ResolvedNode := match iden.uniqueId with - | some key => (model.refToDef.get? key).getD default - | none => default + | some key => + match model.refToDef.get? key with + | some node => node + | none => + -- An ID was assigned during Phase 1 but the reference was never registered in + -- Phase 2 (buildRefToDef). This is a bug in the resolution pass itself. + dbg_trace s!"SOUND BUG: identifier '{iden.text}' (id={key}) has a uniqueId but is missing from refToDef" + .unresolved iden.source + | none => .unresolved iden.source def SemanticModel.isFunction (model: SemanticModel) (id: Identifier): Bool := match model.get id with @@ -223,7 +230,6 @@ private def freshId : ResolveM Nat := do set { s with nextId := id + 1 } return id - /-- Like `defineName`, but reports a diagnostic if the name already exists in the current scope. Inserts an `.unresolved` node so subsequent references still resolve without cascading errors. -/ def defineNameCheckDup (iden : Identifier) (node : ResolvedNode) (overrideResolutionName: Option String := none) : ResolveM Identifier := do @@ -481,9 +487,9 @@ def resolveStmtExpr (exprMd : StmtExprMd) : ResolveM StmtExprMd := do | .Fresh val => let val' ← resolveStmtExpr val pure (.Fresh val') - | .Assert ⟨condExpr, summary⟩ => + | .Assert ⟨condExpr, summary, free⟩ => let cond' ← resolveStmtExpr condExpr - pure (.Assert { condition := cond', summary }) + pure (.Assert { condition := cond', summary, free }) | .Assume cond => let cond' ← resolveStmtExpr cond pure (.Assume cond') @@ -536,15 +542,13 @@ def resolveProcedure (proc : Procedure) : ResolveM Procedure := do let pres' ← proc.preconditions.mapM (·.mapM resolveStmtExpr) let dec' ← proc.decreases.mapM resolveStmtExpr let body' ← resolveBody proc.body - if !proc.isFunctional && body'.isTransparent then - let diag := diagnosticFromSource proc.name.source - s!"transparent procedures are not yet supported. Add 'opaque' to make the procedure opaque" - modify fun s => { s with errors := s.errors.push diag } let invokeOn' ← proc.invokeOn.mapM resolveStmtExpr + let axioms' ← proc.axioms.mapM resolveStmtExpr return { name := procName', inputs := inputs', outputs := outputs', isFunctional := proc.isFunctional, preconditions := pres', decreases := dec', invokeOn := invokeOn', + axioms := axioms', body := body' } /-- Resolve a field: define its name under the qualified key (OwnerType.fieldName) and resolve its type. -/ @@ -569,16 +573,18 @@ def resolveInstanceProcedure (typeName : Identifier) (proc : Procedure) : Resolv let pres' ← proc.preconditions.mapM (·.mapM resolveStmtExpr) let dec' ← proc.decreases.mapM resolveStmtExpr let body' ← resolveBody proc.body - if !proc.isFunctional && body'.isTransparent then + if !proc.isFunctional && body'.isTransparent && !proc.name.text.any (· == '$') then let diag := diagnosticFromSource proc.name.source - s!"transparent procedures are not yet supported. Add 'opaque' to make the procedure opaque" + s!"transparent statement bodies are not supported. Add 'opaque' to make the procedure opaque" modify fun s => { s with errors := s.errors.push diag } let invokeOn' ← proc.invokeOn.mapM resolveStmtExpr modify fun s => { s with instanceTypeName := savedInstType } + let axioms' ← proc.axioms.mapM resolveStmtExpr return { name := procName', inputs := inputs', outputs := outputs', isFunctional := proc.isFunctional, preconditions := pres', decreases := dec', invokeOn := invokeOn', + axioms := axioms', body := body' } /-- Resolve a type definition. -/ @@ -729,7 +735,7 @@ private def collectStmtExpr (map : Std.HashMap Nat ResolvedNode) (expr : StmtExp | .Assigned name => collectStmtExpr map name | .Old val => collectStmtExpr map val | .Fresh val => collectStmtExpr map val - | .Assert ⟨cond, _⟩ => collectStmtExpr map cond + | .Assert ⟨cond, _, _⟩ => collectStmtExpr map cond | .Assume cond => collectStmtExpr map cond | .ProveBy val proof => let map := collectStmtExpr map val @@ -856,8 +862,18 @@ private def preRegisterTopLevel (program : Program) : ResolveM Unit := do /-- Run the full resolution pass on a Laurel program. -/ def resolve (program : Program) (existingModel: Option SemanticModel := none) : ResolutionResult := + -- Phase 1: pre-register all top-level names, then assign IDs and resolve references let phase1 : ResolveM Program := do + + for td in program.types do + if let .Composite ct := td then + for proc in ct.instanceProcedures do + let diag := diagnosticFromSource proc.name.source + s!"Instance procedure '{proc.name.text}' on composite type '{ct.name.text}' is not yet supported" + DiagnosticType.NotYetImplemented + modify fun s => { s with errors := s.errors.push diag } + preRegisterTopLevel program let types' ← program.types.mapM resolveTypeDefinition let constants' ← program.constants.mapM resolveConstant diff --git a/Strata/Languages/Laurel/TransparencyPass.lean b/Strata/Languages/Laurel/TransparencyPass.lean new file mode 100644 index 0000000000..ae2acc3126 --- /dev/null +++ b/Strata/Languages/Laurel/TransparencyPass.lean @@ -0,0 +1,157 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.Languages.Laurel.MapStmtExpr +public import Strata.Languages.Laurel.Laurel +import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator + +/-! +## Transparency Pass + +For each Core procedure, generate a function with the same signature and name +suffixed with `$asFunction`. If a Core procedure is marked as transparent, +attempt to add a body to its function version. In the functional body, +assertions are erased and all calls are to functional versions. If the function +has a body, add a free postcondition to the related procedure that equates the +two. + +This IR sits between Laurel and CoreWithLaurelTypes in the pipeline: + Laurel → UnorderedCoreWithLaurelTypes → CoreWithLaurelTypes → Core +-/ + +namespace Strata.Laurel + +public section + +/-- +An intermediate representation produced by the transparency pass. +Functions are pure computational procedures (suffixed `$asFunction`); +coreProcedures are the original procedures with any free postconditions +embedded in their `Body.Opaque` postcondition lists. +-/ +public structure UnorderedCoreWithLaurelTypes where + functions : List Procedure + coreProcedures : List Procedure + datatypes : List DatatypeDefinition + constants : List Constant + +private def mkMd (e : StmtExpr) : StmtExprMd := { val := e, source := none } + +/-- Deep traversal that strips all Assert and Assume nodes from a StmtExpr tree. + Assert/Assume nodes are replaced with `LiteralBool true`, and Block nodes + are collapsed by filtering out trivial `LiteralBool true` leftovers. -/ +def stripAssertAssume (expr : StmtExprMd) : StmtExprMd := + mapStmtExpr (fun e => + match e.val with + | .Assert _ | .Assume _ => ⟨.LiteralBool true, e.source⟩ + | .Block stmts label => + let stmts' := stmts.filter fun s => + match s.val with | .LiteralBool true => false | _ => true + match stmts' with + | [] => ⟨.LiteralBool true, e.source⟩ + | [s] => if label.isNone then s else ⟨.Block [s] label, e.source⟩ + | _ => ⟨.Block stmts' label, e.source⟩ + | _ => e) expr + +/-- Rewrite StaticCall callees to their `$asFunction` versions, + but only for procedures whose names appear in `nonExternalNames`. -/ +private def rewriteCallsToFunctional (nonExternalNames : List String) (expr : StmtExprMd) : StmtExprMd := + mapStmtExpr (fun e => + match e.val with + | .StaticCall callee args => + if nonExternalNames.contains callee.text then + let funcCallee := { callee with text := callee.text ++ "$asFunction", uniqueId := none } + ⟨.StaticCall funcCallee args, e.source⟩ + else e + | _ => e) expr + +/-- Build a free postcondition equating the procedure's output to its functional version. + For a procedure `foo(a, b) returns (r)`, produces: + `r == foo$asFunction(a, b)` -/ +private def mkFreePostcondition (proc : Procedure) : StmtExprMd := + let funcName := { proc.name with text := proc.name.text ++ "$asFunction", uniqueId := none } + let inputArgs := proc.inputs.map fun p => mkMd (.Var (.Local p.name)) + let funcCall := mkMd (.StaticCall funcName inputArgs) + match proc.outputs with + | [out] => mkMd (.PrimitiveOp .Eq [mkMd (.Var (.Local out.name)), funcCall]) + | _ => mkMd (.LiteralBool true) + +/-- Create the function copy of a procedure (suffixed `$asFunction`). + If the procedure is transparent, include a functional body. + Otherwise the function is opaque. -/ +private def mkFunctionCopy (nonExternalNames : List String) (proc : Procedure) : Procedure := + let funcName := { proc.name with text := proc.name.text ++ "$asFunction", uniqueId := none } + let body := match proc.body with + | .Transparent b => .Transparent (rewriteCallsToFunctional nonExternalNames (stripAssertAssume b)) + | .Opaque _ _ _ => .Opaque [] none [] + | x => x + { proc with name := funcName, isFunctional := true, body := body } + +/-- Check whether a function copy has a body (i.e. the procedure was transparent). -/ +private def functionHasBody (proc : Procedure) : Bool := + match proc.body with + | .Transparent _ => true + | _ => false + +/-- Append a free postcondition to a procedure's body postconditions. + For Opaque and Abstract bodies, the free condition is appended to the + existing postcondition list. For Transparent bodies, the body is promoted + to Opaque so the free postcondition can be carried. -/ +private def addFreePostcondition (proc : Procedure) (freePost : StmtExprMd) : Procedure := + match freePost.val with + | .LiteralBool true => proc -- trivial, skip + | _ => + let freeCond : Condition := { condition := freePost, free := true } + match proc.body with + | .Opaque postconds impl modif => + { proc with body := .Opaque (postconds ++ [freeCond]) impl modif } + | .Abstract postconds => + { proc with body := .Abstract (postconds ++ [freeCond]) } + | .Transparent body => + { proc with body := .Opaque [freeCond] (some body) [] } + | _ => proc + +/-- +Transparency pass: translate a Laurel program to the UnorderedCoreWithLaurelTypes IR. + +For each procedure: +- Generate a function with the same signature, named `foo$asFunction` +- If transparent, the function gets a functional body (assertions erased, calls to functional versions) +- If the function has a body, add a free postcondition equating the procedure output to the function +-/ +def transparencyPass (program : Program) : UnorderedCoreWithLaurelTypes := + let nonExternal := program.staticProcedures.filter (fun p => !p.body.isExternal) + let nonExternalNames := nonExternal.map (fun p => p.name.text) + -- $asFunction copies for non-external procedures + let asFunctions := nonExternal.map (mkFunctionCopy nonExternalNames) + -- External procedures get a plain function copy (they have no $asFunction version) + let externalFunctions := program.staticProcedures.filter (fun p => p.body.isExternal) + |>.map fun proc => { proc with isFunctional := true } + let functions := externalFunctions ++ asFunctions + let coreProcedures := nonExternal.map fun p => + let freePostcondition := mkFreePostcondition p + let proc := { p with isFunctional := false } + addFreePostcondition proc freePostcondition + let datatypes := program.types.filterMap fun td => match td with + | .Datatype dt => some dt + | _ => none + { functions, coreProcedures, datatypes, constants := program.constants } + +open Std (Format ToFormat) + +def formatUnorderedCoreWithLaurelTypes (p : UnorderedCoreWithLaurelTypes) : Format := + let datatypeFmts := p.datatypes.map ToFormat.format + let constantFmts := p.constants.map ToFormat.format + let functionFmts := p.functions.map ToFormat.format + let procFmts := p.coreProcedures.map ToFormat.format + Format.joinSep (datatypeFmts ++ constantFmts ++ functionFmts ++ procFmts) "\n\n" + +instance : ToFormat UnorderedCoreWithLaurelTypes where + format := formatUnorderedCoreWithLaurelTypes + +end -- public section +end Strata.Laurel diff --git a/Strata/Languages/Python/PythonToLaurel.lean b/Strata/Languages/Python/PythonToLaurel.lean index d6cbbd7c98..dc3f4abe9f 100644 --- a/Strata/Languages/Python/PythonToLaurel.lean +++ b/Strata/Languages/Python/PythonToLaurel.lean @@ -206,6 +206,15 @@ def stmtExprToVar (e : StmtExprMd) : Except TranslationError VariableMd := /-- A wildcard modifies list, meaning the procedure may modify anything. -/ def wildcardModifies : List StmtExprMd := [mkStmtExprMd .All] +/-- Create a VariableMd with default metadata -/ +def mkVariableMd (v : Variable) : VariableMd := + { val := v, source := none } + +/-- Extract a Variable from a StmtExpr. Throws if the expression is not a Var. -/ +def stmtExprToVar (e : StmtExprMd) : Except TranslationError VariableMd := + match e.val with + | .Var v => .ok { val := v, source := e.source } + | _ => .error (.internalError "stmtExprToVar: expected Var node") /-- Create a StmtExprMd with source location metadata. -/ def mkStmtExprMdWithLoc (expr : StmtExpr) (source : Option FileRange) : StmtExprMd := @@ -2337,6 +2346,73 @@ def extractClassFields (ctx : TranslationContext) (classBody : Array (Python.stm return fields +/-- Translate a Python method to a Laurel instance procedure -/ +def translateMethod (ctx : TranslationContext) (className : String) + (methodStmt : Python.stmt SourceRange) + : Except TranslationError Procedure := do + match methodStmt with + | .FunctionDef _ name args body _ _ret _ _ => do + let methodName := name.val + + -- First parameter is self (typed as Composite to match call-site convention) + let selfParam : Parameter := { + name := "self" + type := mkHighTypeMd (.UserDefined (mkId className)) + } + + -- Translate remaining parameters (all typed as Any to match the + -- Python→Laurel pipeline's Any-wrapping convention for call sites). + let mut inputs : List Parameter := [selfParam] + match args with + | .mk_arguments _ _ argsList _ _ _ _ _ => + -- Skip first arg (self), process rest + if argsList.val.size > 0 then + for arg in argsList.val.toList.tail! do + match arg with + | .mk_arg _ paramName _paramAnnotation _ => + inputs := inputs ++ [{name := paramName.val, type := AnyTy}] + let mut kwargsName : Option String := none + match args with + | .mk_arguments _ _ _ _ _ _ kwargs _ => + match kwargs.val with + | some (.mk_arg _ name _ _ ) => + inputs:= inputs ++ [{ name := name.val, type := mkCoreType PyLauType.DictStrAny }] + kwargsName := some name.val + | _ => pure () + + -- Translate return type + -- All methods return Any (void methods return Any via from_None) + let outputs : List Parameter := [{name := "LaurelResult", type := AnyTy}] + + -- Translate method body with class context + -- Add method parameters to variableTypes so that hoisting (e.g. in + -- try/except) does not re-declare them as local variables. + let paramTypes : List (String × String) := inputs.map fun p => + if p.name.text == "self" then (p.name.text, className) else (p.name.text, PyLauType.Any) + let ctxWithClass := {ctx with currentClassName := some className, + variableTypes := paramTypes} + let newDecls := collectDeclaredNamesAndTypes ctxWithClass body.val.toList + let (varDecls, ctxWithClass) ← createVarDeclStmtsAndCtx ctxWithClass newDecls + let (_, bodyStmts) ← translateStmtList ctxWithClass body.val.toList + let bodyStmts := prependExceptHandlingHelper (varDecls ++ bodyStmts) + let (renamedInputs, paramCopies) := renameInputParams inputs + (fun n => n == "self" || kwargsName == some n) + let bodyStmts := paramCopies ++ bodyStmts + let bodyBlock := mkStmtExprMd (StmtExpr.Block bodyStmts none) + + let source := sourceRangeToSource ctx.filePath methodStmt.ann + return { + name := { text := manglePythonMethod className methodName, source := source } + inputs := renamedInputs + outputs := outputs + preconditions := [{ condition := mkStmtExprMd (StmtExpr.LiteralBool true) }] + isFunctional := false + decreases := none + body := .Opaque [] (some bodyBlock) wildcardModifies + } + | _ => throw (.internalError "Expected FunctionDef for method") + + /-- Extract fields from __init__ method body by scanning for self.field : type = expr patterns -/ def extractFieldsFromInit (ctx : TranslationContext) (initBody : Array (Python.stmt SourceRange)) : Except TranslationError (List Field) := do @@ -2515,10 +2591,13 @@ def translateClass (ctx : TranslationContext) (classStmt : Python.stmt SourceRan -- and the resolution pass may not handle all constructs in method bodies. let inHierarchy := ctx.classesInHierarchy.contains className let mut instanceProcedures : Array Procedure := #[] - - for (funcDecl, sr, funcBody) in classFunDeclsAndBody do - let (proc, _) ← translateFunction ctx sr funcDecl $ if inHierarchy then none else funcBody - instanceProcedures := instanceProcedures.push proc + for stmt in body do + if let .FunctionDef .. := stmt then + let proc ← translateMethod ctx className stmt + if inHierarchy then + instanceProcedures := instanceProcedures.push { proc with body := .Opaque [] .none wildcardModifies } + else + instanceProcedures := instanceProcedures.push proc -- Add synthesized default __init__ if needed if let some initProc := defaultInitProc then instanceProcedures := instanceProcedures.push initProc diff --git a/Strata/Languages/Python/Specs/ToLaurel.lean b/Strata/Languages/Python/Specs/ToLaurel.lean index da75cc4076..a88d57175f 100644 --- a/Strata/Languages/Python/Specs/ToLaurel.lean +++ b/Strata/Languages/Python/Specs/ToLaurel.lean @@ -414,9 +414,10 @@ def buildSpecBody (allArgs : Array Arg) (returnType : SpecType) (source : Option FileRange) (ctx : SpecExprContext) - : ToLaurelM Body := do + : ToLaurelM (List Condition × Body) := do let fileSource ← mkFileSource let mut stmts : Array StmtExprMd := #[] + let mut preconds : Array Condition := #[] -- 1. Havoc the result: result := Hole(nondet) let holeExpr : StmtExprMd := { val := .Hole (deterministic := false), source := source } let resultId : AstNode Variable := { val := Variable.Local (mkId "result"), source := source } @@ -451,6 +452,7 @@ def buildSpecBody (allArgs : Array Arg) let (⟨condType, condExpr⟩, success) ← runChecked <| specExprToLaurel assertion.formula source ctx if success then if let .TBool := condType then + preconds := preconds.push { condition := condExpr.stmt, summary := some msg } let assertStmt ← mkStmtWithLoc (.Assert { condition := condExpr.stmt, summary := some msg }) default stmts := stmts.push assertStmt else @@ -479,7 +481,7 @@ def buildSpecBody (allArgs : Array Arg) val := .Block stmts.toList none, source := fileSource } - return .Opaque [] (some body) [{ val := .All, source := none }] + return (preconds.toList, .Opaque [] (some body) [{ val := .All, source := none }]) /-! ## Declaration Translation -/ @@ -519,14 +521,14 @@ def funcDeclToLaurel (procName : String) (func : FunctionDecl) inputs.foldl (init := ({} : Std.HashMap String HighType).insert "result" Laurel.tyAny) fun m p => m.insert p.name.text p.type.val let specCtx : SpecExprContext := { procName, argTypes } - let body ← buildSpecBody allArgs func.preconditions func.postconditions + let (preconds, body) ← buildSpecBody allArgs func.preconditions func.postconditions func.returnType none specCtx let src ← mkSourceWithFileRange func.loc return { name := { text := procName, source := src } inputs := inputs.toList outputs := outputs - preconditions := [] + preconditions := preconds decreases := none isFunctional := false body := body diff --git a/StrataTest/Backends/CBMC/contracts/test_contract.lr.st b/StrataTest/Backends/CBMC/contracts/test_contract.lr.st index 5660809918..20505c2cbc 100644 --- a/StrataTest/Backends/CBMC/contracts/test_contract.lr.st +++ b/StrataTest/Backends/CBMC/contracts/test_contract.lr.st @@ -6,7 +6,9 @@ procedure add(x: int, y: int) returns (r: int) r := x + y; }; -procedure main() { +procedure main() + opaque +{ var a: int := 42; assert a > 0; }; diff --git a/StrataTest/Backends/CBMC/contracts/test_contracts_e2e.sh b/StrataTest/Backends/CBMC/contracts/test_contracts_e2e.sh index eef32397e1..0ab00ccab1 100755 --- a/StrataTest/Backends/CBMC/contracts/test_contracts_e2e.sh +++ b/StrataTest/Backends/CBMC/contracts/test_contracts_e2e.sh @@ -66,12 +66,15 @@ echo "--- Test 1: Procedure with requires/ensures (full DFCC + CBMC) ---" build_goto "contract" 'procedure add(x: int, y: int, out r: int) requires x >= 0 + opaque ensures r >= x { r := x + y; } -procedure main() { +procedure main() + opaque +{ var a: int := 42; assert a > 0; }' @@ -102,7 +105,9 @@ echo "" # ---- Test 2: Simple assert (full CBMC verification) ---- echo "--- Test 2: Simple assert (full DFCC + CBMC) ---" -build_goto "assert" 'procedure main() { +build_goto "assert" 'procedure main() + opaque +{ var x: int := 10; var y: int := x + 5; assert y > x; @@ -122,12 +127,15 @@ echo "--- Test 3: Procedure with ensures (full DFCC + CBMC) ---" build_goto "ensures" 'procedure inc(x: int, out r: int) requires x >= 0 + opaque ensures r > x { r := x + 1; } -procedure main() { +procedure main() + opaque +{ var v: int := 10; assert v > 0; }' @@ -146,6 +154,7 @@ echo "--- Test 4: Loop with invariant (full DFCC + CBMC) ---" build_goto "loop" 'procedure sum_to_n(n: int, out s: int) requires n >= 0 + opaque ensures s >= 0 { var i: int := 0; @@ -159,7 +168,9 @@ build_goto "loop" 'procedure sum_to_n(n: int, out s: int) } } -procedure main() { +procedure main() + opaque +{ var x: int := 5; assert x > 0; }' @@ -179,12 +190,15 @@ echo "--- Test 5: Procedure call (full DFCC + CBMC) ---" build_goto "call" 'procedure double(x: int, out r: int) requires x >= 0 + opaque ensures r == x + x { r := x + x; } -procedure main() { +procedure main() + opaque +{ var a: int := 3; assert a > 0; }' @@ -217,6 +231,7 @@ echo "--- Test 6: Multiple procedures with contracts ---" build_goto "multi" 'procedure inc(x: int, out r: int) requires x >= 0 + opaque ensures r == x + 1 { r := x + 1; @@ -224,12 +239,15 @@ build_goto "multi" 'procedure inc(x: int, out r: int) procedure dec(x: int, out r: int) requires x > 0 + opaque ensures r == x - 1 { r := x - 1; } -procedure main() { +procedure main() + opaque +{ var x: int := 5; assert x > 0; }' @@ -263,12 +281,15 @@ echo "--- Test 7: Call inside if-then-else (GOTO output) ---" build_goto "nested_call" 'procedure inc(x: int, out r: int) requires x >= 0 + opaque ensures r == x + 1 { r := x + 1; } -procedure main() { +procedure main() + opaque +{ var a: int := 3; var b: int; if (a > 0) { @@ -299,12 +320,15 @@ echo "--- Test 8: Call inside loop (GOTO output) ---" build_goto "loop_call" 'procedure inc(x: int, out r: int) requires x >= 0 + opaque ensures r == x + 1 { r := x + 1; } -procedure main() { +procedure main() + opaque +{ var i: int := 0; var s: int := 0; while (i < 3) diff --git a/StrataTest/Languages/Core/Examples/TypeDecl.lean b/StrataTest/Languages/Core/Examples/TypeDecl.lean index 3903c29331..4509cee4c4 100644 --- a/StrataTest/Languages/Core/Examples/TypeDecl.lean +++ b/StrataTest/Languages/Core/Examples/TypeDecl.lean @@ -127,7 +127,7 @@ error: ❌ Type checking error. This type declaration's name is reserved! int := bool KnownTypes' names: -[arrow, Sequence, TriggerGroup, real, string, bitvec, Triggers, int, bool, Map, regex] +[arrow, Sequence, TriggerGroup, real, string, bitvec, Triggers, int, bool, Map, errorVoid, regex] -/ #guard_msgs in #eval verify typeDeclPgm4 diff --git a/StrataTest/Languages/Laurel/AbstractToConcreteTreeTranslatorTest.lean b/StrataTest/Languages/Laurel/AbstractToConcreteTreeTranslatorTest.lean index 701405b362..d1e6342473 100644 --- a/StrataTest/Languages/Laurel/AbstractToConcreteTreeTranslatorTest.lean +++ b/StrataTest/Languages/Laurel/AbstractToConcreteTreeTranslatorTest.lean @@ -58,24 +58,34 @@ private def roundtrip (input : String) : IO String := do /-- info: procedure foo() -{ assert true; assert false }; + opaque +{ + assert true; + assert false +}; -/ #guard_msgs in -#eval do IO.println (← roundtrip r"procedure foo() { assert true; assert false };") +#eval do IO.println (← roundtrip r"procedure foo() opaque { assert true; assert false };") /-- info: procedure add(x: int, y: int): int -{ x + y }; + opaque +{ + x + y +}; -/ #guard_msgs in -#eval do IO.println (← roundtrip r"procedure add(x: int, y: int): int { x + y };") +#eval do IO.println (← roundtrip r"procedure add(x: int, y: int): int opaque { x + y };") /-- info: function aFunction(x: int): int -{ x }; +{ + x +}; -/ #guard_msgs in -#eval do IO.println (← roundtrip r"function aFunction(x: int): int { x };") +#eval do IO.println (← roundtrip r"function aFunction(x: int): int +{ x };") /-- info: composite Point { var x: int var y: int } @@ -90,17 +100,22 @@ composite Point { /-- info: procedure test(x: int): int -{ if x > 0 then x else 0 - x }; + opaque +{ + if x > 0 then x else 0 - x +}; -/ #guard_msgs in -#eval do IO.println (← roundtrip r"procedure test(x: int): int { if x > 0 then x else 0 - x };") +#eval do IO.println (← roundtrip r"procedure test(x: int): int opaque { if x > 0 then x else 0 - x };") /-- info: procedure divide(x: int, y: int): int requires y != 0 opaque ensures result >= 0 -{ x / y }; +{ + x / y +}; -/ #guard_msgs in #eval do IO.println (← roundtrip r" @@ -113,11 +128,15 @@ procedure divide(x: int, y: int): int /-- info: procedure test() -{ assert forall(x: int) => x == x; assert exists(y: int) => y > 0 }; + opaque +{ + assert forall(x: int) => x == x; + assert exists(y: int) => y > 0 +}; -/ #guard_msgs in #eval do IO.println (← roundtrip r" -procedure test() { +procedure test() opaque { assert forall(x: int) => x == x; assert exists(y: int) => y > 0 }; @@ -127,7 +146,12 @@ procedure test() { info: composite Point { var x: int var y: int } procedure test(): int -{ var p: Point := new Point; p#x := 5; p#x }; + opaque +{ + var p: Point := new Point; + p#x := 5; + p#x +}; -/ #guard_msgs in #eval do IO.println (← roundtrip r" @@ -135,7 +159,7 @@ composite Point { var x: int var y: int } -procedure test(): int { +procedure test(): int opaque { var p: Point := new Point; p#x := 5; p#x @@ -160,25 +184,34 @@ info: composite Animal { } composite Dog extends Animal { } procedure test(a: Animal): bool -{ a is Dog }; + opaque +{ + a is Dog +}; -/ #guard_msgs in #eval do IO.println (← roundtrip r" composite Animal {} composite Dog extends Animal {} -procedure test(a: Animal): bool { a is Dog }; +procedure test(a: Animal): bool opaque { a is Dog }; ") -- Additional coverage: while loops /-- info: procedure test() -{ var x: int := 0; while(x < 10) - invariant x >= 0 { x := x + 1 } }; + opaque +{ + var x: int := 0; + while(x < 10) + invariant x >= 0 { + x := x + 1 + } +}; -/ #guard_msgs in #eval do IO.println (← roundtrip r" -procedure test() { +procedure test() opaque { var x: int := 0; while(x < 10) invariant x >= 0 @@ -203,7 +236,10 @@ procedure modify(c: Container) opaque ensures true modifies c -{ c#value := c#value + 1; true }; +{ + c#value := c#value + 1; + true +}; -/ #guard_msgs in #eval do IO.println (← roundtrip r" @@ -219,9 +255,12 @@ procedure modify(c: Container) /-- info: procedure test(): int -{ }; + opaque +{ + +}; -/ #guard_msgs in -#eval do IO.println (← roundtrip r"procedure test(): int { };") +#eval do IO.println (← roundtrip r"procedure test(): int opaque { };") end Strata.Laurel diff --git a/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean b/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean index 86ce51e683..2e5fb6c3f1 100644 --- a/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean +++ b/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean @@ -23,7 +23,9 @@ namespace Strata.Laurel def testProgram : String := r" constrained nat = x: int where x >= 0 witness 0 -procedure test(n: nat) returns (r: nat) { +procedure test(n: nat) returns (r: nat) + opaque +{ assert r >= 0; var y: nat := n; return y @@ -44,15 +46,26 @@ def parseLaurelAndElim (input : String) : IO Program := do /-- info: function nat$constraint(x: int): bool -{ x >= 0 }; +{ + x >= 0 +}; procedure test(n: int) returns (r: int) requires nat$constraint(n) opaque ensures nat$constraint(r) -{ assert r >= 0; var y: int := n; assert nat$constraint(y); return y }; +{ + assert r >= 0; + var y: int := n; + assert nat$constraint(y); + return y +}; procedure $witness_nat() -{ var $witness: int := 0; assert nat$constraint($witness) }; + opaque +{ + var $witness: int := 0; + assert nat$constraint($witness) +}; -/ #guard_msgs in #eval! do @@ -63,7 +76,9 @@ procedure $witness_nat() -- Scope management: constrained variable in if-branch must not leak into sibling block def scopeProgram : String := r" constrained pos = v: int where v > 0 witness 1 -procedure test(b: bool) { +procedure test(b: bool) + opaque +{ if b then { var x: pos := 1 }; @@ -76,11 +91,27 @@ procedure test(b: bool) { /-- info: function pos$constraint(v: int): bool -{ v > 0 }; +{ + v > 0 +}; procedure test(b: bool) -{ if b then { var x: int := 1; assert pos$constraint(x) }; { var x: int := -5; x := -10 } }; + opaque +{ + if b then { + var x: int := 1; + assert pos$constraint(x) + }; + { + var x: int := -5; + x := -10 + } +}; procedure $witness_pos() -{ var $witness: int := 1; assert pos$constraint($witness) }; + opaque +{ + var $witness: int := 1; + assert pos$constraint($witness) +}; -/ #guard_msgs in #eval! do @@ -92,7 +123,9 @@ procedure $witness_pos() -- The variable has no known value, only the type constraint is assumed. def uninitProgram : String := r" constrained posint = x: int where x > 0 witness 1 -procedure f() { +procedure f() + opaque +{ var x: posint; assert x == 1 }; @@ -100,11 +133,22 @@ procedure f() { /-- info: function posint$constraint(x: int): bool -{ x > 0 }; +{ + x > 0 +}; procedure f() -{ var x: int; assume posint$constraint(x); assert x == 1 }; + opaque +{ + var x: int; + assume posint$constraint(x); + assert x == 1 +}; procedure $witness_posint() -{ var $witness: int := 1; assert posint$constraint($witness) }; + opaque +{ + var $witness: int := 1; + assert posint$constraint($witness) +}; -/ #guard_msgs in #eval! do diff --git a/StrataTest/Languages/Laurel/DivisionByZeroCheckTest.lean b/StrataTest/Languages/Laurel/DivisionByZeroCheckTest.lean index 40e8a9112d..d6a77924f2 100644 --- a/StrataTest/Languages/Laurel/DivisionByZeroCheckTest.lean +++ b/StrataTest/Languages/Laurel/DivisionByZeroCheckTest.lean @@ -54,12 +54,12 @@ procedure callPureDivUnsafe(x: int) opaque { var z: int := pureDiv(10, x) -//^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold +//^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: precondition could not be proved // Error ranges are too wide because Core does not use expression locations }; " -#guard_msgs(drop info, error) in +#guard_msgs (drop info, error) in #eval testInputWithOffset "DivByZeroE2E" e2eProgram 22 processLaurelFile end Laurel diff --git a/StrataTest/Languages/Laurel/DuplicateNameTests.lean b/StrataTest/Languages/Laurel/DuplicateNameTests.lean index beb1a06737..08c5085dea 100644 --- a/StrataTest/Languages/Laurel/DuplicateNameTests.lean +++ b/StrataTest/Languages/Laurel/DuplicateNameTests.lean @@ -72,25 +72,33 @@ composite Foo { /-! ## Duplicate parameter names in a procedure -/ def dupParams := r" -procedure foo(x: int, x: bool) opaque { }; +procedure foo(x: int, x: bool) // ^ error: Duplicate definition 'x' is already defined in this scope + opaque +{ }; " #guard_msgs (error, drop all) in -#eval testInputWithOffset "DupParams" dupParams 61 processResolution +#eval testInputWithOffset "DupParams" dupParams 77 processResolution /-! ## Duplicate instance procedure names in a composite type -/ def dupInstanceProcs := r" composite Foo { - procedure bar() opaque { }; - procedure bar() opaque { }; + procedure bar() +// ^^^ error: Instance procedure 'bar' on composite type 'Foo' is not yet supported + opaque + { }; + procedure bar() +// ^^^ error: Instance procedure 'bar' on composite type 'Foo' is not yet supported // ^^^ error: Duplicate definition 'bar' is already defined in this scope + opaque + { }; } " #guard_msgs (error, drop all) in -#eval testInputWithOffset "DupInstanceProcs" dupInstanceProcs 71 processResolution +#eval testInputWithOffset "DupInstanceProcs" dupInstanceProcs 89 processResolution /-! ## Duplicate local variable names in the same block -/ diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypes.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypes.lean index 80d21eb4d6..d818122b10 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypes.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypes.lean @@ -32,7 +32,7 @@ procedure outputValid(): nat // Output constraint — invalid return fails procedure outputInvalid(): nat -// ^^^ error: assertion does not hold +// ^^^ error: postcondition does not hold opaque { return -1 @@ -88,7 +88,7 @@ procedure argInvalid() returns (r: int) opaque { var x: int := takesNat(-1); -//^^^^^^^^^^^^^^^^^^^^^^^^^^ error: precondition does not hold +//^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold return x }; @@ -159,9 +159,7 @@ procedure uninitNotWitness() // Quantifier constraint injection — forall // n + 1 > 0 is only provable with n >= 0 injected; false for all int -procedure forallNat() - opaque -{ +procedure forallNat() opaque { var b: bool := forall(n: nat) => n + 1 > 0; assert b }; @@ -169,9 +167,7 @@ procedure forallNat() // Quantifier constraint injection — exists // n == -1 is satisfiable for int, but not when n >= 0 is required // n == 42 works because 42 >= 0 -procedure existsNat() - opaque -{ +procedure existsNat() opaque { var b: bool := exists(n: nat) => n == 42; assert b }; @@ -196,7 +192,7 @@ procedure captureTest(y: haslarger) }; " -#guard_msgs(drop info, error) in +#guard_msgs (drop info, error) in #eval testInputWithOffset "ConstrainedTypes" program 14 processLaurelFile end Laurel diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T14_Quantifiers.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T14_Quantifiers.lean index c60edd889c..50ae574f18 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T14_Quantifiers.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T14_Quantifiers.lean @@ -49,7 +49,7 @@ procedure triggers() " -#guard_msgs(drop info, error) in +#guard_msgs (drop info, error) in #eval testInputWithOffset "Quantifiers" quantifiersProgram 14 processLaurelFile end Laurel diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T15_ShortCircuit.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T15_ShortCircuit.lean index 2e5b46a8ab..30737832d6 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T15_ShortCircuit.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T15_ShortCircuit.lean @@ -91,7 +91,7 @@ procedure testImpliesProc() }; " -#guard_msgs(drop info) in +#guard_msgs (drop info) in #eval testInputWithOffset "ShortCircuit" shortCircuitProgram 15 processLaurelFile end Laurel diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T16_PropertySummary.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T16_PropertySummary.lean index b9d25ce265..7ceb3aea9b 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T16_PropertySummary.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T16_PropertySummary.lean @@ -19,7 +19,7 @@ procedure divide(x: int, y: int) returns (result: int) opaque { assert y == 0 summary "divisor is zero"; -//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: divisor is zero does not hold +//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: divisor is zero could not be proved return x }; @@ -27,7 +27,7 @@ procedure checkPositive(n: int) returns (ok: bool) opaque { var x: int := divide(3, 0) -//^^^^^^^^^^^^^^^^^^^^^^^^^^ error: divisor is non-zero does not hold +//^^^^^^^^^^^^^^^^^^^^^^^^^^ error: divisor is non-zero could not be proved }; "# diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveFunction.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveFunction.lean index 23da15a520..7257ec2df3 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveFunction.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveFunction.lean @@ -22,7 +22,8 @@ datatype IntList { Cons(head: int, tail: IntList) } -function listLen(xs: IntList): int { +function listLen(xs: IntList): int +{ if IntList..isNil(xs) then 0 else 1 + listLen(IntList..tail!(xs)) }; @@ -35,12 +36,14 @@ procedure testListLen() }; // Mutual recursion -function listLenEven(xs: IntList): bool { +function listLenEven(xs: IntList): bool +{ if IntList..isNil(xs) then true else listLenOdd(IntList..tail!(xs)) }; -function listLenOdd(xs: IntList): bool { +function listLenOdd(xs: IntList): bool +{ if IntList..isNil(xs) then false else listLenEven(IntList..tail!(xs)) }; diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_InvokeOn.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_InvokeOn.lean index a5eb37f347..22e2dea42c 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_InvokeOn.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_InvokeOn.lean @@ -69,7 +69,7 @@ procedure badPostcondition(x: int) invokeOn R(x) opaque ensures R(x) -// ^^^^ error: assertion could not be proved +// ^^^^ error: postcondition could not be proved { }; @@ -77,6 +77,6 @@ procedure badPostcondition(x: int) #guard_msgs (drop info, error) in #eval testInputWithOffset "InvokeOn" program 14 - (Strata.Laurel.processLaurelFileWithOptions { verifyOptions := { Core.VerifyOptions.default with solver := "z3" } }) + (Strata.Laurel.processLaurelFileWithOptions { Core.VerifyOptions.default with solver := "z3" }) end Strata.Laurel diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBodyError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBodyError.lean index c86b0e3c9c..1fca021343 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBodyError.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBodyError.lean @@ -13,11 +13,17 @@ namespace Strata namespace Laurel def transparentBodyProgram := r" -procedure transparentBody() -// ^^^^^^^^^^^^^^^ error: transparent procedures are not yet supported. Add 'opaque' to make the procedure opaque +procedure transparentBody(): int { - assert true + assert true; + 3 }; + +// No support for transparent void procedures yet +// procedure transparentBody() +// { +// assert true +// }; " #guard_msgs(drop info, error) in diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressions.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressions.lean index e65d283f57..b80b47c57e 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressions.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressions.lean @@ -80,7 +80,6 @@ procedure nestedImpureStatementsAndOpaque() // An imperative procedure call in expression position is lifted before the // surrounding expression is evaluated. procedure imperativeProc(x: int) returns (r: int) - // ensures clause required because Core's symbolic verification does not support transparent proceduces yet opaque ensures r == x + 1 { @@ -150,7 +149,7 @@ procedure addProcCaller(): int " #guard_msgs (error, drop all) in -#eval! testInputWithOffset "NestedImpureStatements" program 14 processLaurelFile +#eval! testInputWithOffset "NestedImpureStatements" program 14 processLaurelFileKeepIntermediates end Laurel diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressionsError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressionsError.lean index 2b3767391c..c9ef3d2d4d 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressionsError.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressionsError.lean @@ -35,12 +35,11 @@ function impureFunction2(x: int): int function impureFunction3(x: int): int { impure() -//^^^^^^^^ error: calls to procedures are not supported in functions or contracts }; procedure impureContractIsNotLegal1(x: int) requires x == impure() -// ^^^^^^^^ error: calls to procedures are not supported in functions or contracts + opaque { assert impure() == 1 @@ -52,7 +51,6 @@ procedure impureContractIsNotLegal2(x: int) opaque { assert (x := 2) == 2 -// ^^^^^^ error: destructive assignments are not supported in functions or contracts }; " diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlow.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlow.lean index 6e79453261..82b6de8fb4 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlow.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlow.lean @@ -13,7 +13,28 @@ open Strata namespace Strata.Laurel def program := r" -function returnAtEnd(x: int) returns (r: int) { +function letsInFunction() returns (r: int) { + var x: int := 0; + var y: int := x + 1; + var z: int := y + 1; + z +}; + +procedure callLetsInFunction() opaque { + var x: int := letsInFunction(); + assert x == 2 +}; + +function assertAndAssumeInFunctions(a: int) returns (r: int) +{ + assert 2 == 3; +//^^^^^^^^^^^^^ error: assertion does not hold + assume true; + a +}; + +function returnAtEnd(x: int) returns (r: int) +{ if x > 0 then { if x == 1 then { return 1 @@ -25,11 +46,13 @@ function returnAtEnd(x: int) returns (r: int) { } }; -function elseWithCall(): int { +function elseWithCall(): int +{ if true then 3 else returnAtEnd(3) }; -function guardInFunction(x: int) returns (r: int) { +function guardInFunction(x: int) returns (r: int) +{ if x > 0 then { if x == 1 then { return 1 @@ -46,11 +69,11 @@ procedure testFunctions() { assert returnAtEnd(1) == 1; assert returnAtEnd(1) == 2; -//^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold +//^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion could not be proved assert guardInFunction(1) == 1; assert guardInFunction(1) == 2 -//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold +//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion could not be proved }; procedure guards(a: int) returns (r: int) diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError.lean index 3ebe4eb4cf..035154862c 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError.lean @@ -16,12 +16,11 @@ def program := r" function assertAndAssumeInFunctions(a: int) returns (r: int) { assert 2 == 3; -//^^^^^^^^^^^^^ error: asserts are not YET supported in functions or contracts assume true; -//^^^^^^^^^^^ error: assumes are not YET supported in functions or contracts a }; + function letsInFunction() returns (r: int) { var x: int := 0; var y: int := x + 1; diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T4_LoopJumps.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T4_LoopJumps.lean index 040bf3a186..6fa2eaab2e 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T4_LoopJumps.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T4_LoopJumps.lean @@ -13,7 +13,9 @@ open Strata namespace Laurel def program := r" -procedure whileWithBreakAndContinue(steps: int, continueSteps: int, exitSteps: int): int { +procedure whileWithBreakAndContinue(steps: int, continueSteps: int, exitSteps: int): int + opaque +{ var counter = 0 { while(steps > 0) diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T5_ProcedureCalls.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T5_ProcedureCalls.lean index e1e5c0cfd8..6204b99dd2 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T5_ProcedureCalls.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T5_ProcedureCalls.lean @@ -38,7 +38,7 @@ procedure fooProof() var x: int := fooReassign(); var y: int := fooSingleAssign() // The following assertions fails while it should succeed, -// because Core does not yet support transparent procedures +// because Core does not yet support transparent statement bodies // assert x == y; }; diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T6_Preconditions.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T6_Preconditions.lean index c7f1742a88..a300094b89 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T6_Preconditions.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T6_Preconditions.lean @@ -22,7 +22,7 @@ procedure hasRequires(x: int) returns (r: int) { assert x > 0; assert x > 3; -//^^^^^^^^^^^^ error: assertion does not hold +//^^^^^^^^^^^^ error: assertion could not be proved x + 1 }; @@ -30,7 +30,7 @@ procedure caller() opaque { var x: int := hasRequires(1); -//^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: precondition does not hold +//^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: precondition could not be proved var y: int := hasRequires(3) }; @@ -44,7 +44,7 @@ procedure aFunctionWithPreconditionCaller() opaque { var x: int := aFunctionWithPrecondition(0) -//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold +//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: precondition could not be proved // Error ranges are too wide because Core does not use expression locations }; @@ -61,7 +61,7 @@ procedure multipleRequiresCaller() { var a: int := multipleRequires(1, 2); var b: int := multipleRequires(-1, 2) -//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: precondition does not hold +//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: precondition could not be proved }; function funcMultipleRequires(x: int, y: int): int @@ -76,7 +76,7 @@ procedure funcMultipleRequiresCaller() { var a: int := funcMultipleRequires(1, 2); var b: int := funcMultipleRequires(1, -1) -//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold +//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: precondition could not be proved }; " diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T7_Decreases.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T7_Decreases.lean index ee5cfc149d..9167c54f51 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T7_Decreases.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T7_Decreases.lean @@ -19,26 +19,33 @@ A procedure with a decreases clause may be called in an erased context. def program := r" procedure noDecreases(x: int): boolean; + opaque procedure caller(x: int) requires noDecreases(x) // ^ error: noDecreases can not be called from a pure context, because it is not proven to terminate + opaque ; procedure noCyclicCalls() + opaque decreases [] { leaf(); }; -procedure leaf() decreases [1] { }; +procedure leaf() decreases [1] + opaque +{ }; procedure mutualRecursionA(x: nat) + opaque decreases [x, 1] { mutualRecursionB(x); }; procedure mutualRecursionB(x: nat) + opaque decreases [x, 0] { if x != 0 { mutualRecursionA(x-1); } diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_Postconditions.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_Postconditions.lean index 526a03dd92..5be0755a2f 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_Postconditions.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_Postconditions.lean @@ -31,12 +31,14 @@ procedure callerOfOpaqueProcedure() }; procedure invalidPostcondition(x: int) - opaque - ensures false -// ^^^^^ error: assertion does not hold + returns (r: int) // TODO, removing this returns triggers a latent bug + opaque + ensures false +// ^^^^^ error: postcondition does not hold { }; " #guard_msgs (drop info, error) in -#eval testInputWithOffset "Postconditions" program 14 processLaurelFile +#eval testInputWithOffset "Postconditions" program 14 + (processLaurelFileWithOptions { translateOptions := { keepAllFilesPrefix := "/home/ubuntu/repos/Strata/Build/"}}) diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_PostconditionsErrors.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_PostconditionsErrors.lean deleted file mode 100644 index d61c5849da..0000000000 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_PostconditionsErrors.lean +++ /dev/null @@ -1,39 +0,0 @@ -/- - Copyright Strata Contributors - - SPDX-License-Identifier: Apache-2.0 OR MIT --/ - -import StrataTest.Util.TestDiagnostics -import StrataTest.Languages.Laurel.TestExamples - -open StrataTest.Util -open Strata - -namespace Strata.Laurel - -def program := r" - -function opaqueFunction(x: int) returns (r: int) -// ^^^^^^^^^^^^^^ error: functions with postconditions are not yet supported -// The above limitation is because Core does not yet support functions with postconditions - requires x > 0 - opaque - ensures r > 0 -// The above limitation is because functions in Core do not support postconditions -{ - x -}; - -procedure callerOfOpaqueFunction() - opaque -{ - var x: int := opaqueFunction(3); - assert x > 0; -// The following assertion should fail but does not - assert x == 3 -}; -" - -#guard_msgs (drop info, error) in -#eval testInputWithOffset "Postconditions" program 14 processLaurelFile diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8b_EarlyReturnPostconditions.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8b_EarlyReturnPostconditions.lean index 964fc7dfb0..f8f4b8089b 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8b_EarlyReturnPostconditions.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8b_EarlyReturnPostconditions.lean @@ -26,7 +26,7 @@ procedure earlyReturnCorrect(x: int) returns (r: int) procedure earlyReturnBuggy(x: int) returns (r: int) opaque ensures r >= 0 -// ^^^^^^ error: assertion does not hold +// ^^^^^^ error: postcondition does not hold { if x < 0 then { return x diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8c_BodilessInlining.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8c_BodilessInlining.lean index 34ef67a97e..0e6c623a03 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8c_BodilessInlining.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8c_BodilessInlining.lean @@ -5,6 +5,8 @@ -/ import Strata.SimpleAPI +import StrataTest.Util.TestDiagnostics +import StrataTest.Languages.Laurel.TestExamples /-! # Bodiless Procedure Inlining Test @@ -16,6 +18,9 @@ the inlined call is correctly rejected. -/ namespace Strata.Laurel.BodilessInliningTest +open StrataTest.Util +open Strata + private def laurelSource := " procedure bodilessProcedure() returns (r: int) opaque @@ -28,32 +33,12 @@ procedure caller() var x: int := bodilessProcedure(); assert x > 0; assert false +//^^^^^^^^^^^^ error: assertion could not be proved }; " -/-- info: "assert(161): ❌ fail" -/ -#guard_msgs in -#eval show IO String from do - let laurelProg ← Strata.parseLaurelText "test.laurel" laurelSource - let coreProg ← match ← Strata.laurelToCore laurelProg with - | .ok p => pure p - | .error e => throw (IO.userError s!"Translation failed: {e}") - let inlined ← match Strata.Core.inlineProcedures coreProg {} with - | .ok p => pure p - | .error e => throw (IO.userError s!"Inlining failed: {e}") - let vcResults ← - EIO.toIO (fun e => IO.Error.userError e) - (Strata.Core.verifyProgram inlined - { Core.VerifyOptions.default with verbose := .quiet } - (proceduresToVerify := some ["caller"])) - -- Collect only failing results - let failures := vcResults.filter fun vcr => - match vcr.outcome with - | .ok o => o.validityProperty != .unsat - | .error _ => true - let mut output := "" - for vcr in failures do - output := output ++ s!"{vcr.obligation.label}: {vcr.formatOutcome}" - return output +#guard_msgs (drop info, error) in +#eval testInputWithOffset "Postconditions" laurelSource 23 + (fun p => processLaurelFileWithOptions { translateOptions := { inlineFunctionsWhenPossible := true} } p) end Strata.Laurel.BodilessInliningTest diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8d_HeapMutatingValueReturn.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8d_HeapMutatingValueReturn.lean index 0a8321d945..96434e4c52 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8d_HeapMutatingValueReturn.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8d_HeapMutatingValueReturn.lean @@ -29,7 +29,7 @@ procedure setAndReturn(c: Container, x: int) returns (r: int) procedure setAndReturnBuggy(c: Container, x: int) returns (r: int) opaque ensures r == x + 1 -// ^^^^^^^^^^ error: assertion does not hold +// ^^^^^^^^^^ error: modifies clause could not be proved modifies c { c#value := x; diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T9_Nondeterministic.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T9_Nondeterministic.lean index d8dbacf369..545bf8830b 100644 --- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T9_Nondeterministic.lean +++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T9_Nondeterministic.lean @@ -20,7 +20,9 @@ nondet procedure nonDeterministic(x: int): (r: int) assumed }; -procedure caller() { +procedure caller() + opaque +{ var x = nonDeterministic(1) assert x > 0; var y = nonDeterministic(1) @@ -29,11 +31,13 @@ procedure caller() { }; nondet procedure nonDeterminsticTransparant(x: int): (r: int) + opaque { nonDeterministic(x + 1) }; procedure nonDeterministicCaller(x: int): int + opaque { nonDeterministic(x) }; diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean b/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean index 7dbf35022d..db0ae9527a 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean @@ -67,20 +67,17 @@ procedure updatesAndAliasing() assert dAlias#intValue == d#intValue }; -procedure subsequentHeapMutations(c: Container) - opaque - modifies c -{ +procedure subsequentHeapMutations() opaque { + var c: Container := new Container; + // The additional parenthesis on the next line are needed to let the parser succeed. Joe, any idea why this is needed? var sum: int := ((c#intValue := 1) + c#intValue) + (c#intValue := 2); assert sum == 4 }; -procedure implicitEquality(c: Container, d: Container) - opaque - modifies c - modifies d -{ +procedure implicitEquality() opaque { + var c: Container := new Container; + var d: Container := new Container; c#intValue := 1; d#intValue := 2; if c#intValue == d#intValue then { @@ -101,11 +98,9 @@ composite SameFieldName { var intValue: bool } -procedure sameFieldNameDifferentType(a: Container, b: SameFieldName) - opaque - modifies a - modifies b -{ +procedure sameFieldNameDifferentType() opaque { + var a: Container := new Container; + var b: SameFieldName := new SameFieldName; a#intValue := 1; b#intValue := true; @@ -124,9 +119,7 @@ composite Pixel { var color: Color } -procedure datatypeField() - opaque -{ +procedure datatypeField() opaque { var p: Pixel := new Pixel; p#color := Red(); assert Color..isRed(p#color); @@ -186,6 +179,8 @@ procedure fieldAssignsFromHeapModifyingMultipleReturnCaller() assert y == 2; assert z == 3 }; +<<<<<<< HEAD +======= procedure fieldTargetInMultiAssign() opaque @@ -197,6 +192,7 @@ procedure fieldTargetInMultiAssign() assert y == 2; assert z == 3 }; +>>>>>>> formatting-and-debugging-improvements "# #guard_msgs(drop info, error) in diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T3_ReadsClauses.lr.st b/StrataTest/Languages/Laurel/Examples/Objects/T3_ReadsClauses.lr.st index d95606784d..210a95c155 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T3_ReadsClauses.lr.st +++ b/StrataTest/Languages/Laurel/Examples/Objects/T3_ReadsClauses.lr.st @@ -16,10 +16,11 @@ composite Container { procedure opaqueProcedure(c: Container): int reads c - ensures true + opaque ; procedure foo(c: Container, d: Container) + opaque { var x = opaqueProcedure(c); d.value = 1; @@ -33,6 +34,7 @@ procedure foo(c: Container, d: Container) procedure permissionLessReader(c: Container): int reads {} + opaque { c.value } // ^^^^^^^ error: enclosing procedure 'permissionLessReader' does not have permission to read 'c.value' ; @@ -44,7 +46,8 @@ type Composite; type Field; val value: Field; -function opaqueProcedure_ensures(heap: Heap, c: Container, r: int): boolean { +function opaqueProcedure_ensures(heap: Heap, c: Container, r: int): boolean +{ true } diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T4_ImmutableFields.lr.st b/StrataTest/Languages/Laurel/Examples/Objects/T4_ImmutableFields.lr.st index d92a44c6bd..f287c7f84d 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T4_ImmutableFields.lr.st +++ b/StrataTest/Languages/Laurel/Examples/Objects/T4_ImmutableFields.lr.st @@ -9,6 +9,7 @@ composite ImmutableContainer { } procedure valueReader(c: ImmutableContainer): int + opaque { c.value } // no reads clause needed because value is immutable ; @@ -18,7 +19,8 @@ Translation towards SMT: type Composite; function ImmutableContainer_value(c: Composite): int -function valueReader(c: Composite): int { +function valueReader(c: Composite): int +{ ImmutableContainer_value(c) } diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritance.lean b/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritance.lean index ba406b0ddc..50a880c4f6 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritance.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritance.lean @@ -89,7 +89,7 @@ procedure diamondInheritance() }; // Currently does not pass. Implementation needs b type invariant mechanism that we have yet to add. -//procedure typedParameter(b: Bottom) { +//procedure typedParameter(b: Bottom) opaque { // var b: Bottom := b; // assert b is Left; // assert b is Right; diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean b/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean index ec05fcfd3d..4451893acf 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean @@ -15,10 +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 - opaque - { + procedure increment2(self: Counter) opaque { +// ^^^^^^^^^^ error: Instance procedure 'increment2' on composite type 'Counter' is not yet supported self#count := self#count + 1 }; procedure reset(self: Counter) diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T8_NonCompositeModifies.lean b/StrataTest/Languages/Laurel/Examples/Objects/T8_NonCompositeModifies.lean index 76bb786239..cb0a8c69a1 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/T8_NonCompositeModifies.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/T8_NonCompositeModifies.lean @@ -27,7 +27,7 @@ composite Container { procedure incWithPrimitiveModifies(x: int) returns (r: int) opaque modifies x -// ^ error: non-composite type +// ^ error: modifies clause entry has non-composite type 'int' and will be ignored { r := x + 1 }; @@ -36,7 +36,7 @@ procedure modifyContainerAndPrimitive(c: Container, x: int) opaque modifies c modifies x -// ^ error: non-composite type +// ^ error: modifies clause entry has non-composite type 'int' and will be ignored { c#value := 1 }; diff --git a/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Allocation.lr.st b/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Allocation.lr.st index cc0377ee27..9ce2bd2f05 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Allocation.lr.st +++ b/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Allocation.lr.st @@ -13,6 +13,7 @@ composite Immutable { invariant x + y >= 5 procedure construct() + opaque constructor requires contructing == {this} ensures constructing == {} @@ -23,7 +24,9 @@ composite Immutable { }; } -procedure foo() { +procedure foo() + opaque +{ val immutable = Immutable.construct(); // constructor instance method can be called as a static. }; @@ -34,6 +37,7 @@ composite ImmutableChainOfTwo { invariant other.other == this // reading other.other is allowed because the field is immutable procedure construct() + opaque constructor requires contructing == {this} ensures constructing == {} @@ -49,13 +53,16 @@ composite ImmutableChainOfTwo { // only used privately procedure allocate() + opaque constructor ensures constructing = {this} { // empty body }; } -procedure foo2() { +procedure foo2() + opaque +{ val immutable = ImmutableChainOfTwo.construct(); val same = immutable.other.other; assert immutable =&= same; @@ -67,6 +74,7 @@ composite UsesHelperConstructor { val y: int procedure setXhelper() + opaque constructor requires constructing == {this} ensures constructing == {this} && assigned(this.x) @@ -75,6 +83,7 @@ composite UsesHelperConstructor { }; procedure construct() + opaque constructor requires contructing == {this} ensures constructing == {} diff --git a/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Constructors.lr.st b/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Constructors.lr.st index 5d2c02cfd5..fd1c136e1b 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Constructors.lr.st +++ b/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Constructors.lr.st @@ -18,6 +18,7 @@ composite Immutable { // fields of Immutable are considered mutable inside this procedure // and invariants of Immutable are not visible // can only call procedures that are also constructing Immutable + opaque constructs Immutable modifies this { @@ -27,13 +28,16 @@ composite Immutable { }; procedure assignToY() + opaque constructs Immutable { this.y = 3; }; } -procedure foo() { +procedure foo() + opaque +{ var c = new Immutable.construct(); var temp = c.x; c.z = 1; @@ -41,7 +45,9 @@ procedure foo() { assert temp == c.x; // pass }; -procedure pureCompositeAllocator(): boolean { +procedure pureCompositeAllocator(): boolean + opaque +{ // can be called in a determinstic context var i: Immutable = Immutable.construct(); var j: Immutable = Immutable.construct(); diff --git a/StrataTest/Languages/Laurel/Examples/Objects/WIP/6. TypeTests.lr.st b/StrataTest/Languages/Laurel/Examples/Objects/WIP/6. TypeTests.lr.st index 6d94f9a08d..2b067c7f2a 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/WIP/6. TypeTests.lr.st +++ b/StrataTest/Languages/Laurel/Examples/Objects/WIP/6. TypeTests.lr.st @@ -19,7 +19,9 @@ composite Extended2 extends Base { var z: int } -procedure typeTests(e: Extended1) { +procedure typeTests(e: Extended1) + opaque +{ var b: Base = e as Base; // even upcasts are not implicit, but they pass statically var e2 = e as Extended2; // ^^ error: could not prove 'e' is of type 'Extended2' diff --git a/StrataTest/Languages/Laurel/Examples/Objects/WIP/7. InstanceCallables.lr.st b/StrataTest/Languages/Laurel/Examples/Objects/WIP/7. InstanceCallables.lr.st index fe4c5756d6..95cf829196 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/WIP/7. InstanceCallables.lr.st +++ b/StrataTest/Languages/Laurel/Examples/Objects/WIP/7. InstanceCallables.lr.st @@ -5,12 +5,14 @@ */ composite Base { procedure foo(): int + opaque ensures result > 3 { abstract }; } composite Extender1 extends Base { procedure foo(): int + opaque ensures result > 4 // ^^^^^^^ error: could not prove ensures clause guarantees that of extended method 'Base.foo' { abstract }; @@ -19,6 +21,7 @@ composite Extender1 extends Base { composite Extender2 extends Base { value: int procedure foo(): int + opaque ensures result > 2 { this.value + 2 // 'this' is an implicit variable inside instance callables diff --git a/StrataTest/Languages/Laurel/Examples/Objects/WIP/9. Closures.lr.st b/StrataTest/Languages/Laurel/Examples/Objects/WIP/9. Closures.lr.st index 73a72a4738..bd3932322d 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/WIP/9. Closures.lr.st +++ b/StrataTest/Languages/Laurel/Examples/Objects/WIP/9. Closures.lr.st @@ -87,6 +87,7 @@ so in affect there no longer are any variables captured by a closure. // Option A: first class procedures procedure hasClosure() returns (r: int) + opaque ensures r == 7 { var x = 3; @@ -100,17 +101,21 @@ procedure hasClosure() returns (r: int) // Option B: type closures composite ATrait { - procedure foo() returns (r: int) ensures r > 0 { + procedure foo() returns (r: int) ensures r > 0 + opaque + { abstract }; } procedure hasClosure() returns (r: int) + opaque ensures r == 7 { var x = 3; var aClosure := closure extends ATrait { procedure foo() returns (r: int) + opaque { r = x + 4; }; diff --git a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_String.lean b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_String.lean index 02b5729dc8..c5f150cb95 100644 --- a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_String.lean +++ b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_String.lean @@ -15,7 +15,7 @@ namespace Laurel def program := r#" procedure testStringKO() -returns (result: string) + returns (result: string) opaque { var message: string := "Hello"; diff --git a/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean b/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean index f3a3acbd6f..ca8e530011 100644 --- a/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean +++ b/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean @@ -23,6 +23,7 @@ namespace Strata.Laurel def blockStmtLiftingProgram : String := r" procedure assertInBlockExpr() + opaque { var x: int := 0; var y: int := { assert x == 0; x := 1; x }; @@ -40,11 +41,23 @@ def parseLaurelAndLift (input : String) : IO Program := do | .ok program => let result := resolve program let (program, model) := (result.program, result.model) - pure (liftExpressionAssignments model program) + let imperativeCallees := program.staticProcedures.filter (fun p => !p.isFunctional) + |>.map (fun p => p.name.text) + pure (liftExpressionAssignments program model imperativeCallees) /-- info: procedure assertInBlockExpr() -{ var x: int := 0; assert x == 0; var $x_0: int := x; x := 1; var y: int := { x }; assert y == 1 }; + opaque +{ + var x: int := 0; + assert x == 0; + var $x_0: int := x; + x := 1; + var y: int := { + x + }; + assert y == 1 +}; -/ #guard_msgs in #eval! do diff --git a/StrataTest/Languages/Laurel/LiftHolesTest.lean b/StrataTest/Languages/Laurel/LiftHolesTest.lean index 14d25a4416..27485548dc 100644 --- a/StrataTest/Languages/Laurel/LiftHolesTest.lean +++ b/StrataTest/Languages/Laurel/LiftHolesTest.lean @@ -46,11 +46,20 @@ info: function $hole_0() returns ($result: int) opaque; procedure test() -{ var x: int := 1 + $hole_0() }; + opaque +{ + var x: int := 1 + $hole_0() +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { var x: int := 1 + }; +<<<<<<< HEAD +procedure test() + opaque +{ var x: int := 1 + }; +======= +procedure test() opaque { var x: int := 1 + }; +>>>>>>> formatting-and-debugging-improvements " -- Bare Hole as Assign Declare initializer → replaced with call (no longer preserved as havoc). @@ -59,11 +68,20 @@ info: function $hole_0() returns ($result: int) opaque; procedure test() -{ var x: int := $hole_0() }; + opaque +{ + var x: int := $hole_0() +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { var x: int := }; +<<<<<<< HEAD +procedure test() + opaque +{ var x: int := }; +======= +procedure test() opaque { var x: int := }; +>>>>>>> formatting-and-debugging-improvements " -- Hole in comparison arg inside assert → int (inferred from sibling literal). @@ -72,11 +90,20 @@ info: function $hole_0() returns ($result: int) opaque; procedure test() -{ assert $hole_0() > 0 }; + opaque +{ + assert $hole_0() > 0 +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { assert > 0 }; +<<<<<<< HEAD +procedure test() + opaque +{ assert > 0 }; +======= +procedure test() opaque { assert > 0 }; +>>>>>>> formatting-and-debugging-improvements " -- Hole directly as assert condition → bool. @@ -85,11 +112,20 @@ info: function $hole_0() returns ($result: bool) opaque; procedure test() -{ assert $hole_0() }; + opaque +{ + assert $hole_0() +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { assert }; +<<<<<<< HEAD +procedure test() + opaque +{ assert }; +======= +procedure test() opaque { assert }; +>>>>>>> formatting-and-debugging-improvements " -- Hole directly as assume condition → bool. @@ -98,11 +134,20 @@ info: function $hole_0() returns ($result: bool) opaque; procedure test() -{ assume $hole_0() }; + opaque +{ + assume $hole_0() +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { assume }; +<<<<<<< HEAD +procedure test() + opaque +{ assume }; +======= +procedure test() opaque { assume }; +>>>>>>> formatting-and-debugging-improvements " -- Hole as if-then-else condition → bool. @@ -111,11 +156,22 @@ info: function $hole_0() returns ($result: bool) opaque; procedure test() -{ if $hole_0() then { assert true } }; + opaque +{ + if $hole_0() then { + assert true + } +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { if then { assert true } }; +<<<<<<< HEAD +procedure test() + opaque +{ if then { assert true } }; +======= +procedure test() opaque { if then { assert true } }; +>>>>>>> formatting-and-debugging-improvements " -- Hole in then-branch of if-then-else inside typed local variable → int. @@ -124,11 +180,20 @@ info: function $hole_0() returns ($result: int) opaque; procedure test() -{ var x: int := if true then $hole_0() else 0 }; + opaque +{ + var x: int := if true then $hole_0() else 0 +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { var x: int := if true then else 0 }; +<<<<<<< HEAD +procedure test() + opaque +{ var x: int := if true then else 0 }; +======= +procedure test() opaque { var x: int := if true then else 0 }; +>>>>>>> formatting-and-debugging-improvements " -- Hole as while-loop condition → bool. @@ -137,11 +202,22 @@ info: function $hole_0() returns ($result: bool) opaque; procedure test() -{ while($hole_0()) { } }; + opaque +{ + while($hole_0()) { + ⏎ + } +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { while() {} }; +<<<<<<< HEAD +procedure test() + opaque +{ while() {} }; +======= +procedure test() opaque { while() {} }; +>>>>>>> formatting-and-debugging-improvements " -- Hole as while-loop invariant → bool. @@ -150,12 +226,23 @@ info: function $hole_0() returns ($result: bool) opaque; procedure test() -{ while(true) - invariant $hole_0() { } }; + opaque +{ + while(true) + invariant $hole_0() { + ⏎ + } +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { while(true) invariant {} }; +<<<<<<< HEAD +procedure test() + opaque +{ while(true) invariant {} }; +======= +procedure test() opaque { while(true) invariant {} }; +>>>>>>> formatting-and-debugging-improvements " /-! ## Operators -/ @@ -166,11 +253,20 @@ info: function $hole_0() returns ($result: bool) opaque; procedure test() -{ assert true && $hole_0() }; + opaque +{ + assert true && $hole_0() +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { assert true && }; +<<<<<<< HEAD +procedure test() + opaque +{ assert true && }; +======= +procedure test() opaque { assert true && }; +>>>>>>> formatting-and-debugging-improvements " -- Hole in Neg inside typed local variable → int. @@ -179,11 +275,20 @@ info: function $hole_0() returns ($result: int) opaque; procedure test() -{ var x: int := -$hole_0() }; + opaque +{ + var x: int := -$hole_0() +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { var x: int := - }; +<<<<<<< HEAD +procedure test() + opaque +{ var x: int := - }; +======= +procedure test() opaque { var x: int := - }; +>>>>>>> formatting-and-debugging-improvements " -- Hole in StrConcat inside typed local variable → string. @@ -192,11 +297,17 @@ info: function $hole_0() returns ($result: string) opaque; procedure test() -{ var s: string := "hello" ++ $hole_0() }; +<<<<<<< HEAD +======= + opaque +>>>>>>> formatting-and-debugging-improvements +{ + var s: string := "hello" ++ $hole_0() +}; -/ #guard_msgs in #eval! parseElimAndPrint - "procedure test() { var s: string := \"hello\" ++ };" + "procedure test() opaque { var s: string := \"hello\" ++ };" /-! ## Multiple holes -/ @@ -209,11 +320,20 @@ function $hole_1() returns ($result: int) opaque; procedure test() -{ var x: int := $hole_0() + $hole_1() }; + opaque +{ + var x: int := $hole_0() + $hole_1() +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { var x: int := + }; +<<<<<<< HEAD +procedure test() + opaque +{ var x: int := + }; +======= +procedure test() opaque { var x: int := + }; +>>>>>>> formatting-and-debugging-improvements " -- Holes across statements: Mul arg (int) then assert condition (bool). @@ -225,11 +345,21 @@ function $hole_1() returns ($result: bool) opaque; procedure test() -{ var x: int := 2 * $hole_0(); assert $hole_1() }; + opaque +{ + var x: int := 2 * $hole_0(); + assert $hole_1() +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { var x: int := 2 * ; assert }; +<<<<<<< HEAD +procedure test() + opaque +{ var x: int := 2 * ; assert }; +======= +procedure test() opaque { var x: int := 2 * ; assert }; +>>>>>>> formatting-and-debugging-improvements " /-! ## Combinations: holes in nested contexts -/ @@ -240,11 +370,22 @@ info: function $hole_0() returns ($result: int) opaque; procedure test() -{ if 1 + $hole_0() > 0 then { assert true } }; + opaque +{ + if 1 + $hole_0() > 0 then { + assert true + } +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { if 1 + > 0 then { assert true } }; +<<<<<<< HEAD +procedure test() + opaque +{ if 1 + > 0 then { assert true } }; +======= +procedure test() opaque { if 1 + > 0 then { assert true } }; +>>>>>>> formatting-and-debugging-improvements " -- Hole in Implies inside while invariant → bool. @@ -253,12 +394,24 @@ info: function $hole_0() returns ($result: bool) opaque; procedure test() -{ var p: bool; while(true) - invariant p ==> $hole_0() { } }; + opaque +{ + var p: bool; + while(true) + invariant p ==> $hole_0() { + ⏎ + } +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { var p: bool; while(true) invariant p ==> {} }; +<<<<<<< HEAD +procedure test() + opaque +{ var p: bool; while(true) invariant p ==> {} }; +======= +procedure test() opaque { var p: bool; while(true) invariant p ==> {} }; +>>>>>>> formatting-and-debugging-improvements " -- Hole in Mul inside typed local variable with real type → real. @@ -267,11 +420,20 @@ info: function $hole_0() returns ($result: real) opaque; procedure test() -{ var r: real := 3.14 * $hole_0() }; + opaque +{ + var r: real := 3.14 * $hole_0() +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { var r: real := 3.14 * }; +<<<<<<< HEAD +procedure test() + opaque +{ var r: real := 3.14 * }; +======= +procedure test() opaque { var r: real := 3.14 * }; +>>>>>>> formatting-and-debugging-improvements " /-! ## Call argument and return type inference -/ @@ -282,11 +444,20 @@ info: function $hole_0(n: int) returns ($result: int) opaque; procedure test(n: int) -{ assert n > $hole_0(n) }; + opaque +{ + assert n > $hole_0(n) +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test(n: int) { assert n > }; +<<<<<<< HEAD +procedure test(n: int) + opaque +{ assert n > }; +======= +procedure test(n: int) opaque { assert n > }; +>>>>>>> formatting-and-debugging-improvements " /-! ## Holes in functions -/ @@ -297,11 +468,20 @@ info: function $hole_0(x: int) returns ($result: int) opaque; function test(x: int): int -{ $hole_0(x) }; + opaque +{ + $hole_0(x) +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -function test(x: int): int { }; +<<<<<<< HEAD +function test(x: int): int + opaque +{ }; +======= +function test(x: int): int opaque { }; +>>>>>>> formatting-and-debugging-improvements " /-! ## Nondeterministic holes () -/ @@ -309,11 +489,20 @@ function test(x: int): int { }; -- Nondet hole in procedure → preserved after eliminateHoles (lifted by liftExpressionAssignments). /-- info: procedure test() -{ assert }; + opaque +{ + assert +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { assert }; +<<<<<<< HEAD +procedure test() + opaque +{ assert }; +======= +procedure test() opaque { assert }; +>>>>>>> formatting-and-debugging-improvements " -- Mixed: det hole eliminated, nondet hole preserved. @@ -322,11 +511,21 @@ info: function $hole_0() returns ($result: int) opaque; procedure test() -{ var x: int := $hole_0(); assert }; + opaque +{ + var x: int := $hole_0(); + assert +}; -/ #guard_msgs in #eval! parseElimAndPrint r" -procedure test() { var x: int := ; assert }; +<<<<<<< HEAD +procedure test() + opaque +{ var x: int := ; assert }; +======= +procedure test() opaque { var x: int := ; assert }; +>>>>>>> formatting-and-debugging-improvements " -- Nondet hole in function → should be rejected (not tested here since diff --git a/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean b/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean index e88deb4143..f44067848c 100644 --- a/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean +++ b/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean @@ -42,9 +42,17 @@ private def printLifted (input : String) : IO Unit := do /-- info: procedure impure(): int -{ var x: int := 0; x := x + 1; x }; +{ + var x: int := 0; + x := x + 1; + x +}; procedure test() -{ var $c_0: int; $c_0 := impure(); assert $c_0 == 1 }; +{ + var $c_0: int; + $c_0 := impure(); + assert $c_0 == 1 +}; -/ #guard_msgs in #eval! printLifted r" @@ -62,7 +70,10 @@ procedure test() { /-- info: procedure test() -{ var x: int := 0; assert (x := 2) == 2 }; +{ + var x: int := 0; + assert (x := 2) == 2 +}; -/ #guard_msgs in #eval! printLifted r" @@ -76,9 +87,17 @@ procedure test() { /-- info: procedure impure(): int -{ var x: int := 0; x := x + 1; x }; +{ + var x: int := 0; + x := x + 1; + x +}; procedure test() -{ var $c_0: int; $c_0 := impure(); assume $c_0 == 1 }; +{ + var $c_0: int; + $c_0 := impure(); + assume $c_0 == 1 +}; -/ #guard_msgs in #eval! printLifted r" @@ -99,9 +118,16 @@ procedure test() { /-- info: procedure multi_out(x: int) returns (r: int, extra: int) -{ r := x + 1; extra := x + 2 }; +{ + r := x + 1; + extra := x + 2 +}; procedure test() -{ var $c_0: BUG_MultiValuedExpr; $c_0 := multi_out(5); assert $c_0 == 6 }; +{ + var $c_0: BUG_MultiValuedExpr; + $c_0 := multi_out(5); + assert $c_0 == 6 +}; -/ #guard_msgs in #eval! printLifted r" diff --git a/StrataTest/Languages/Laurel/StatisticsTest.lean b/StrataTest/Languages/Laurel/StatisticsTest.lean index 00bc6c7b24..94deaaf6d9 100644 --- a/StrataTest/Languages/Laurel/StatisticsTest.lean +++ b/StrataTest/Languages/Laurel/StatisticsTest.lean @@ -66,6 +66,7 @@ procedure p1(a: bool, b: bool) returns (r: bool) }; procedure p2(x: int) returns (y: int) + opaque { y := x + }; diff --git a/StrataTest/Languages/Laurel/TestExamples.lean b/StrataTest/Languages/Laurel/TestExamples.lean index 5affbb2813..13d4c92e4b 100644 --- a/StrataTest/Languages/Laurel/TestExamples.lean +++ b/StrataTest/Languages/Laurel/TestExamples.lean @@ -36,4 +36,15 @@ def processLaurelFileWithOptions (options : LaurelVerifyOptions) (input : InputC def processLaurelFile (input : InputContext) : IO (Array Diagnostic) := processLaurelFileWithOptions default input +/-- Project-root-relative path to the `Build/` directory for intermediate files. + Resolved from the current working directory so it works on any machine. -/ +def buildDir : IO String := do + let cwd ← IO.currentDir + return s!"{cwd}/Build/" + +/-- For local debugging; never invoked in CI. -/ +def processLaurelFileKeepIntermediates (input : InputContext) : IO (Array Diagnostic) := do + let dir ← buildDir + processLaurelFileWithOptions { translateOptions := { keepAllFilesPrefix := dir}} input + end Laurel diff --git a/StrataTest/Languages/Python/PySpecArgTypeTest.lean b/StrataTest/Languages/Python/PySpecArgTypeTest.lean index d921aaab9c..ff30813ef9 100644 --- a/StrataTest/Languages/Python/PySpecArgTypeTest.lean +++ b/StrataTest/Languages/Python/PySpecArgTypeTest.lean @@ -97,7 +97,12 @@ preconditions redundant. -/ info: procedure 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) }; +{ + result := ; + assert Any..isfrom_int(x); + assert Any..isfrom_str(y); + assume Any..isfrom_float(result) +}; -/ #guard_msgs in #eval! do diff --git a/StrataTest/Languages/Python/ToLaurelTest.lean b/StrataTest/Languages/Python/ToLaurelTest.lean index 597badb207..73cfaf569b 100644 --- a/StrataTest/Languages/Python/ToLaurelTest.lean +++ b/StrataTest/Languages/Python/ToLaurelTest.lean @@ -458,7 +458,7 @@ info: errors: 1 -- Regression test for issue #800: nested dict access `kwargs["Outer"]["Inner"]` -- should generate `Any_get` (dict lookup), not `FieldSelect`. /-- -info: body contains Any_get: true +info: preconditions contain Any_get: true body contains FieldSelect: false -/ #guard_msgs in @@ -487,11 +487,13 @@ body contains FieldSelect: false assert! result.errors.size = 0 match result.program.staticProcedures with | proc :: _ => + let precondStr := proc.preconditions.map (fun (p : Strata.Laurel.Condition) => toString (Strata.Laurel.formatStmtExpr p.condition)) + |> String.intercalate ", " let bodyStr := match proc.body with | .Transparent body => toString (Strata.Laurel.formatStmtExpr body) | .Opaque _ (some body) _ => toString (Strata.Laurel.formatStmtExpr body) | _ => "" - IO.println s!"body contains Any_get: {bodyStr.contains "Any_get"}" + IO.println s!"preconditions contain Any_get: {precondStr.contains "Any_get"}" IO.println s!"body contains FieldSelect: {bodyStr.contains "#"}" | [] => IO.println "no procedures" @@ -723,7 +725,13 @@ private def translatePrecondResult (preconditions : Array Assertion) private def translatePrecond (preconditions : Array Assertion) (args : Array Arg := #[]) : String × Nat := let result := translatePrecondResult preconditions args - (getBody result |>.getD "", result.errors.size) + let precondStr := match result.program.staticProcedures with + | proc :: _ => + let formatted := proc.preconditions.map (fun (p : Strata.Laurel.Condition) => toString (Strata.Laurel.formatStmtExpr p.condition)) + if formatted.isEmpty then getBody result |>.getD "" + else "{ " ++ (String.intercalate "; " formatted) ++ " }" + | [] => "" + (precondStr, result.errors.size) -- enumMember: or and eq via `|` and `==` infix syntax #eval do @@ -765,12 +773,13 @@ private def translatePrecond (preconditions : Array Assertion) message := #[], formula := .containsKey (.var "kwargs" loc) "key" loc }] postconditions := #[] }] "" - let body := getBody result |>.getD "" assertEq result.errors.size 0 - assert! body.contains "result := " - assert! body.contains "Any..isfrom_None(key) | Any..isfrom_str(key)" - assert! body.contains "assert !Any..isfrom_None(key) summary \"precondition 0\"" - assert! body.contains "assume Any..isfrom_str(result)" + match result.program.staticProcedures with + | proc :: _ => + let precondStr := proc.preconditions.map (fun (p : Strata.Laurel.Condition) => toString (Strata.Laurel.formatStmtExpr p.condition)) + |> String.intercalate ", " + assert! precondStr.contains "!Any..isfrom_None(key)" + | [] => assert! false -- containsKey on a non-kwargs dict: DictStrAny_contains in an assert -- (would have been silently dropped before fix #2) diff --git a/StrataTest/Languages/Python/expected_laurel/test_class_decl.expected b/StrataTest/Languages/Python/expected_laurel/test_class_decl.expected index 2583076f7e..bbe3923445 100644 --- a/StrataTest/Languages/Python/expected_laurel/test_class_decl.expected +++ b/StrataTest/Languages/Python/expected_laurel/test_class_decl.expected @@ -1,3 +1,3 @@ -test_class_decl.py(9, 4): ✅ pass - (CircularBuffer@__init__ requires) Type constraint of n +test_class_decl.py(9, 4): ✅ pass - callElimAssert_requires_15 DETAIL: 1 passed, 0 failed, 0 inconclusive RESULT: Analysis success diff --git a/StrataTest/Languages/Python/expected_laurel/test_class_methods.expected b/StrataTest/Languages/Python/expected_laurel/test_class_methods.expected index 36c53a8361..dc91f71f00 100644 --- a/StrataTest/Languages/Python/expected_laurel/test_class_methods.expected +++ b/StrataTest/Languages/Python/expected_laurel/test_class_methods.expected @@ -7,5 +7,5 @@ test_class_methods.py(34, 4): ✔️ always true if reached - set_balance should test_class_methods.py(31, 4): ✔️ always true if reached - assert_name_is_foo test_class_methods.py(31, 4): ✔️ always true if reached - assert_opt_name_none_or_str test_class_methods.py(31, 4): ✔️ always true if reached - assert_opt_name_none_or_bar -DETAIL: 9 passed, 0 failed, 0 inconclusive +DETAIL: 13 passed, 0 failed, 0 inconclusive RESULT: Analysis success diff --git a/StrataTest/Languages/Python/expected_laurel/test_class_no_init_with_method.expected b/StrataTest/Languages/Python/expected_laurel/test_class_no_init_with_method.expected index 29b6682a29..92196da4ef 100644 --- a/StrataTest/Languages/Python/expected_laurel/test_class_no_init_with_method.expected +++ b/StrataTest/Languages/Python/expected_laurel/test_class_no_init_with_method.expected @@ -1,5 +1,5 @@ test_class_no_init_with_method.py(4, 23): ❓ unknown - (WithMethod@get_x ensures) Return type constraint test_class_no_init_with_method.py(8, 4): ✅ pass - callElimAssert_requires_4 test_class_no_init_with_method.py(9, 4): ✅ pass - class with method but no __init__ -DETAIL: 2 passed, 0 failed, 1 inconclusive -RESULT: Inconclusive +DETAIL: 2 passed, 0 failed, 0 inconclusive +RESULT: Analysis success diff --git a/StrataTest/Languages/Python/expected_laurel/test_class_with_methods.expected b/StrataTest/Languages/Python/expected_laurel/test_class_with_methods.expected index 1085e02e58..8e46807ff6 100644 --- a/StrataTest/Languages/Python/expected_laurel/test_class_with_methods.expected +++ b/StrataTest/Languages/Python/expected_laurel/test_class_with_methods.expected @@ -5,5 +5,5 @@ test_class_with_methods.py(32, 4): ✔️ always true if reached - get_name shou test_class_with_methods.py(29, 4): ✔️ always true if reached - assert_name_is_foo test_class_with_methods.py(29, 4): ✔️ always true if reached - assert_opt_name_none_or_str test_class_with_methods.py(29, 4): ✔️ always true if reached - assert_opt_name_none_or_bar -DETAIL: 7 passed, 0 failed, 0 inconclusive +DETAIL: 10 passed, 0 failed, 0 inconclusive RESULT: Analysis success diff --git a/StrataTest/Languages/Python/expected_laurel/test_composite_return.expected b/StrataTest/Languages/Python/expected_laurel/test_composite_return.expected index 9380a52945..a20220ac72 100644 --- a/StrataTest/Languages/Python/expected_laurel/test_composite_return.expected +++ b/StrataTest/Languages/Python/expected_laurel/test_composite_return.expected @@ -1,3 +1,3 @@ -test_composite_return.py(10, 4): ✅ pass - (MyService@__init__ requires) Type constraint of name +test_composite_return.py(10, 4): ✅ pass - callElimAssert_requires_5 DETAIL: 1 passed, 0 failed, 0 inconclusive RESULT: Analysis success diff --git a/StrataTest/Languages/Python/expected_laurel/test_field_write.expected b/StrataTest/Languages/Python/expected_laurel/test_field_write.expected index cb51cb69f9..4d59d1a2ae 100644 --- a/StrataTest/Languages/Python/expected_laurel/test_field_write.expected +++ b/StrataTest/Languages/Python/expected_laurel/test_field_write.expected @@ -1,4 +1,5 @@ -test_field_write.py(8, 4): ✅ pass - (Cell@__init__ requires) Type constraint of val +test_field_write.py(8, 4): ✅ pass - callElimAssert_requires_5 +test_field_write.py(10, 4): ✅ pass - assert_assert(147)_calls_Any_to_bool_0 test_field_write.py(10, 4): ✅ pass - field overwritten -DETAIL: 2 passed, 0 failed, 0 inconclusive +DETAIL: 3 passed, 0 failed, 0 inconclusive RESULT: Analysis success diff --git a/StrataTest/Languages/Python/expected_laurel/test_method_kwargs_no_hierarchy.expected b/StrataTest/Languages/Python/expected_laurel/test_method_kwargs_no_hierarchy.expected index 56de827e26..14ec6f436e 100644 --- a/StrataTest/Languages/Python/expected_laurel/test_method_kwargs_no_hierarchy.expected +++ b/StrataTest/Languages/Python/expected_laurel/test_method_kwargs_no_hierarchy.expected @@ -8,5 +8,5 @@ test_method_kwargs_no_hierarchy.py(11, 18): ✅ pass - (Calculator@add requires) test_method_kwargs_no_hierarchy.py(11, 4): ✅ pass - assert(254) test_method_kwargs_no_hierarchy.py(12, 4): ❓ unknown - assert(286) test_method_kwargs_no_hierarchy.py(8, 14): ✅ pass - (main ensures) Return type constraint -DETAIL: 8 passed, 0 failed, 2 inconclusive +DETAIL: 6 passed, 0 failed, 2 inconclusive RESULT: Inconclusive diff --git a/StrataTest/Languages/Python/expected_laurel/test_with_void_enter.expected b/StrataTest/Languages/Python/expected_laurel/test_with_void_enter.expected index 86faeff6d1..efb6425e21 100644 --- a/StrataTest/Languages/Python/expected_laurel/test_with_void_enter.expected +++ b/StrataTest/Languages/Python/expected_laurel/test_with_void_enter.expected @@ -1,4 +1,8 @@ +test_with_void_enter.py(12, 4): ✅ pass - callElimAssert_requires_14 +test_with_void_enter.py(13, 4): ✅ pass - callElimAssert_requires_9 test_with_void_enter.py(14, 8): ✅ pass - assert(272) +test_with_void_enter.py(13, 4): ✅ pass - callElimAssert_requires_4 +test_with_void_enter.py(15, 4): ✅ pass - assert_assert(287)_calls_Any_to_bool_0 test_with_void_enter.py(15, 4): ✅ pass - assert(287) -DETAIL: 2 passed, 0 failed, 0 inconclusive +DETAIL: 6 passed, 0 failed, 0 inconclusive RESULT: Analysis success diff --git a/StrataTest/Languages/Python/run_py_analyze_sarif.py b/StrataTest/Languages/Python/run_py_analyze_sarif.py index 1e12630061..0b63cb9bbb 100755 --- a/StrataTest/Languages/Python/run_py_analyze_sarif.py +++ b/StrataTest/Languages/Python/run_py_analyze_sarif.py @@ -67,7 +67,11 @@ "test_with_statement", "test_fstrings", } -SKIP_TESTS_LAUREL = BOTH_SKIP +SKIP_TESTS_LAUREL = BOTH_SKIP | { + "test_try_except", # TVoid type from raise statements not supported in function copies + "test_multiple_except", # TVoid type from raise statements not supported in function copies + "test_datetime_now_tz", # Resolution failure: timezone/utc not defined +} def run(test_file: str, *, laurel: bool) -> bool: diff --git a/StrataTest/Languages/Python/tests/cbmc_expected.txt b/StrataTest/Languages/Python/tests/cbmc_expected.txt index 0dc6283317..b078d4aaff 100644 --- a/StrataTest/Languages/Python/tests/cbmc_expected.txt +++ b/StrataTest/Languages/Python/tests/cbmc_expected.txt @@ -33,6 +33,7 @@ test_if_elif.py.ion SKIP test_variable_reassign.py.ion SKIP test_datetime_now_tz.py.ion SKIP test_timedelta_expr.py.ion SKIP +test_composite_return.py.ion PASS test_multi_assign.py.ion FAIL test_multi_assign_triple.py.ion FAIL test_multi_assign_side_effect.py.ion SKIP diff --git a/StrataTest/Util/TestDiagnostics.lean b/StrataTest/Util/TestDiagnostics.lean index ebfb9f8ecb..3a23a20c4b 100644 --- a/StrataTest/Util/TestDiagnostics.lean +++ b/StrataTest/Util/TestDiagnostics.lean @@ -137,6 +137,10 @@ def testInputWithOffset (filename: String) (input : String) (lineOffset : Nat) IO.println s!"\nUnexpected diagnostics:" for diag in unmatchedDiagnostics do IO.println s!" - Line {diag.start.line}, Col {diag.start.column}-{diag.ending.column}: {diag.message}" + + if unmatchedExpectations.length == 0 && unmatchedDiagnostics.length == 0 then + IO.println s!"Duplicate diagnostics: {repr diagnostics}" + throw (IO.userError "Test failed") def testInput (filename: String) (input : String) (process : Lean.Parser.InputContext -> IO (Array Diagnostic)) : IO Unit := diff --git a/StrataTestExtra/Languages/Python/AnalyzeLaurelTest.lean b/StrataTestExtra/Languages/Python/AnalyzeLaurelTest.lean index 0b2c761a2e..11c001a009 100644 --- a/StrataTestExtra/Languages/Python/AnalyzeLaurelTest.lean +++ b/StrataTestExtra/Languages/Python/AnalyzeLaurelTest.lean @@ -349,10 +349,9 @@ Without the attribute, the regex VC would be ❓ unknown. -/ | .error msg => throw <| IO.userError s!"Pipeline failed: {msg}" | .ok vcResults => for r in vcResults do - if r.obligation.label.startsWith "servicelib_Storage_" then - if !r.isSuccess then - throw <| IO.userError - s!"Expected all Storage preconditions to pass but got: {r.formatOutcome}" + if !r.isSuccess then + throw <| IO.userError + s!"Expected all Storage preconditions to pass but got: {r.formatOutcome}" /-! ## Resolution error test after FilterPrelude