From aaca68f619746418d39e6b9e6b40a6ecc6ee0bb8 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Mon, 29 Jun 2026 14:36:02 +0000 Subject: [PATCH 01/28] prototype plan --- docs/design/laurel_extensions.md | 449 +++++++++++++++++++++++++++++++ 1 file changed, 449 insertions(+) create mode 100644 docs/design/laurel_extensions.md diff --git a/docs/design/laurel_extensions.md b/docs/design/laurel_extensions.md new file mode 100644 index 0000000000..b204f695fc --- /dev/null +++ b/docs/design/laurel_extensions.md @@ -0,0 +1,449 @@ +# Laurel Extensions for Exception Handling (Holistic Design — WIP) + +_Last updated: 2026-06-25_ + +This document proposes a **single, coherent set of Laurel extensions** intended to +host *all* the exception-handling features `F1`–`F36` — F1–F30 for the three initial +front-ends (Java/Python/JavaScript) and F31–F36 for the Kotlin/C# candidates (each +`F` is named in the coverage table below). The features are interdependent, so we +design the extension *areas* together rather than feature-by-feature, then show how +each area serves the relevant `F`. + +It is anchored in a design baseline: a single optional `throws` type per procedure, a +separate `onThrow` exceptional postcondition, a value-carrying `throw`, and +predicate-based catch clauses, lowering toward `Result`. + +> **Scope.** Synchronous exception handling only. + +> **STATUS: working draft.** Extensions E1–E7 below are worked through. The table +> below maps every feature (F1–F36) to the extension(s) that cover it. + +--- + +## Feature coverage (F1–F36 → extensions) + +How each feature `F1`–`F36` is covered by the design extensions E1–E7 below. E1 (the rooted `BaseException` typing of +`throw`/`catch`/`onThrow`) underlies the whole table; only the most relevant extensions are +named per row. "Front-end" means the feature is realized by a front-end desugaring or check +on top of the named extension, not by a new core construct. + +| ID | Feature | Extension(s) | How it is covered | +|----|---------|-------------|-------------------| +| F1 | Unchecked | E4, E7 | front-end imposes no declare-or-catch; `throws` declared/inferred, lowered to `Result` | +| F2 | Checked exceptions | E4, E3 | Java front-end does declare-or-catch; Laurel records `throws`; multi-type via `onThrow` predicate | +| F3 | Any value thrown (JS) | E1 | JS front-end wraps raw values in `DynamicJsValue extends BaseException` | +| F4 | Single rooted hierarchy | E1 | prelude root `BaseException`; user types `extends` it | +| F5 | `Error` fatal tier (Java) | E1 | front-end makes Java's `Error` a direct child of the root, outside its catchable `Exception` tier, so `is Exception` is false | +| F6 | `BaseException`-only tier (Py) | E1 | front-end makes `SystemExit`/`KeyboardInterrupt`/`GeneratorExit` direct children of the root, outside its `Exception` tier | +| F7 | Type dispatch, most-specific-first | E3 | ordered `catch e when e is T`, first-match-wins | +| F8 | No dispatch, manual (JS) | E3, E1 | one catch-all clause + manual `is`/field inspection | +| F9 | At most one catch (JS) | E3 | front-end emits a single clause | +| F10 | Multiple catch clauses | E3 | ordered `catches` list | +| F11 | Multi-catch | E3 | one clause `catch e when e is A \|\| e is B` | +| F12 | Optional binding | E3 | binding mandatory in IR; front-end synthesizes a name when omitted | +| F13 | `else` (on success) | E5 | front-end desugars (success flag inside `finally`) | +| F14 | `finally` | E5 | core `Try.finally` arm | +| F15 | try-with-resources (Java) | E5 | front-end desugars to nested `try`/`finally` + suppressed (F26) | +| F16 | Context-manager `with` (Py) | E5 | front-end desugars to `try`/`finally` (`__enter__`/`__exit__`) | +| F17 | `with` suppression (Py) | E5 | front-end desugars to `try`/`catch`/`finally` with conditional rethrow | +| F18 | `return`-in-`finally` masking | E5 | `finally` lowering: abrupt completion wins | +| F19 | Explicit cause chaining | E6 | `cause` field on `BaseException`, set by front-end | +| F20 | Implicit context (`__context__`) | E6, E2 | `context` field, written when raising mid-handling | +| F21 | Chain suppression (`from None`) | E6 | `suppressContext` flag / cleared `cause` | +| F22 | `add_note` | E6 | `notes` list field appended by front-end | +| F23 | `throw e` preserves trace (Java) | E2 | base `throw e`; traces not modelled | +| F24 | Bare `raise` (Py) | E2 | front-end lowers to `throw e` against the catch binding | +| F25 | `AggregateError` (JS) | E6 | library composite with an `errors` list | +| F26 | Suppressed (Java) | E6, E5 | `suppressed` field; try-with-resources attaches the secondary failure | +| F27 | `ExceptionGroup`/`except*` (Py) | E6 | library composite; `except*` desugared; possible future first-class `catch*` | +| F28 | Generator `.throw()` (Py/JS) | E6 | deferred to the generator feature; reuses ordinary `throw` | +| F29 | Exceptions as control flow (Py) | E6 | ordinary composites (`StopIteration`/`GeneratorExit`) via the normal machinery | +| F30 | Cleanup-bypassing exit | E6 | builtin `ensures false` (`os._exit`) / `throw SystemExit` (`sys.exit`) | +| F31 | `Result`/`runCatching` (Kotlin) | E7 | the same `Result` surfaced as a value | +| F32 | `when` guards (C#) | E3 | guard predicate `e is T && cond` | +| F33 | try-as-expression (Kotlin) | — | **out of scope (for now):** `Try` is a unified `StmtExpr`, but value-yielding semantics are deferred | +| F34 | `Nothing` bottom type (Kotlin) | E7 | non-throwers unwrapped; always-throws ⇒ `Nothing` on the normal channel (needs a bottom type) | +| F35 | `finally` cannot be exited (C#) | E5 | front-end check rejecting `return`/`break`/`continue` in `finally` | +| F36 | `ExceptionDispatchInfo` (C#) | E2 | collapses to `throw e` (traces not modelled) | + +--- + +## Extension areas (overview) + +The constructs the design adds to Laurel, grouped. Extensions E1–E7 resolve the choices +within these areas; the table above maps individual features. + +- **A. Exceptional control-flow channel** — a `throw` statement plus an exceptional + procedure-exit path. +- **B. Throwable values & exception hierarchy** — the `BaseException` channel root (E1); + any tiering above it is front-end policy. +- **C. Procedure exceptional contract** — an optional single `throws` type and an + `onThrow` exceptional postcondition. +- **D. Structured handler** — `try` / predicate-based `catch` / `finally` (E3, E5). +- **E. Resource & scoped cleanup** — try-with-resources and context-managers, by + desugaring (E5). +- **F. Aggregation & groups** — multi-error carriers and group matching, deferred (E6). +- **G. Control-flow-as-exceptions & termination** — generator injection, iteration + sentinels, cleanup-bypassing exit; deferred (E6). +- **H. Candidate-feature hooks (Kotlin/C#)** — F31–F36. +- **I. Lowering to Core** — `Result` plus labelled blocks / `Exit` (E7). + +--- + +## Extensions + +### E1. Throwable values are rooted at a prelude `BaseException` + +**Extension.** Laurel is extended with a single, prelude-defined root composite +`BaseException`, and every value that travels on the exceptional channel is a subtype of +it. `throw`'s operand, a `catch` binding, and the `onThrow` exception binder are all typed +`BaseException` (or a declared subtype). + +The prelude defines **only the root** — the one type Laurel itself depends on, because it +anchors the exceptional channel for the type-checker: + +``` +composite BaseException { + var message: string +}; +``` + +**Tiering is front-end policy, not a Laurel concern.** Laurel deliberately does **not** +predefine an `Exception` / fatal split (or any other taxonomy). The "escapes an ordinary +catch-all" behavior — Java's `Error`, Python's `SystemExit`/`KeyboardInterrupt`/ +`GeneratorExit` — is not a Laurel construct. It is realized entirely by (a) the front-end +choosing *which parent a type extends* and (b) the catch predicate. Laurel's subtype +machinery evaluates `e is T` generically and treats every exception type as an ordinary +composite. + +This is intentional. Predefining a two-tier (or N-tier) taxonomy would bake Java/Python's +particular structure into a language-neutral IR — the same objection as enumerating every +`SystemExit`-like type — and it buys **no verification power**: VC generation, the E4 +no-escape invariant (which is about the channel root), and E7's `Err` typing (bounded by +`BaseException`) are all tier-independent, and predefining tiers cannot stop a front-end +from extending the wrong parent anyway. So the catchable-vs-fatal distinction stays where +it belongs — in the front-end. Adding a built-in tier to Laurel would only be justified +later if Laurel grew a first-class catch-all that needed a built-in "everything except +fatal," or if the verifier needed to reason structurally about a fatal tier; neither is in +scope. + +**How this serves F4–F6.** + +- **F4 (single rooted hierarchy):** Java's `Throwable` / Python's `BaseException` map onto + the root; user types `extends` it, directly or transitively. +- **F5/F6 (the "escapes a normal catch" tiers):** the front-end models its catchable tier + (e.g. a front-end-defined `Exception` type) and its fatal/exit types as *separate* + children of `BaseException`. Because a fatal type is not a subtype of the front-end's + catchable tier, `e is Exception` is automatically `false` for it — the escape falls out + of the subtype check, needing nothing beyond how the front-end wires `extends`. + (F3/F8 — JavaScript's throw-anything and manual inspection — are handled by the JS + wrapper; see Q1.) + +> **Prelude gating (implementation note).** `BaseException` is a *composite*, so it +> participates in the heap model — unlike the always-on datatype/function prelude, which +> is "free" for SMT. The Laurel pipeline prepends the prelude unfiltered, so injecting a +> heap-participating composite into *every* program perturbs SMT heap reasoning for +> programs that don't use exceptions. The exception prelude is therefore prepended **only +> when a program references it** (names `BaseException` or a subtype). Programs that do +> not use exceptions are unaffected. + +> **Note (type-checker, validated in prototype).** `e is T` is rejected as a *type error* +> when `e`'s static type and `T` are unrelated (neither is a subtype of the other), rather +> than evaluating to `false`. This is exactly why the catch binding is typed at the root +> `BaseException`: bound at the root, `e is Exception` (for a front-end `Exception` tier) +> is well-typed and resolves to `false`/`true` at verification, so F5/F6 work. Binding at +> a narrow sibling type instead would make the cross-tier test ill-typed. + + +#### Q1 (resolved): thrown values are `BaseException` composites; JS boxes into a wrapper + +**Decision.** Every thrown value is a `composite` rooted at `BaseException` +(**alternative (i)** below). Non-composite values (**datatypes**) are *not* thrown +directly. JavaScript's throw-anything is handled by the front-end boxing the value in a +wrapper, `composite DynamicJsValue extends BaseException { var value: JsValue }`: + +``` +var ex := new DynamicJsValue; ex#value := JsString("oops"); throw ex +``` + +`catch` binds a `BaseException` and unwraps via `(e as DynamicJsValue)#value`. + +**Why this is simplest.** It is a **front-end concern only** and reuses the E1 machinery +verbatim — `extends BaseException` (subtyping is already implemented via `TypeLattice`), +`new`, field assignment, and `as` are all existing AST constructs. The shared prelude +needs only the generic `BaseException` root; `DynamicJsValue`/`JsValue` are JS-front-end +types (the front-end already needs a `JsValue` representation for dynamic values). So this +adds **no new core construct, no type-system change, and no change to the Core/SMT +encoding**, and keeps the channel uniformly typed (simple `catch`/`onThrow` typing). F8's +manual inspection is emitted as ordinary `is`/field/`if` predicates. The only cost — a +wrapper allocation plus a downcast per throw — is a runtime/perf concern that does not +matter for verification (the allocation is conceptually free; the downcast is an +`AsType` the verifier already understands). + +**Alternative (ii), rejected — datatypes thrown directly.** The thrown value would be the +`JsValue` datatype itself (`throw JsString("oops")`), with `catch` binding it at its own +type. *Pro:* no boxing. *Con:* the channel is no longer uniformly `BaseException` (its +type becomes "`BaseException` or any thrown value"), which forces a language-neutral +relaxation of the channel type away from `BaseException` — touching `throw`/`catch`/ +`onThrow` typing in the type system *and* the Core/SMT encoding. That is strictly more +core surface area for no verification benefit, so we do not adopt it. + + +### E2. Bare rethrow lowers to `throw e` — no dedicated rethrow construct + +**Extension.** Laurel adds **no** no-operand rethrow form. The base +`throw` keeps the rule that it "takes a value and nothing else," and +a source-level bare rethrow is lowered by the front-end to `throw e`, where `e` is the +catch binding for the currently-handled exception. This is always possible because +every `CatchClause` carries a **mandatory** binding, so inside any +handler there is always a name for the in-flight exception; where the source omits the +name (F12), the front-end synthesizes a fresh one. + +**Why no construct is needed.** F23 is already the base `throw e` (Java re-throws by +naming the caught object). F24 (bare `raise`) and F36 (`ExceptionDispatchInfo`) are +motivated entirely by stack-trace preservation — a runtime-metadata concern Laurel does +not model — so re-throwing the same value via `throw e` is semantically identical to a +"trace-preserving" rethrow. Bare `raise` lowers to `throw e` against the catch binding. +A `rethrow` form would buy no IR-level behavior. + +**Subtlety (relationship to F20).** Python distinguishes bare `raise` (F24 — re-raise +the current exception, *no* new `__context__`) from `raise e` (a fresh raise that, when +done mid-handling, sets `__context__` — that is F20, implicit context chaining). +Lowering both to `throw e` erases that distinction at the IR level, which is correct +**provided context chaining (F19–F22) stays front-end-managed** — i.e. the front-end +explicitly writes the `context`/`cause` fields when it wants them, rather than `throw` +establishing context implicitly. Chaining is already deferred to E6 on exactly +those terms, so this remains sound. The only thing that would force a dedicated +`rethrow` is giving `throw` *implicit* context semantics, which this design avoids +precisely to keep this viable. + + +### E3. Catch dispatch: predicate-based clauses + +**Extension.** A `catch` clause is a binding plus an optional predicate guard (no +types). The observable dispatch is an ordered clause list with first-match-wins. +Type dispatch is written `catch e when e is T`, and multi-catch +`catch e when e is A || e is B`. This is a single, minimal mechanism: there is no +type-list clause form and no surface sugar — front-ends call `isType` explicitly. + +**Clause shape and dispatch.** + +``` +structure CatchClause { + binding : Identifier -- bound to the caught value (typed BaseException) + predicate : Option StmtExpr -- guard; absent = catch-all + body : StmtExpr +} +``` + +A `Try` holds an ordered `catches : List CatchClause`. Clauses are tried in order; for +each, `binding` is bound to the caught value and `predicate` (if present) is evaluated; +the first match runs its `body`; if none match, the exception propagates out of the +`try`. This is **first-match-wins**. + +**Feature coverage** is the table's dispatch rows (F7–F12, F32). Java's +"broader-before-narrower is a compile error" ordering is a front-end check (Python's +runtime first-match is not an error). + +**Points to pin down.** + +- The binding stays typed `BaseException`. A multi-type catch + (`catch e when e is A || e is B`) has no single narrow type, so the binding is the + common root; a body that needs subclass fields narrows via `(e as T)`. +- Guard predicates are expected to be **pure**. F32's side-effecting filter idiom + (`when (Log(e))` returning `false`) relies on observable side effects during matching + and is therefore not modelled faithfully. +- A multi-type checked declaration only constrains the *type set*; per-type exceptional + postconditions still require explicit `onThrow` clauses. + +The `try` / `else` / `finally` *handler arms* (how the surrounding structure is shaped, +not how clauses match) are covered by **E5**. + + +### E4. `throws` enforcement is front-end-only; Laurel records, not enforces + +**Extension.** Laurel **records** a procedure's declared exception type +(`throws`/`onThrow`) as exceptional-postcondition data the verifier reasons about, but +performs **no** Java-style declare-or-catch check. Java's checked-exception rule (F2) is +run by the Java front-end on the Java source; Python/JavaScript/Kotlin front-ends skip +it. F1 (unchecked) and F2 (checked) then produce identical Laurel constructs — the only +difference is whether the front-end ran the check. + +**Recording ≠ enforcing.** Two things are easy to conflate: + +- *Recording / soundness modelling* — the verifier must know a callee can exit + exceptionally (its `throws`/`onThrow`) to reason about a call site. This is needed + whether or not the source language has checked exceptions, and is **not** enforcement. +- *The declare-or-catch static check* (F2) — a source-language well-formedness rule. + This is what is left to the front-end. + +**How this serves the static-checking features:** + +- **F2 (checked exceptions — Java):** the Java front-end performs declare-or-catch on the + Java AST — where the checked/unchecked distinction, the hierarchy, and "unrelated + checked types" all live — and emits the resulting `throws` declarations. Laurel does + not re-check it. +- **F1 (unchecked — Java runtime tier, Py, JS):** nothing extra. The front-end imposes + no declare-or-catch obligation; it just declares (or infers) `throws` on procedures + that can throw so the verifier models them. + +**The one invariant Laurel does enforce (semantic, language-agnostic).** Sound lowering +to `Result` requires that *a procedure with no `throws` declaration cannot let +an exception escape* — every throw inside it must be caught. Violating it is a +verification failure (like an unmet postcondition). This is the language-neutral +*counterpart* of declare-or-catch, not Java's syntactic rule. Consequences: + +- The *callee marking* ("this procedure can throw") must exist for soundness; it comes + from the `throws` declaration, or from future inference (ties to E7). +- F1 front-ends therefore still declare or infer `throws` on throwing procedures even + though their source language does not require it, so the invariant is satisfiable. + +**Why front-end-only over Laurel-enforced.** Enforcing F2 in Laurel would bake a +Java-specific rule (checked vs unchecked tiers, hierarchy knowledge) into a +language-agnostic IR; every other front-end would have to opt out, and it would +duplicate the check the Java front-end already runs — with no benefit to verification. +Recording `throws` plus the semantic no-escape invariant gives soundness without the +Java-specific machinery. + + +### E5. `finally` is a core handler arm; `else` and resource forms are desugared + +**Extension.** The `Try` structure gains one new core arm, `finally`; everything else in +this theme is front-end desugaring into `try`/`catch`/`finally`. + +``` +structure Try { + body : StmtExpr + catches : List CatchClause + finally : Option StmtExpr -- core cleanup arm; runs on every exit path (F14) +} +``` + +**Why `finally` is core.** It runs on *every* exit path — normal completion, +`return`/`Exit`, and a propagating throw — and its interaction with abrupt completion is +the subtle part: a `return` or throw inside `finally` overrides a pending exception and +any prior return (F18). Centralizing it in one lowering means every front-end gets that +masking behavior correct for free, rather than each re-deriving it. + +**Why `else` is not core.** Python's `else` (F13) is plain control flow — "run after the +body succeeds, outside the catches" — with no subtle interaction with the exceptional +channel, and it is Python-only. The front-end desugars it with a success flag inside the +`finally` scope, so it needs no core arm: + +``` +try { + try { body; ok := true } catch e when e is E { handler } + if ok { elsebody } +} finally { cleanup } +``` + +The remaining cleanup features are front-end work over `try`/`catch`/`finally` (see the +table): `else` (F13) as above; try-with-resources (F15) and `with`/context-managers +(F16/F17) by desugaring; and F35 (C# forbidding exit from `finally`) as a front-end check +— Laurel core must *allow* exit from `finally` to model F18 for the other languages. + + +### E6. Chaining, aggregation, control flow and termination are deferred (no new core) + +**Extension.** None of these features get new core exception machinery now. Each rests on +top of E1–E5 as one of: (a) a **library composite** or extra **field** on +`BaseException`, (b) a **front-end desugaring** onto already-decided constructs, or +(c) an ordinary **builtin procedure**. They are deferred — recorded here so the design +is complete, but not specified in detail. + +**The concrete shapes** (deferred, recorded for completeness): + +- *Chaining/notes (F19–F22):* fields on `BaseException` written by the front-end — + `cause : BaseException` (F19), `context : BaseException` (F20), a `suppressContext` + flag (F21), a `notes` list (F22). +- *Aggregation/groups (F25–F27):* library composites — + `AggregateError extends BaseException { errors : List BaseException }` (F25; the + front-end picks the parent — e.g. its own `Error` tier); a + `suppressed : List BaseException` field that try-with-resources (F15, E5) populates + (F26); `ExceptionGroup extends BaseException { exceptions : List BaseException }` with + `except*` desugared (F27). +- *Control flow (F28–F29):* F28 (generator `.throw()`) belongs to the generator feature + and reuses ordinary `throw` once that lands; F29 (`StopIteration`/`GeneratorExit`) are + ordinary composites via the normal machinery. +- *Termination (F30):* `os._exit`/`System.exit` is a builtin with `ensures false` (never + returns, not a throw, so it bypasses `finally`); Python's catchable `sys.exit()` maps + to `throw` of a front-end `SystemExit` type (a direct child of `BaseException`, outside + the catchable tier) instead. + +**Why `except*` (F27) is the only possible future core work.** The predicate catch of E3 +is **select-one-of**: first-match-wins, exactly one clause fires, and it binds the whole +thrown value. `except*` is **partition-and-run-all-with-residual**: a single +`ExceptionGroup` is *split* across clauses (several may fire, each on its matching +subgroup), and the unmatched remainder re-raises automatically. The same primitives still +express it — the front-end emits a catch-all that splits the group, runs each matching +handler, and re-throws the remainder: + +``` +try { ... } +catch e { // catch the whole group + var m1 := splitMatching(e, ValueError); + if !isEmpty(m1) { eg := m1; } + var m2 := splitMatching(e, TypeError); + if !isEmpty(m2) { eg := m2; } + var rest := unmatched(e, [ValueError, TypeError]); + if !isEmpty(rest) { throw rest } // re-raise the remainder +} +``` + +A first-class `catch*` would simply bake in that split/run-all/residual shape; since it +desugars, it stays deferred. + + +### E7. `Result` lowering requires generic datatypes; non-throwers stay unwrapped + +**Extension.** An exceptional procedure (one with a `throws` declaration) lowers to return +a generic `Result` sum type carrying either the normal value (`Good`) or the +thrown exception (`Bad`); a **non-throwing procedure returns its value type directly, +unwrapped** — no `Result`, no `Err` (E4). This **requires Laurel to support +generic (polymorphic) datatypes** — a single `Result`, not concrete +per-instantiation types. Laurel does not have polymorphic datatypes today (confirmed in +the grammar/AST and the `CoreDefinitionsForLaurel` "fix when Laurel supports polymorphism" +TODO), so this is a **prerequisite** for the lowering. Generics are a known, needed +addition expected soon, and we deliberately do **not** work around their absence by +synthesizing monomorphized `Result__` types. + +``` +datatype Result { Good(value: Val), Bad(err: Err) }; +``` + +**`Err` typing.** `Err` is the procedure's single declared `throws` type, always bounded +by `BaseException` (E1). It is instantiated **precisely** where the throw set is a single +type (`Result`), and **coarsened to +a common supertype** — `BaseException` or the nearest common ancestor — for the +multi-type checked case (Java multi-type `throws`, recorded as an `onThrow` predicate +carrying the precise set) and the JS-dynamic case (`DynamicJsValue`). Non-throwing +procedures have no `Err` at all. + +**Lowering mechanics (reusing existing `Block`/`Exit`/`bodyLabel`).** + +- `throw v` → assign `Bad(v)` to the result variable and `exit` the nearest enclosing + `try` label, or the procedure's `bodyLabel` if there is no enclosing `try`. +- a call to a thrower → bind the returned `Result`; `if Result..isBad(tmp) then exit + `; otherwise extract `Result..value(tmp)` and continue. +- the handler region (`tryCatches`) runs the predicate-based catches (E3); an unmatched + or re-thrown exception re-assigns `Bad` and exits outward; `finally` (E5) is inserted + on every exit edge, which is where its F18 masking is realized. + +No new control-flow construct is introduced — the lowering is built from Laurel's existing +labelled blocks and `Exit`. + + +--- + +## Status & open points + +Extensions E1–E7 above are worked through, and all design questions are resolved. + +**Out of scope for now:** + +- **F33 (try-as-expression):** deferred. `Try` is a unified `StmtExpr`, but its + value-yielding semantics are not specified and we are not handling them at this stage. + +All extensions (E1–E7) are resolved — including E1/Q1 (thrown values are `BaseException` +composites; JS boxes into a `DynamicJsValue` wrapper). The table above gives the +per-feature mapping. From 4100546732f3d8c712b781f80df6515ffb45a924 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Mon, 29 Jun 2026 14:39:18 +0000 Subject: [PATCH 02/28] feat(laurel): add gated BaseException exception-channel root (E1) Add the prelude composite `BaseException` (E1 exceptional-channel root) as a separate, gated prelude: it is prepended only when a program references it, so heap/SMT reasoning for non-exception programs is unaffected. Add a public `referencedNames` helper to drive the gating. Tests: ExceptionHierarchy (subtyping/is/fields), ExceptionPreludeGating (prelude injected iff referenced). --- .../Laurel/CoreDefinitionsForLaurel.lean | 40 +++++++++ Strata/Languages/Laurel/FilterPrelude.lean | 12 +++ .../Laurel/LaurelCompilationPipeline.lean | 12 +++ .../Examples/Objects/ExceptionHierarchy.lean | 76 +++++++++++++++++ .../Objects/ExceptionPreludeGating.lean | 83 +++++++++++++++++++ 5 files changed, 223 insertions(+) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/ExceptionHierarchy.lean create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/ExceptionPreludeGating.lean diff --git a/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean b/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean index 362d45110d..872cabb481 100644 --- a/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean +++ b/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean @@ -49,6 +49,46 @@ def coreDefinitionsForLaurel : Program := | .ok program => program | .error e => dbg_trace s!"BUG: CoreDefinitionsForLaurel parse error: {e}"; default +/-- +E1: the exceptional-channel root for exception handling. +See `docs/design/laurel_extensions.md` (extension E1). + +`BaseException` is the root of every value that travels on the exceptional +channel; `throw`'s operand, a `catch` binding, and the `onThrow` binder are all +typed `BaseException` (or a declared subtype). The prelude defines only the +root: any catchable-vs-fatal tiering above it is front-end policy, expressed by +which parent a front-end type `extends` plus the catch predicate. + +Unlike `coreDefinitionsForLaurel` (datatypes/functions that are "free" for SMT), +`BaseException` is a *composite* and therefore participates in the heap model. +Injecting it into every program would perturb SMT heap reasoning for programs +that do not use exceptions, so it is kept separate and prepended **only when a +program references it** (see the pipeline's gating on `baseExceptionTypeName`). +-/ +def exceptionDefinitionsForLaurelDDM := +#strata +program Laurel; + +composite BaseException { + var message: string +} + +#end + +/-- +The E1 exception prelude as a `Laurel.Program`, parsed at compile time. +-/ +def exceptionDefinitionsForLaurel : Program := + match TransM.run none (parseProgram exceptionDefinitionsForLaurelDDM) with + | .ok program => program + | .error e => dbg_trace s!"BUG: ExceptionDefinitionsForLaurel parse error: {e}"; default + +/-- Name of the E1 exceptional-channel root composite (`BaseException`). + A program "uses exceptions" — and so needs `exceptionDefinitionsForLaurel` + prepended — iff it references this name (directly, or transitively via a + subtype, whose `extends` chain names it). -/ +def baseExceptionTypeName : String := "BaseException" + end -- public section end Strata.Laurel diff --git a/Strata/Languages/Laurel/FilterPrelude.lean b/Strata/Languages/Laurel/FilterPrelude.lean index 18bbca462b..d529cd4c8a 100644 --- a/Strata/Languages/Laurel/FilterPrelude.lean +++ b/Strata/Languages/Laurel/FilterPrelude.lean @@ -264,6 +264,18 @@ private def collectProgramRefs (prog : Laurel.Program) : CollectState := prog.staticProcedures.forM collectProcDeps prog.types.forM collectTypeDefDeps +/-- The set of all names (procedure-call targets and type references) that a + user program refers to. Exposed so the compilation pipeline can decide + whether an optional, heap-participating prelude fragment (e.g. the E1 + exception root `BaseException`) needs to be prepended — a fragment that + perturbs SMT heap reasoning when injected into programs that never use it. + + Detecting a bare *subtype* reference works for free: the prelude defines only + the root, so any subtype is defined in the user program with an `extends` + chain that names the root, and `extends` targets are collected here. -/ +public def referencedNames (prog : Laurel.Program) : Std.HashSet String := + (collectProgramRefs prog).allNames + /-- Filter a prelude Laurel program to only include declarations transitively needed by the user program. -/ public def filterPrelude (prelude user : Laurel.Program) diff --git a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean index ce500d1ab3..247655485c 100644 --- a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean +++ b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean @@ -16,6 +16,7 @@ import Strata.Languages.Laurel.TypeHierarchy import Strata.Languages.Laurel.InferHoleTypes import Strata.Languages.Laurel.EliminateDeterministicHoles import Strata.Languages.Laurel.CoreDefinitionsForLaurel +import Strata.Languages.Laurel.FilterPrelude import Strata.Languages.Laurel.LiftImperativeExpressions import Strata.Languages.Laurel.ConstrainedTypeElim import Strata.Languages.Laurel.PushOldInward @@ -141,11 +142,22 @@ program state after each named Laurel pass is written to private def runLaurelPasses (pctx : Strata.Pipeline.PipelineContext) (program : Program) : PipelineM (Program × SemanticModel × List DiagnosticModel × Statistics) := do + -- The always-on prelude: datatypes/functions, "free" for SMT. let program := { program with staticProcedures := coreDefinitionsForLaurel.staticProcedures ++ program.staticProcedures, types := coreDefinitionsForLaurel.types ++ program.types } + -- E1 gating: `BaseException` is a heap-participating composite, so it is + -- prepended only when the user program references it (the name itself, or a + -- subtype whose `extends` chain names it). Programs that do not use + -- exceptions are left untouched, avoiding perturbation of SMT heap reasoning. + -- See `docs/design/laurel_extensions.md` (extension E1). + let program := + if (referencedNames program).contains baseExceptionTypeName then + { program with types := exceptionDefinitionsForLaurel.types ++ program.types } + else program + -- Step 0: the input program before any passes emit "Initial" "laurel.st" program diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ExceptionHierarchy.lean b/StrataTest/Languages/Laurel/Examples/Objects/ExceptionHierarchy.lean new file mode 100644 index 0000000000..bd6ffc8032 --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/ExceptionHierarchy.lean @@ -0,0 +1,76 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Exercises the E1 exceptional-channel root `BaseException` that ships in the +Laurel prelude (see `Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean` and +`docs/design/laurel_extensions.md`). + +Laurel predefines only `BaseException`. The catchable-vs-fatal tiering is +front-end policy, so this test program defines its own tiers as separate +children of the root — exactly as a real front-end would — and shows that the +F4/F5/F6 behavior falls out of ordinary `extends` + `is`. + +Because `BaseException` is part of the always-on prelude, this also confirms the +prelude composite parses (a parse failure would yield an empty program and every +reference below would fail to resolve). +-/ +#eval testLaurel <| +#strata +program Laurel; + +// Front-end-defined tiers on top of the prelude root `BaseException`. +// Two separate children of the root: a catchable tier and a "fatal" tier. +composite AppException extends BaseException {} +composite FatalError extends BaseException {} + +// A user-defined exception under the catchable tier (F4). +composite MyError extends AppException { + var code: int +} + +procedure baseExceptionIsUsable() + opaque +{ + // The prelude root is available to every program and carries `message`. + var b: BaseException := new BaseException; + b#message := "root"; + assert b#message == "root"; + assert b is BaseException +}; + +procedure userExceptionIsRooted() + opaque +{ + var e: MyError := new MyError; + // `message` is inherited from `BaseException` two levels up the chain. + e#message := "boom"; + e#code := 42; + assert e#message == "boom"; + assert e#code == 42; + // F4: a user exception is a subtype of its parent tier and of the root. + assert e is MyError; + assert e is AppException; + assert e is BaseException +}; + +procedure fatalTierEscapesCatchAll() + opaque +{ + // F5/F6: a fatal-tier value, bound at the channel root `BaseException` (as a + // catch binding is), is provably not in the catchable tier — so a catch-all + // predicated on `AppException` would not catch it. The escape falls out of + // the subtype check, needing nothing beyond how the front-end wires `extends`. + var f: BaseException := new FatalError; + assert f is BaseException; + assert !(f is AppException) +}; +#end diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ExceptionPreludeGating.lean b/StrataTest/Languages/Laurel/Examples/Objects/ExceptionPreludeGating.lean new file mode 100644 index 0000000000..7d858635ae --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/ExceptionPreludeGating.lean @@ -0,0 +1,83 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Confirms the E1 *prelude gating* (see `docs/design/laurel_extensions.md`, +extension E1, and `Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean`). + +`BaseException` is a heap-participating composite, so injecting it into every +program would perturb SMT heap reasoning for programs that never throw. The +pipeline therefore prepends the exception prelude **only when the user program +references `BaseException`** (directly, or via a subtype whose `extends` chain +names it). + +These tests lower each program to Core (translation only, no SMT) and check +whether `BaseException` appears in the result: + +- a program that uses no exceptions must **not** pull it in (gating off); +- a program that references it must (gating on). +-/ + +/-- A program that does not mention exceptions at all. -/ +private def noExceptionsBlock := #strata +program Laurel; + +procedure noExceptions() + opaque +{ + var x: int := 1; + assert x == 1 +}; +#end + +/-- A program that references the prelude root `BaseException`. -/ +private def usesExceptionsBlock := #strata +program Laurel; + +procedure usesExceptions() + opaque +{ + var e: BaseException := new BaseException; + e#message := "boom"; + assert e#message == "boom" +}; +#end + +/-- Lower a parsed snippet to Core and return the pretty-printed program text, + throwing on a translation failure. The pipeline prepends the (gated) + prelude, so the result reflects whether `BaseException` was injected. -/ +private def loweredCoreText (block : StrataDDM.SourcedProgram) : IO String := do + let user ← translateLaurel block.program + let (coreOpt, diags) ← Strata.Laurel.translate {} user + match coreOpt with + | some core => return (Std.format core).pretty + | none => + throw <| IO.userError s!"translation failed: {diags.map (·.message)}" + +/-- True iff `BaseException` occurs anywhere in `text`. -/ +private def mentionsBaseException (text : String) : Bool := + (text.splitOn "BaseException").length > 1 + +-- Gating OFF: a non-exception program must not carry `BaseException`. +#eval do + let text ← loweredCoreText noExceptionsBlock + if mentionsBaseException text then + throw <| IO.userError + "E1 gating: BaseException leaked into a program that does not use exceptions" + IO.println "ok: no BaseException injected into a non-exception program" + +-- Gating ON: a program referencing `BaseException` must carry it. +#eval do + let text ← loweredCoreText usesExceptionsBlock + unless mentionsBaseException text do + throw <| IO.userError + "E1 gating: BaseException missing from a program that references it" + IO.println "ok: BaseException injected into a program that references it" From 5898ea1e8dd2a8964d23cd9d0d19affd86c16ff7 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Mon, 29 Jun 2026 15:50:49 +0000 Subject: [PATCH 03/28] feat(laurel): add throw statement (E2), typed at BaseException Introduce a value-carrying 'throw e' statement (E2): one StmtExpr.Throw node, 'throw' surface syntax, and resolution that types the operand at the E1 channel root BaseException (subtypes accepted). No dedicated rethrow form. Reaches resolution/type-check end-to-end. Core lowering is stubbed as NotYetImplemented: the documented Result lowering (E7) needs generic datatypes Laurel does not have yet, and we deliberately do not monomorphize. Details: AST adds StmtExpr.Throw (+ constrName/constructorName) and moves shared baseExceptionTypeName to LaurelAST next to bodyLabel. Grammar adds 'op throw' plus concrete/abstract translators. Resolution adds Synth dispatch + Check.throw, which checks operand <: BaseException but skips the check once heapParameterization erases the operand to the heap Composite reference (avoids a spurious re-resolution failure). FilterPrelude.collectExprNames treats a throw as a reference to BaseException so the exception prelude is gated in and kept. Throw is threaded through the remaining exhaustive matches: MapStmtExpr (both traversals), LaurelTypes.computeExprType (TVoid), Resolution collectStmtExpr, InferHoleTypes, and the Core translator stubs. Tests: ThrowStatement.lean - ill-typed 'throw 5' reports a BaseException type error; well-typed 'throw e' resolves and reaches the NYI lowering. --- .../Laurel/CoreDefinitionsForLaurel.lean | 6 --- Strata/Languages/Laurel/FilterPrelude.lean | 5 ++ .../AbstractToConcreteTreeTranslator.lean | 1 + .../ConcreteToAbstractTreeTranslator.lean | 3 ++ .../Laurel/Grammar/LaurelGrammar.lean | 2 +- .../Languages/Laurel/Grammar/LaurelGrammar.st | 1 + Strata/Languages/Laurel/InferHoleTypes.lean | 2 + Strata/Languages/Laurel/LaurelAST.lean | 17 +++++++ .../Laurel/LaurelToCoreTranslator.lean | 8 +++ Strata/Languages/Laurel/LaurelTypes.lean | 1 + Strata/Languages/Laurel/MapStmtExpr.lean | 4 ++ Strata/Languages/Laurel/Resolution.lean | 45 ++++++++++++++++ .../Examples/Objects/ThrowStatement.lean | 51 +++++++++++++++++++ 13 files changed, 139 insertions(+), 7 deletions(-) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean diff --git a/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean b/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean index 872cabb481..2e992dfa4c 100644 --- a/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean +++ b/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean @@ -83,12 +83,6 @@ def exceptionDefinitionsForLaurel : Program := | .ok program => program | .error e => dbg_trace s!"BUG: ExceptionDefinitionsForLaurel parse error: {e}"; default -/-- Name of the E1 exceptional-channel root composite (`BaseException`). - A program "uses exceptions" — and so needs `exceptionDefinitionsForLaurel` - prepended — iff it references this name (directly, or transitively via a - subtype, whose `extends` chain names it). -/ -def baseExceptionTypeName : String := "BaseException" - end -- public section end Strata.Laurel diff --git a/Strata/Languages/Laurel/FilterPrelude.lean b/Strata/Languages/Laurel/FilterPrelude.lean index d529cd4c8a..5146fbe54d 100644 --- a/Strata/Languages/Laurel/FilterPrelude.lean +++ b/Strata/Languages/Laurel/FilterPrelude.lean @@ -121,6 +121,11 @@ private partial def collectExprNames (expr : StmtExprMd) : CollectM Unit := do collectExprNames body | .Assert cond => collectExprNames cond.condition | .Assume cond => collectExprNames cond + -- A `throw` uses the exceptional channel, whose root `BaseException` must be + -- in scope wherever it appears. Recording it as a type reference drives both + -- the prelude gating and this dependency closure to include the exception + -- prelude for any program containing a `throw`. + | .Throw value => addTypeName baseExceptionTypeName; collectExprNames value | .Return val => val.forM collectExprNames | .Old val | .Fresh val | .Assigned val => collectExprNames val | .ProveBy val proof => collectExprNames val; collectExprNames proof diff --git a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean index a4cd2ba3a0..036e27d8ac 100644 --- a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean @@ -167,6 +167,7 @@ where laurelOp "errorSummary" #[.strlit sr msg]) laurelOp "assert" #[stmtExprToArg cond.condition, errOpt] | .Assume cond => laurelOp "assume" #[stmtExprToArg cond] + | .Throw value => laurelOp "throw" #[stmtExprToArg value] | .New name => laurelOp "new" #[ident name.text] | .This => laurelOp "identifier" #[ident "this"] | .IsType target ty => diff --git a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean index 2fe575e1cf..4cf988e6fa 100644 --- a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean @@ -203,6 +203,9 @@ partial def translateStmtExpr (arg : Arg) : TransM StmtExprMd := do | q`Laurel.assume, #[arg0] => let cond ← translateStmtExpr arg0 return mkStmtExprMd (.Assume cond) src + | q`Laurel.throw, #[arg0] => + let value ← translateStmtExpr arg0 + return mkStmtExprMd (.Throw value) src | q`Laurel.block, #[arg0] => let stmts ← translateSeqCommand arg0 return mkStmtExprMd (.Block stmts none) src diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean index 80f80911ba..bea6e6ef96 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean @@ -12,7 +12,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: renamed strConcat token to `^`; added preIncr/preDecr/postIncr/postDecr; `return` value is now Option StmtExpr (supports a valueless return). +-- Last grammar change: added `throw` statement (E2 exception handling). public import StrataDDM.AST import StrataDDM.BuiltinDialects.Init import StrataDDM.Integration.Lean.HashCommands diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st index ae8316a01b..3d160971c1 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st @@ -120,6 +120,7 @@ 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 throw (value : StmtExpr) : StmtExpr => @[prec(0)] "throw " value:0; op return (value : Option StmtExpr) : StmtExpr => @[prec(0)] "return " value:0; 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; diff --git a/Strata/Languages/Laurel/InferHoleTypes.lean b/Strata/Languages/Laurel/InferHoleTypes.lean index 400de87c3a..d18beae7b4 100644 --- a/Strata/Languages/Laurel/InferHoleTypes.lean +++ b/Strata/Languages/Laurel/InferHoleTypes.lean @@ -154,6 +154,8 @@ private def inferExpr (expr : StmtExprMd) (expectedType : HighTypeMd) : InferHol return ⟨.Assert { condition := ← inferExpr condExpr ⟨ .TBool, source ⟩, summary, free }, source⟩ | .Assume cond => return ⟨.Assume (← inferExpr cond ⟨ .TBool, source ⟩), source⟩ + | .Throw v => + return ⟨.Throw (← inferExpr v ⟨ .Unknown, source ⟩), source⟩ | .Return (some retExpr) => return ⟨.Return (some (← inferExpr retExpr (← get).currentOutputType)), source⟩ | .Old v => return ⟨.Old (← inferExpr v expectedType), source⟩ diff --git a/Strata/Languages/Laurel/LaurelAST.lean b/Strata/Languages/Laurel/LaurelAST.lean index d9638174b0..6a012e4eb9 100644 --- a/Strata/Languages/Laurel/LaurelAST.lean +++ b/Strata/Languages/Laurel/LaurelAST.lean @@ -361,6 +361,10 @@ inductive StmtExpr : Type where | Assert (condition : Condition) /-- Assume a condition, restricting the state space. -/ | Assume (condition : AstNode StmtExpr) + /-- Throw a value on the exceptional channel (E2). The operand is typed at the + prelude root `BaseException` (or a declared subtype). See + `docs/design/laurel_extensions.md` (extension E2). -/ + | Throw (value : AstNode StmtExpr) /-- Attach a proof hint to a value. The semantics are those of `value`, but `proof` helps discharge assertions in `value`. -/ | ProveBy (value : AstNode StmtExpr) (proof : AstNode StmtExpr) /-- Extract the contract (reads, modifies, precondition, or postcondition) of a function. -/ @@ -417,6 +421,7 @@ def StmtExpr.constrName : StmtExpr → String | .Fresh .. => "fresh" | .Assert .. => "assert" | .Assume .. => "assume" + | .Throw .. => "throw" | .ProveBy .. => "by" | .ContractOf .. => "contractOf" | .Abstract => "abstract" @@ -442,6 +447,17 @@ def StmtExpr.constrName : StmtExpr → String out of the user-name space (no source identifier can contain `$`). -/ def bodyLabel : String := "$body" +/-- Name of the E1/E2 exceptional-channel root composite (`BaseException`), + defined in the exception prelude (`exceptionDefinitionsForLaurel`). + + Shared here (like `bodyLabel`) so the resolver, the prelude gating, and + FilterPrelude's dependency tracking all agree on the exact name: + - `throw`'s operand is type-checked against this type (resolution); + - any program containing a `throw` (or naming this type) pulls the + exception prelude in (gating), since the channel root must be in scope + wherever the exceptional channel is used. -/ +def baseExceptionTypeName : String := "BaseException" + theorem AstNode.sizeOf_val_lt {t : Type} [SizeOf t] (e : AstNode t) : sizeOf e.val < sizeOf e := by cases e; grind @@ -735,6 +751,7 @@ def StmtExpr.constructorName (e : StmtExpr) : String := | .Fresh .. => "Fresh" | .Assert .. => "Assert" | .Assume .. => "Assume" + | .Throw .. => "Throw" | .ProveBy .. => "ProveBy" | .ContractOf .. => "ContractOf" | .Abstract => "Abstract" diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index 7ffdc5b0dd..cb27c001ae 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -328,6 +328,7 @@ def translateExpr (expr : StmtExprMd) | .Fresh _ => throwExprDiagnostic $ diagnosticFromSource expr.source "fresh expression translation" DiagnosticType.NotYetImplemented | .Assert _ => throwExprDiagnostic $ diagnosticFromSource expr.source "assert expression translation" DiagnosticType.NotYetImplemented | .Assume _ => throwExprDiagnostic $ diagnosticFromSource expr.source "assume expression translation" DiagnosticType.NotYetImplemented + | .Throw _ => throwExprDiagnostic $ diagnosticFromSource expr.source "throw is not yet supported (requires generic Result lowering, E7)" DiagnosticType.NotYetImplemented | .ProveBy value _ => throwExprDiagnostic $ diagnosticFromSource expr.source "proveBy expression translation" DiagnosticType.NotYetImplemented | .ContractOf _ _ => throwExprDiagnostic $ diagnosticFromSource expr.source "contractOf expression translation" DiagnosticType.NotYetImplemented | .Abstract => throwExprDiagnostic $ diagnosticFromSource expr.source "abstract expression translation" DiagnosticType.NotYetImplemented @@ -583,6 +584,13 @@ def translateStmt (stmt : StmtExprMd) -- Hole in statement position: treat as havoc (no-op). -- This can occur when an unmodeled call's Block is flattened. return [] + | .Throw _ => + -- Full `throw` lowering targets a generic `Result` (E7), which + -- Laurel cannot express until it has generic datatypes. Until then, emit a + -- diagnostic rather than silently mis-lowering via the wildcard below. + throwStmtDiagnostic $ md.toDiagnostic + "throw is not yet supported (requires generic Result lowering, E7)" + DiagnosticType.NotYetImplemented | _ => -- Expression in statement position: preserve as an unused variable init exprAsUnusedInit stmt md diff --git a/Strata/Languages/Laurel/LaurelTypes.lean b/Strata/Languages/Laurel/LaurelTypes.lean index f39632ca90..02d178adef 100644 --- a/Strata/Languages/Laurel/LaurelTypes.lean +++ b/Strata/Languages/Laurel/LaurelTypes.lean @@ -91,6 +91,7 @@ def computeExprType (model : SemanticModel) (expr : StmtExprMd) : HighTypeMd := | .Declare _ => ⟨ .TVoid, source ⟩ -- shouldn't happen; rejected by translator | .Assert _ => ⟨ .TVoid, source ⟩ | .Assume _ => ⟨ .TVoid, source ⟩ + | .Throw _ => ⟨ .TVoid, source ⟩ -- Instance related | .New name => ⟨ .UserDefined name, source ⟩ | .This => default -- TODO: implement diff --git a/Strata/Languages/Laurel/MapStmtExpr.lean b/Strata/Languages/Laurel/MapStmtExpr.lean index 4db4592b29..dbfc6fa3d8 100644 --- a/Strata/Languages/Laurel/MapStmtExpr.lean +++ b/Strata/Languages/Laurel/MapStmtExpr.lean @@ -87,6 +87,8 @@ def mapStmtExprM [Monad m] (f : StmtExprMd → m StmtExprMd) (expr : StmtExprMd) pure ⟨.Assert { cond with condition := ← mapStmtExprM f cond.condition }, source⟩ | .Assume cond => pure ⟨.Assume (← mapStmtExprM f cond), source⟩ + | .Throw value => + pure ⟨.Throw (← mapStmtExprM f value), source⟩ | .ProveBy value proof => pure ⟨.ProveBy (← mapStmtExprM f value) (← mapStmtExprM f proof), source⟩ | .ContractOf ty func => @@ -178,6 +180,8 @@ def mapStmtExprPrePostM [Monad m] (pre : StmtExprMd → m (Option StmtExprMd)) pure ⟨.Assert { cond with condition := ← mapStmtExprPrePostM pre post cond.condition }, source⟩ | .Assume cond => pure ⟨.Assume (← mapStmtExprPrePostM pre post cond), source⟩ + | .Throw value => + pure ⟨.Throw (← mapStmtExprPrePostM pre post value), source⟩ | .ProveBy value proof => pure ⟨.ProveBy (← mapStmtExprPrePostM pre post value) (← mapStmtExprPrePostM pre post proof), source⟩ | .ContractOf ty func => diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index f79b5fb5ee..4031f7baef 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -732,6 +732,9 @@ def Synth.resolveStmtExpr (exprMd : StmtExprMd) : ResolveM (StmtExprMd × HighTy | .Assume cond => do let r ← Check.assume exprMd cond source (by rw [h_node]) return (r, ⟨ .TVoid, source ⟩) + | .Throw value => do + let r ← Check.throw exprMd value source (by rw [h_node]) + return (r, ⟨ .TVoid, source ⟩) return ({ val := val', source := source }, ty) termination_by (exprMd, 2) decreasing_by all_goals first @@ -1448,6 +1451,47 @@ def Check.assume (exprMd : StmtExprMd) simp only [StmtExpr.Assume.sizeOf_spec] at hsz omega +/-- (Throw) + ``` + Γ ⊢ value ⇐ BaseException + ────────────────────────────────── + Γ ⊢ Throw value ⇒ TVoid + ``` + The operand is checked against the exceptional-channel root + `BaseException` (E1/E2); any declared subtype is accepted by subsumption. + `throw` is a statement: it yields no value, so it synthesizes `TVoid`. + + Typing the operand at `BaseException` requires the type to be in scope; the + prelude gating (driven by `FilterPrelude.collectExprNames` treating a + `Throw` as a reference to `baseExceptionTypeName`) guarantees the exception + prelude is prepended for any program containing a `throw`. -/ +def Check.throw (exprMd : StmtExprMd) + (value : StmtExprMd) (source : Option FileRange) + (h : exprMd.val = .Throw value) : + ResolveM StmtExprMd := do + let (value', actual) ← Synth.resolveStmtExpr value + -- The operand must be a `BaseException` (or subtype). This is a check on the + -- *original* program: `heapParameterization` later erases every composite — + -- including exception values — to the heap `Composite` reference datatype, at + -- which point the static BaseException-ness lives only in the runtime type + -- tag. So once the operand has been erased to that reference, re-resolution + -- must not re-impose the check (it would spuriously fail `Composite <: BaseException`). + let isErasedCompositeRef : Bool := match actual.val with + -- "Composite" is the heap reference datatype; see `HeapParameterizationConstants`. + | .UserDefined ref => ref.text == "Composite" + | _ => false + unless isErasedCompositeRef do + let baseTy ← resolveHighType { val := .UserDefined (mkId baseExceptionTypeName), source := source } + checkSubtype value.source baseTy actual + pure { val := .Throw value', source := source } + termination_by (exprMd, 0) + decreasing_by + apply Prod.Lex.left + have hsz := exprMd.sizeOf_val_lt + rw [h] at hsz + simp only [StmtExpr.Throw.sizeOf_spec] at hsz + omega + -- ### Assignment /-- (Assign) @@ -2868,6 +2912,7 @@ private def collectStmtExpr (map : Std.HashMap Nat ResolvedNode) (expr : StmtExp | .Fresh val => collectStmtExpr map val | .Assert ⟨cond, _, _⟩ => collectStmtExpr map cond | .Assume cond => collectStmtExpr map cond + | .Throw value => collectStmtExpr map value | .ProveBy val proof => let map := collectStmtExpr map val collectStmtExpr map proof diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean b/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean new file mode 100644 index 0000000000..da4dffcd1b --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean @@ -0,0 +1,51 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Exercises the E2 `throw` statement (see `docs/design/laurel_extensions.md`, +extension E2). `throw`'s operand is typed at the prelude root `BaseException` +(E1); any declared subtype is accepted. + +Full lowering to Core targets a generic `Result` (E7), which Laurel +cannot express until it gains generic datatypes, so a well-typed `throw` +currently reaches translation and reports `not-yet-implemented` there. These +tests pin down the front half of the pipeline: parsing, resolution, and the +`BaseException` type rule. +-/ + +-- Ill-typed: the operand is an `int`, not a `BaseException`. The type error is +-- reported during resolution, so the pipeline never reaches translation. +#eval testLaurel <| +#strata +program Laurel; + +procedure throwsNonException() + opaque +{ + throw 5 +// ^ error: expected 'BaseException', got 'int' +}; +#end + +-- Well-typed: the operand is a `BaseException`. Parsing, resolution, and the +-- `BaseException` type rule all succeed; only the Core lowering is missing (E7). +#eval testLaurel <| +#strata +program Laurel; + +procedure throwsException() + opaque +{ + var e: BaseException := new BaseException; + throw e +//^^^^^^^ not-yet-implemented: throw is not yet supported (requires generic Result lowering, E7) +}; +#end From a0288ba8df49391663219aa721f1e5506f0db382 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Tue, 30 Jun 2026 15:48:17 +0000 Subject: [PATCH 04/28] feat(laurel): add try/catch/finally (E3/E5), predicate-based dispatch Add a structured exception handler: a try body, an ordered list of predicate-based catch clauses (first-match-wins, E3), and an optional finally arm (E5). A catch binds the caught value at the channel root BaseException (E1) and may carry a 'when' guard (checked at bool); type dispatch is written 'catch e when e is T', multi-catch as 'catch e when e is A || e is B'. No new clause kinds beyond the guard. Reaches resolution/type-check end-to-end. Core lowering is stubbed as NotYetImplemented: like throw, it targets a generic Result (E7), which needs generic datatypes Laurel does not have yet. Details: AST adds a CatchClause struct (binding, optional predicate, body) in the mutual block and StmtExpr.Try (body, catches, finally?), with CatchClause sizeOf lemmas for traversal termination. Grammar adds try/catch/when/finally surface syntax (CatchGuard, CatchClause, FinallyClause categories + tryCatch op) plus both tree translators. Resolution adds Check.tryCatch, which opens a per-clause scope, binds the catch variable at BaseException, checks guards at bool and bodies/finally in statement position; Try synthesizes TVoid; collectStmtExpr registers each binding and is now partial (it recurses through clause fields). Try is threaded through the exhaustive matches: MapStmtExpr (both traversals), LaurelTypes.computeExprType (TVoid), FilterPrelude (gates the exception prelude in), and the Core translator stubs. InferHoleTypes intentionally does not recurse into Try (left to the wildcard): adding the arm forced the mutual block onto well-founded recursion, so holes inside try/catch/finally are not inferred yet (documented in-place). Tests: TryCatch.lean - well-typed try/catch/finally and a boolean 'when' guard reach the NYI lowering; an int guard reports expected 'bool', got 'int'. --- Strata/Languages/Laurel/FilterPrelude.lean | 9 +++ .../AbstractToConcreteTreeTranslator.lean | 6 ++ .../ConcreteToAbstractTreeTranslator.lean | 23 ++++++ .../Laurel/Grammar/LaurelGrammar.lean | 2 +- .../Languages/Laurel/Grammar/LaurelGrammar.st | 14 ++++ Strata/Languages/Laurel/InferHoleTypes.lean | 5 ++ Strata/Languages/Laurel/LaurelAST.lean | 27 +++++++ .../Laurel/LaurelToCoreTranslator.lean | 7 ++ Strata/Languages/Laurel/LaurelTypes.lean | 1 + Strata/Languages/Laurel/MapStmtExpr.lean | 18 +++++ Strata/Languages/Laurel/Resolution.lean | 51 +++++++++++- .../Laurel/Examples/Objects/TryCatch.lean | 78 +++++++++++++++++++ 12 files changed, 239 insertions(+), 2 deletions(-) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/TryCatch.lean diff --git a/Strata/Languages/Laurel/FilterPrelude.lean b/Strata/Languages/Laurel/FilterPrelude.lean index 5146fbe54d..4c1c8852db 100644 --- a/Strata/Languages/Laurel/FilterPrelude.lean +++ b/Strata/Languages/Laurel/FilterPrelude.lean @@ -126,6 +126,15 @@ private partial def collectExprNames (expr : StmtExprMd) : CollectM Unit := do -- the prelude gating and this dependency closure to include the exception -- prelude for any program containing a `throw`. | .Throw value => addTypeName baseExceptionTypeName; collectExprNames value + -- A `try`/`catch` likewise uses the exceptional channel (the catch binding is + -- typed `BaseException`), so record the root and recurse into every arm. + | .Try body catches finally? => + addTypeName baseExceptionTypeName + collectExprNames body + catches.forM (fun c => do + c.predicate.forM collectExprNames + collectExprNames c.body) + finally?.forM collectExprNames | .Return val => val.forM collectExprNames | .Old val | .Fresh val | .Assigned val => collectExprNames val | .ProveBy val proof => collectExprNames val; collectExprNames proof diff --git a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean index 036e27d8ac..2d9a574bae 100644 --- a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean @@ -168,6 +168,12 @@ where laurelOp "assert" #[stmtExprToArg cond.condition, errOpt] | .Assume cond => laurelOp "assume" #[stmtExprToArg cond] | .Throw value => laurelOp "throw" #[stmtExprToArg value] + | .Try body catches finally? => + let catchArgs := catches.map (fun c => + let guardArg := optionArg (c.predicate.map fun p => laurelOp "catchGuard" #[stmtExprToArg p]) + laurelOp "catchClause" #[ident c.binding.text, guardArg, stmtExprToArg c.body]) |>.toArray + let finallyArg := optionArg (finally?.map fun f => laurelOp "finallyClause" #[stmtExprToArg f]) + laurelOp "tryCatch" #[stmtExprToArg body, seqArg catchArgs, finallyArg] | .New name => laurelOp "new" #[ident name.text] | .This => laurelOp "identifier" #[ident "this"] | .IsType target ty => diff --git a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean index 4cf988e6fa..76132d1e0a 100644 --- a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean @@ -206,6 +206,29 @@ partial def translateStmtExpr (arg : Arg) : TransM StmtExprMd := do | q`Laurel.throw, #[arg0] => let value ← translateStmtExpr arg0 return mkStmtExprMd (.Throw value) src + | q`Laurel.tryCatch, #[bodyArg, catchSeqArg, finallyArg] => + let body ← translateStmtExpr bodyArg + let catches ← match catchSeqArg with + | .seq _ _ clauses => clauses.toList.mapM fun arg => match arg with + | .op cOp => match cOp.name, cOp.args with + | q`Laurel.catchClause, #[bindingArg, guardArg, cBodyArg] => do + let binding ← translateIdent bindingArg + let predicate ← match guardArg with + | .option _ (some (.op gOp)) => match gOp.name, gOp.args with + | q`Laurel.catchGuard, #[pArg] => translateStmtExpr pArg >>= (pure ∘ some) + | _, _ => pure none + | _ => pure none + let cBody ← translateStmtExpr cBodyArg + pure ({ binding := binding, predicate := predicate, body := cBody } : CatchClause) + | _, _ => TransM.error "Expected catchClause" + | _ => TransM.error "Expected operation" + | _ => pure [] + let finally? ← match finallyArg with + | .option _ (some (.op fOp)) => match fOp.name, fOp.args with + | q`Laurel.finallyClause, #[fBodyArg] => translateStmtExpr fBodyArg >>= (pure ∘ some) + | _, _ => pure none + | _ => pure none + return mkStmtExprMd (.Try body catches finally?) src | q`Laurel.block, #[arg0] => let stmts ← translateSeqCommand arg0 return mkStmtExprMd (.Block stmts none) src diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean index bea6e6ef96..3439cc12c7 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean @@ -12,7 +12,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: added `throw` statement (E2 exception handling). +-- Last grammar change: added `try`/`catch`/`finally` (E3/E5 exception handling). public import StrataDDM.AST import StrataDDM.BuiltinDialects.Init import StrataDDM.Integration.Lean.HashCommands diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st index 3d160971c1..b019b6e852 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st @@ -126,6 +126,20 @@ op block (stmts : SemicolonSepBy StmtExpr) : StmtExpr => @[prec(1000)] "{\n " i 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; +// Exception handling (E3/E5): try / catch (with optional `when` guard) / finally. +category CatchGuard; +op catchGuard (predicate: StmtExpr): CatchGuard => " when " predicate:0; + +category CatchClause; +op catchClause (binding: Ident, guard: Option CatchGuard, body: StmtExpr): CatchClause + => "\n catch " binding guard " " body:0; + +category FinallyClause; +op finallyClause (body: StmtExpr): FinallyClause => "\n finally " body:0; + +op tryCatch (body: StmtExpr, catches: Seq CatchClause, finallyClause: Option FinallyClause): StmtExpr + => @[prec(0)] "try " body:0 catches finallyClause; + // While loops category InvariantClause; op invariantClause (cond: StmtExpr): InvariantClause => "\n invariant " cond:0; diff --git a/Strata/Languages/Laurel/InferHoleTypes.lean b/Strata/Languages/Laurel/InferHoleTypes.lean index d18beae7b4..f8c22b0994 100644 --- a/Strata/Languages/Laurel/InferHoleTypes.lean +++ b/Strata/Languages/Laurel/InferHoleTypes.lean @@ -156,6 +156,11 @@ private def inferExpr (expr : StmtExprMd) (expectedType : HighTypeMd) : InferHol return ⟨.Assume (← inferExpr cond ⟨ .TBool, source ⟩), source⟩ | .Throw v => return ⟨.Throw (← inferExpr v ⟨ .Unknown, source ⟩), source⟩ + -- NOTE: `Try` is intentionally not handled here; it falls through to the + -- wildcard below (returned unchanged). Recursing into the catch-clause list + -- would force this mutual block from structural onto well-founded recursion. + -- Consequence: holes inside `try`/`catch`/`finally` arms are not type-inferred + -- yet. Revisit if holes in those positions need inference. | .Return (some retExpr) => return ⟨.Return (some (← inferExpr retExpr (← get).currentOutputType)), source⟩ | .Old v => return ⟨.Old (← inferExpr v expectedType), source⟩ diff --git a/Strata/Languages/Laurel/LaurelAST.lean b/Strata/Languages/Laurel/LaurelAST.lean index 6a012e4eb9..18584d6902 100644 --- a/Strata/Languages/Laurel/LaurelAST.lean +++ b/Strata/Languages/Laurel/LaurelAST.lean @@ -254,6 +254,21 @@ structure Condition where not checked on exit from implementations. -/ free : Bool := false +/-- +A `catch` clause (E3): a mandatory binding bound to the caught value (typed +`BaseException`), an optional predicate guard, and a handler body. A `Try` +holds an ordered list of these; clauses are tried in order, first-match-wins, +and an absent predicate is a catch-all. Type dispatch is written as a guard, +e.g. `catch e when e is T`. See `docs/design/laurel_extensions.md` (extension E3). +-/ +structure CatchClause where + /-- The identifier bound to the caught value (typed `BaseException`). -/ + binding : Identifier + /-- Optional guard predicate (checked at `TBool`); `none` is a catch-all. -/ + predicate : Option (AstNode StmtExpr) := none + /-- The handler body, run when this clause matches. -/ + body : AstNode StmtExpr + /-- The body of a procedure. A body can be transparent (with a visible implementation), opaque (with a postcondition and optional implementation), @@ -365,6 +380,10 @@ inductive StmtExpr : Type where prelude root `BaseException` (or a declared subtype). See `docs/design/laurel_extensions.md` (extension E2). -/ | Throw (value : AstNode StmtExpr) + /-- Structured exception handler (E3/E5): a `body`, an ordered list of `catch` + clauses (tried first-match-wins), and an optional `finally` arm that runs on + every exit path. See `docs/design/laurel_extensions.md` (extensions E3, E5). -/ + | Try (body : AstNode StmtExpr) (catches : List CatchClause) (finally? : Option (AstNode StmtExpr)) /-- Attach a proof hint to a value. The semantics are those of `value`, but `proof` helps discharge assertions in `value`. -/ | ProveBy (value : AstNode StmtExpr) (proof : AstNode StmtExpr) /-- Extract the contract (reads, modifies, precondition, or postcondition) of a function. -/ @@ -422,6 +441,7 @@ def StmtExpr.constrName : StmtExpr → String | .Assert .. => "assert" | .Assume .. => "assume" | .Throw .. => "throw" + | .Try .. => "try" | .ProveBy .. => "by" | .ContractOf .. => "contractOf" | .Abstract => "abstract" @@ -464,6 +484,12 @@ theorem AstNode.sizeOf_val_lt {t : Type} [SizeOf t] (e : AstNode t) : sizeOf e.v theorem Condition.sizeOf_condition_lt (c : Condition) : sizeOf c.condition < 1 + sizeOf c := by cases c; grind +theorem CatchClause.sizeOf_body_lt (c : CatchClause) : sizeOf c.body < 1 + sizeOf c := by + cases c; grind + +theorem CatchClause.sizeOf_predicate_lt (c : CatchClause) : sizeOf c.predicate < 1 + sizeOf c := by + cases c; grind + /-- The target expression inside a `Variable.Field` is strictly smaller than the `Field` itself. Useful for termination proofs when recursing into `Variable.Field` targets. -/ theorem Variable.sizeOf_field_target_lt (target : AstNode StmtExpr) (fieldName : Identifier) : @@ -752,6 +778,7 @@ def StmtExpr.constructorName (e : StmtExpr) : String := | .Assert .. => "Assert" | .Assume .. => "Assume" | .Throw .. => "Throw" + | .Try .. => "Try" | .ProveBy .. => "ProveBy" | .ContractOf .. => "ContractOf" | .Abstract => "Abstract" diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index cb27c001ae..aa6d7c71ae 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -329,6 +329,7 @@ def translateExpr (expr : StmtExprMd) | .Assert _ => throwExprDiagnostic $ diagnosticFromSource expr.source "assert expression translation" DiagnosticType.NotYetImplemented | .Assume _ => throwExprDiagnostic $ diagnosticFromSource expr.source "assume expression translation" DiagnosticType.NotYetImplemented | .Throw _ => throwExprDiagnostic $ diagnosticFromSource expr.source "throw is not yet supported (requires generic Result lowering, E7)" DiagnosticType.NotYetImplemented + | .Try _ _ _ => throwExprDiagnostic $ diagnosticFromSource expr.source "try/catch is not yet supported (requires generic Result lowering, E7)" DiagnosticType.NotYetImplemented | .ProveBy value _ => throwExprDiagnostic $ diagnosticFromSource expr.source "proveBy expression translation" DiagnosticType.NotYetImplemented | .ContractOf _ _ => throwExprDiagnostic $ diagnosticFromSource expr.source "contractOf expression translation" DiagnosticType.NotYetImplemented | .Abstract => throwExprDiagnostic $ diagnosticFromSource expr.source "abstract expression translation" DiagnosticType.NotYetImplemented @@ -591,6 +592,12 @@ def translateStmt (stmt : StmtExprMd) throwStmtDiagnostic $ md.toDiagnostic "throw is not yet supported (requires generic Result lowering, E7)" DiagnosticType.NotYetImplemented + | .Try _ _ _ => + -- `try`/`catch`/`finally` lowering (E3/E5) builds on the same `Result` + -- lowering as `throw` (E7), so it is likewise blocked on generic datatypes. + throwStmtDiagnostic $ md.toDiagnostic + "try/catch is not yet supported (requires generic Result lowering, E7)" + DiagnosticType.NotYetImplemented | _ => -- Expression in statement position: preserve as an unused variable init exprAsUnusedInit stmt md diff --git a/Strata/Languages/Laurel/LaurelTypes.lean b/Strata/Languages/Laurel/LaurelTypes.lean index 02d178adef..7b2fdfd310 100644 --- a/Strata/Languages/Laurel/LaurelTypes.lean +++ b/Strata/Languages/Laurel/LaurelTypes.lean @@ -92,6 +92,7 @@ def computeExprType (model : SemanticModel) (expr : StmtExprMd) : HighTypeMd := | .Assert _ => ⟨ .TVoid, source ⟩ | .Assume _ => ⟨ .TVoid, source ⟩ | .Throw _ => ⟨ .TVoid, source ⟩ + | .Try _ _ _ => ⟨ .TVoid, source ⟩ -- Instance related | .New name => ⟨ .UserDefined name, source ⟩ | .This => default -- TODO: implement diff --git a/Strata/Languages/Laurel/MapStmtExpr.lean b/Strata/Languages/Laurel/MapStmtExpr.lean index dbfc6fa3d8..e2b43e3ced 100644 --- a/Strata/Languages/Laurel/MapStmtExpr.lean +++ b/Strata/Languages/Laurel/MapStmtExpr.lean @@ -89,6 +89,13 @@ def mapStmtExprM [Monad m] (f : StmtExprMd → m StmtExprMd) (expr : StmtExprMd) pure ⟨.Assume (← mapStmtExprM f cond), source⟩ | .Throw value => pure ⟨.Throw (← mapStmtExprM f value), source⟩ + | .Try body catches finally? => + pure ⟨.Try (← mapStmtExprM f body) + (← catches.attach.mapM fun ⟨c, _⟩ => do + pure { c with + predicate := (← c.predicate.attach.mapM fun ⟨e, _⟩ => mapStmtExprM f e) + body := (← mapStmtExprM f c.body) }) + (← finally?.attach.mapM fun ⟨e, _⟩ => mapStmtExprM f e), source⟩ | .ProveBy value proof => pure ⟨.ProveBy (← mapStmtExprM f value) (← mapStmtExprM f proof), source⟩ | .ContractOf ty func => @@ -105,6 +112,8 @@ decreasing_by all_goals simp_wf all_goals (try have := AstNode.sizeOf_val_lt expr) all_goals (try have := Condition.sizeOf_condition_lt ‹_›) + all_goals (try have := CatchClause.sizeOf_body_lt ‹_›) + all_goals (try have := CatchClause.sizeOf_predicate_lt ‹_›) all_goals (try term_by_mem) all_goals (cases expr; simp_all; omega) @@ -182,6 +191,13 @@ def mapStmtExprPrePostM [Monad m] (pre : StmtExprMd → m (Option StmtExprMd)) pure ⟨.Assume (← mapStmtExprPrePostM pre post cond), source⟩ | .Throw value => pure ⟨.Throw (← mapStmtExprPrePostM pre post value), source⟩ + | .Try body catches finally? => + pure ⟨.Try (← mapStmtExprPrePostM pre post body) + (← catches.attach.mapM fun ⟨c, _⟩ => do + pure { c with + predicate := (← c.predicate.attach.mapM fun ⟨e, _⟩ => mapStmtExprPrePostM pre post e) + body := (← mapStmtExprPrePostM pre post c.body) }) + (← finally?.attach.mapM fun ⟨e, _⟩ => mapStmtExprPrePostM pre post e), source⟩ | .ProveBy value proof => pure ⟨.ProveBy (← mapStmtExprPrePostM pre post value) (← mapStmtExprPrePostM pre post proof), source⟩ | .ContractOf ty func => @@ -194,6 +210,8 @@ decreasing_by all_goals simp_wf all_goals (try have := AstNode.sizeOf_val_lt expr) all_goals (try have := Condition.sizeOf_condition_lt ‹_›) + all_goals (try have := CatchClause.sizeOf_body_lt ‹_›) + all_goals (try have := CatchClause.sizeOf_predicate_lt ‹_›) all_goals (try term_by_mem) all_goals (cases expr; simp_all; omega) diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index 4031f7baef..794a6da287 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -735,6 +735,9 @@ def Synth.resolveStmtExpr (exprMd : StmtExprMd) : ResolveM (StmtExprMd × HighTy | .Throw value => do let r ← Check.throw exprMd value source (by rw [h_node]) return (r, ⟨ .TVoid, source ⟩) + | .Try body catches finally? => do + let r ← Check.tryCatch exprMd body catches finally? source (by rw [h_node]) + return (r, ⟨ .TVoid, source ⟩) return ({ val := val', source := source }, ty) termination_by (exprMd, 2) decreasing_by all_goals first @@ -1492,6 +1495,44 @@ def Check.throw (exprMd : StmtExprMd) simp only [StmtExpr.Throw.sizeOf_spec] at hsz omega +/-- (Try) + The `try` body, each `catch` body, and the `finally` arm are statements + (checked in statement position, against `Unknown`). Each `catch` clause + opens a fresh scope in which its binding is bound to the caught value, typed + at the channel root `BaseException` (E1/E3); the optional guard predicate is + checked against `TBool`. `try` is a statement: it synthesizes `TVoid`. See + `docs/design/laurel_extensions.md` (extensions E3, E5). -/ +def Check.tryCatch (exprMd : StmtExprMd) + (body : StmtExprMd) (catches : List CatchClause) (finally? : Option StmtExprMd) + (source : Option FileRange) + (h : exprMd.val = .Try body catches finally?) : + ResolveM StmtExprMd := do + let body' ← Check.resolveStmtExpr body { val := .Unknown, source := body.source } + let catches' ← catches.attach.mapM fun ⟨c, _⟩ => withScope do + let bindTy ← resolveHighType + { val := .UserDefined (mkId baseExceptionTypeName), source := c.binding.source } + let binding' ← defineNameCheckDup c.binding (.var c.binding bindTy) + let predicate' ← c.predicate.attach.mapM fun ⟨p, _⟩ => + Check.resolveStmtExpr p { val := .TBool, source := p.source } + let cbody' ← Check.resolveStmtExpr c.body { val := .Unknown, source := c.body.source } + pure ({ binding := binding', predicate := predicate', body := cbody' } : CatchClause) + let finally'? ← finally?.attach.mapM fun ⟨fexpr, _⟩ => + Check.resolveStmtExpr fexpr { val := .Unknown, source := fexpr.source } + pure { val := .Try body' catches' finally'?, source := source } + termination_by (exprMd, 0) + decreasing_by + all_goals + apply Prod.Lex.left + have hsz := exprMd.sizeOf_val_lt + rw [h] at hsz + simp only [StmtExpr.Try.sizeOf_spec] at hsz + try (have := List.sizeOf_lt_of_mem ‹_ ∈ catches›) + try (have := CatchClause.sizeOf_body_lt ‹_›) + try (have hpr := CatchClause.sizeOf_predicate_lt ‹_›) + try (rw [Option.mem_def.mp ‹_ ∈ c.predicate›, Option.some.sizeOf_spec] at hpr) + try (rw [Option.mem_def.mp ‹_ ∈ finally?›, Option.some.sizeOf_spec] at hsz) + omega + -- ### Assignment /-- (Assign) @@ -2852,7 +2893,7 @@ private def collectHighType (map : Std.HashMap Nat ResolvedNode) (ty : HighTypeM | .MultiValuedExpr tys => tys.foldl collectHighType map | _ => map -private def collectStmtExpr (map : Std.HashMap Nat ResolvedNode) (expr : StmtExprMd) +private partial def collectStmtExpr (map : Std.HashMap Nat ResolvedNode) (expr : StmtExprMd) : Std.HashMap Nat ResolvedNode := match expr with | AstNode.mk val _ => @@ -2913,6 +2954,14 @@ private def collectStmtExpr (map : Std.HashMap Nat ResolvedNode) (expr : StmtExp | .Assert ⟨cond, _, _⟩ => collectStmtExpr map cond | .Assume cond => collectStmtExpr map cond | .Throw value => collectStmtExpr map value + | .Try body catches finally? => + let map := collectStmtExpr map body + let map := catches.foldl (fun map c => + let bindTy : HighTypeMd := ⟨.UserDefined (mkId baseExceptionTypeName), c.binding.source⟩ + let map := register map c.binding (.var c.binding bindTy) + let map := match c.predicate with | some p => collectStmtExpr map p | none => map + collectStmtExpr map c.body) map + match finally? with | some f => collectStmtExpr map f | none => map | .ProveBy val proof => let map := collectStmtExpr map val collectStmtExpr map proof diff --git a/StrataTest/Languages/Laurel/Examples/Objects/TryCatch.lean b/StrataTest/Languages/Laurel/Examples/Objects/TryCatch.lean new file mode 100644 index 0000000000..ae6cde38a1 --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/TryCatch.lean @@ -0,0 +1,78 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Exercises the E3/E5 structured handler: `try` / predicate-based `catch` / +`finally` (see `docs/design/laurel_extensions.md`, extensions E3 and E5). A +`catch` binds the caught value (typed at the channel root `BaseException`, E1) +and may carry a `when` guard (checked at `bool`). + +Like `throw` (E2), full lowering to Core targets a generic `Result` +(E7), which Laurel cannot express until it gains generic datatypes. So a +well-typed `try` reaches translation and reports `not-yet-implemented` there. +These tests pin down the front half: parsing, resolution, catch-binding +scoping, and guard type-checking. +-/ + +-- Well-typed try / catch / finally: parses, resolves, type-checks; only the +-- Core lowering is missing (E7). +#eval testLaurel <| +#strata +program Laurel; + +procedure tryCatchFinally() + opaque +{ + try { +//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) + assert true + } catch e { + assert true + } finally { + assert true + } +}; +#end + +-- Well-typed catch with a boolean `when` guard. +#eval testLaurel <| +#strata +program Laurel; + +procedure tryWithGuard() + opaque +{ + try { +//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) + assert true + } catch e when true { + assert true + } +}; +#end + +-- Ill-typed: the `when` guard is an int, not a bool. Reported during +-- resolution, so the pipeline never reaches translation. +#eval testLaurel <| +#strata +program Laurel; + +procedure badGuard() + opaque +{ + try { + assert true + } catch e when 5 { +// ^ error: expected 'bool', got 'int' + assert true + } +}; +#end From cf5ab22c9c936ce588c79c4c9572903005043c35 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Wed, 1 Jul 2026 13:25:52 +0000 Subject: [PATCH 05/28] feat(laurel): add throws/onThrow procedure contract (E4), recorded not enforced Add the E4 exceptional contract: an optional single throws type and onThrow exceptional postconditions on a procedure. Laurel records and type-checks them; it performs no declare-or-catch enforcement (front-end policy) and does not yet lower them (E7), so a well-formed contract is ignored at translation and verifies cleanly. AST: OnThrowClause (binding + predicate) in the mutual block; Procedure gains throwsType (Option HighType := none) and onThrow (List OnThrowClause := []), defaults keeping all constructor sites compiling. Grammar: 'throws T' and 'onThrow (e) P' procedure clauses; the procedure/function ops grow from 8 to 10 args. Translators: parseProcedure (10-arg) parses both; procedureToOp prints them. Resolution: resolveExceptionalContract resolves the throws type and checks it is a subtype of BaseException, and resolves each onThrow clause in a fresh scope binding the value at BaseException with the predicate checked at bool; wired into resolveProcedure and resolveInstanceProcedure. mapProcedureM rewrites onThrow predicates; collectProcDeps records throws/onThrow names and forces BaseException into scope (gating). Semantics: multiple onThrow clauses conjoin (like ensures). A multi-type throw set is a single disjunctive clause 'onThrow (e) e is A || e is B'; per-type facts are guarded implications 'onThrow (e) e is T ==> P' (the guard scopes each claim so conjoined clauses don't contradict). Tests: ThrowsContract.lean (valid throws/onThrow verify clean; 'throws int' and a non-bool onThrow predicate rejected). ExceptionScenarios.lean (broad E1-E4 coverage: multiple/union/catch-all catches, try/finally, nested try, throw-subtype reaching the NYI lowering; multi-throws contract, per-type guarded-implication onThrow, deeper hierarchy verifying clean; two negatives). Predicates are kept free of binding field-dereference to avoid the known post-heapParameterization rough edge; a value-level per-type postcondition like 'onThrow (e) e is ParseError ==> (e as ParseError)#pos >= 0' is noted as future work pending that fix and E7 lowering. --- Strata/Languages/Laurel/FilterPrelude.lean | 8 + .../AbstractToConcreteTreeTranslator.lean | 6 + .../ConcreteToAbstractTreeTranslator.lean | 25 +- .../Laurel/Grammar/LaurelGrammar.lean | 2 +- .../Languages/Laurel/Grammar/LaurelGrammar.st | 15 +- Strata/Languages/Laurel/LaurelAST.lean | 22 ++ Strata/Languages/Laurel/MapStmtExpr.lean | 3 +- Strata/Languages/Laurel/Resolution.lean | 28 +++ .../Examples/Objects/ExceptionScenarios.lean | 217 ++++++++++++++++++ .../Examples/Objects/ThrowsContract.lean | 81 +++++++ 10 files changed, 400 insertions(+), 7 deletions(-) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/ExceptionScenarios.lean create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean diff --git a/Strata/Languages/Laurel/FilterPrelude.lean b/Strata/Languages/Laurel/FilterPrelude.lean index 4c1c8852db..b41e708f02 100644 --- a/Strata/Languages/Laurel/FilterPrelude.lean +++ b/Strata/Languages/Laurel/FilterPrelude.lean @@ -162,6 +162,14 @@ private def collectProcDeps (proc : Procedure) : CollectM Unit := do proc.preconditions.forM (collectExprNames ·.condition) proc.decreases.forM collectExprNames proc.invokeOn.forM collectExprNames + -- E4 exceptional contract: a declared `throws` type or any `onThrow` clause + -- uses the exceptional channel, whose root `BaseException` must be in scope; + -- recording it (and the throws type / onThrow predicate names) gates the + -- exception prelude in and keeps the relevant declarations. + if proc.throwsType.isSome || !proc.onThrow.isEmpty then + addTypeName baseExceptionTypeName + proc.throwsType.forM collectHighTypeNames + proc.onThrow.forM (collectExprNames ·.predicate) collectBodyNames proc.body /-- Collect all names referenced by a type definition. -/ diff --git a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean index 2d9a574bae..9314535c5e 100644 --- a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean @@ -255,6 +255,10 @@ private def procedureToOp (proc : Procedure) : StrataDDM.Operation := if proc.outputs.isEmpty then optionArg none else optionArg (some (laurelOp "returnParameters" #[commaSep (proc.outputs.map parameterToArg |>.toArray)])) let requiresArgs := proc.preconditions.map requiresClauseToArg |>.toArray + let throwsArg := optionArg (proc.throwsType.map fun t => + laurelOp "throwsClause" #[highTypeToArg t]) + let onThrowArgs := proc.onThrow.map (fun c => + laurelOp "onThrowClause" #[ident c.binding.text, stmtExprToArg c.predicate]) |>.toArray let invokeOnArg := optionArg (proc.invokeOn.map fun e => laurelOp "invokeOnClause" #[stmtExprToArg e]) let (opaqueSpecArg, bodyArg) := match proc.body with @@ -278,6 +282,8 @@ private def procedureToOp (proc : Procedure) : StrataDDM.Operation := returnTypeArg, returnParamsArg, seqArg requiresArgs, + throwsArg, + seqArg onThrowArgs, invokeOnArg, opaqueSpecArg, bodyArg diff --git a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean index 76132d1e0a..75139065f5 100644 --- a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean @@ -530,9 +530,9 @@ def parseProcedure (arg : Arg) : TransM Procedure := do match op.name, op.args with | q`Laurel.procedure, #[nameArg, paramArg, returnTypeArg, returnParamsArg, - requiresArg, invokeOnArg, opaqueSpecArg, bodyArg] + requiresArg, throwsArg, onThrowArg, invokeOnArg, opaqueSpecArg, bodyArg] | q`Laurel.function, #[nameArg, paramArg, returnTypeArg, returnParamsArg, - requiresArg, invokeOnArg, opaqueSpecArg, bodyArg] => + requiresArg, throwsArg, onThrowArg, invokeOnArg, opaqueSpecArg, bodyArg] => let name ← translateIdent nameArg let parameters ← translateParameters paramArg -- Either returnTypeArg or returnParamsArg may have a value, not both @@ -554,6 +554,23 @@ def parseProcedure (arg : Arg) : TransM Procedure := do | _ => TransM.error s!"Expected optionalReturnType operation, got {repr returnTypeArg}" -- Parse preconditions (requires clauses - zero or more) let preconditions ← translateRequiresClauses requiresArg + -- Parse optional `throws` type (E4) + let throwsType ← match throwsArg with + | .option _ (some (.op throwsOp)) => match throwsOp.name, throwsOp.args with + | q`Laurel.throwsClause, #[tyArg] => translateHighType tyArg >>= (pure ∘ some) + | _, _ => TransM.error s!"Expected throwsClause, got {repr throwsOp.name}" + | _ => pure none + -- Parse `onThrow` exceptional postconditions (E4 - zero or more) + let onThrow ← match onThrowArg with + | .seq _ _ clauses => clauses.toList.mapM fun arg => match arg with + | .op cOp => match cOp.name, cOp.args with + | q`Laurel.onThrowClause, #[bindingArg, predArg] => do + let binding ← translateIdent bindingArg + let predicate ← translateStmtExpr predArg + pure ({ binding := binding, predicate := predicate } : OnThrowClause) + | _, _ => TransM.error s!"Expected onThrowClause, got {repr cOp.name}" + | _ => TransM.error "Expected operation in onThrow sequence" + | _ => pure [] -- Parse optional invokeOn clause let invokeOn ← match invokeOnArg with | .option _ (some (.op invokeOnOp)) => match invokeOnOp.name, invokeOnOp.args with @@ -600,11 +617,13 @@ def parseProcedure (arg : Arg) : TransM Procedure := do decreases := none isFunctional := op.name == q`Laurel.function invokeOn := invokeOn + throwsType := throwsType + onThrow := onThrow body := procBody } | q`Laurel.procedure, args | q`Laurel.function, args => - TransM.error s!"parseProcedure expects 8 arguments, got {args.size}" + TransM.error s!"parseProcedure expects 10 arguments, got {args.size}" | _, _ => TransM.error s!"parseProcedure expects procedure or function, got {repr op.name}" diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean index 3439cc12c7..806fb89d0f 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean @@ -12,7 +12,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: added `try`/`catch`/`finally` (E3/E5 exception handling). +-- Last grammar change: added `throws`/`onThrow` procedure clauses (E4 exceptional contract). public import StrataDDM.AST import StrataDDM.BuiltinDialects.Init import StrataDDM.Integration.Lean.HashCommands diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st index b019b6e852..888ca03f96 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st @@ -206,6 +206,13 @@ category OpaqueSpec; op opaqueSpec(ensures: Seq EnsuresClause, modifies: Seq ModifiesClause): OpaqueSpec => "\n opaque" ensures modifies; +// Exceptional contract (E4): an optional `throws` type and `onThrow` postconditions. +category ThrowsClause; +op throwsClause(throwsType: LaurelType): ThrowsClause => "\n throws " throwsType; + +category OnThrowClause; +op onThrowClause(binding: Ident, predicate: StmtExpr): OnThrowClause => "\n onThrow (" binding ") " predicate:0; + category Body; op body(body: StmtExpr): Body => "\n" body:0; op externalBody: Body => "external"; @@ -215,19 +222,23 @@ op procedure (name : Ident, parameters: CommaSepBy Parameter, returnType: Option ReturnType, returnParameters: Option ReturnParameters, requires: Seq RequiresClause, + throws: Option ThrowsClause, + onThrow: Seq OnThrowClause, invokeOn: Option InvokeOnClause, opaqueSpec: Option OpaqueSpec, body : Option Body) : Procedure => - "procedure " name "(" parameters ")" returnType returnParameters requires invokeOn opaqueSpec body ";"; + "procedure " name "(" parameters ")" returnType returnParameters requires throws onThrow invokeOn opaqueSpec body ";"; op function (name : Ident, parameters: CommaSepBy Parameter, returnType: Option ReturnType, returnParameters: Option ReturnParameters, requires: Seq RequiresClause, + throws: Option ThrowsClause, + onThrow: Seq OnThrowClause, invokeOn: Option InvokeOnClause, opaqueSpec: Option OpaqueSpec, body : Option Body) : Procedure => - "function " name "(" parameters ")" returnType returnParameters requires invokeOn opaqueSpec body ";"; + "function " name "(" parameters ")" returnType returnParameters requires throws onThrow invokeOn opaqueSpec body ";"; op composite (name: Ident, extending: Option Extends, fields: Seq Field, procedures: Seq Procedure): Composite => "composite " name extending " {" fields procedures " }"; diff --git a/Strata/Languages/Laurel/LaurelAST.lean b/Strata/Languages/Laurel/LaurelAST.lean index 18584d6902..5673c6ca74 100644 --- a/Strata/Languages/Laurel/LaurelAST.lean +++ b/Strata/Languages/Laurel/LaurelAST.lean @@ -229,6 +229,14 @@ 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 + /-- Optional declared exception type (E4): the single type this procedure may + throw, bounded by the channel root `BaseException`. Recorded as + exceptional-contract data; not enforced (declare-or-catch is front-end + policy) and not yet lowered (E7). -/ + throwsType : Option (AstNode HighType) := none + /-- Exceptional postconditions (E4): predicates that hold when the procedure + exits on the exceptional channel. Recorded, not enforced. -/ + onThrow : List OnThrowClause := [] /-- A typed parameter for a procedure. @@ -269,6 +277,20 @@ structure CatchClause where /-- The handler body, run when this clause matches. -/ body : AstNode StmtExpr +/-- +An `onThrow` exceptional postcondition (E4): a binding for the thrown value +(typed at the channel root `BaseException`) and a boolean predicate that must +hold when the procedure exits exceptionally. A procedure carries a list of +these. Laurel *records* them for the verifier to reason about call sites; it +does not enforce any declare-or-catch rule (that is front-end policy). See +`docs/design/laurel_extensions.md` (extension E4). +-/ +structure OnThrowClause where + /-- The identifier bound to the thrown value (typed `BaseException`). -/ + binding : Identifier + /-- The exceptional-postcondition predicate (checked at `TBool`). -/ + predicate : AstNode StmtExpr + /-- The body of a procedure. A body can be transparent (with a visible implementation), opaque (with a postcondition and optional implementation), diff --git a/Strata/Languages/Laurel/MapStmtExpr.lean b/Strata/Languages/Laurel/MapStmtExpr.lean index e2b43e3ced..e47f49a341 100644 --- a/Strata/Languages/Laurel/MapStmtExpr.lean +++ b/Strata/Languages/Laurel/MapStmtExpr.lean @@ -233,7 +233,8 @@ def mapProcedureM [Monad m] (f : StmtExprMd → m StmtExprMd) (proc : Procedure) return { proc with preconditions := ← proc.preconditions.mapM (·.mapM f) decreases := ← proc.decreases.mapM f - invokeOn := ← proc.invokeOn.mapM f } + invokeOn := ← proc.invokeOn.mapM f + onThrow := ← proc.onThrow.mapM (fun c => do pure { c with predicate := ← f c.predicate }) } /-- 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 794a6da287..5618a791f5 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -2720,6 +2720,30 @@ def resolveBody (body : Body) : ResolveM Body := do return .Abstract posts' | .External => return .External +/-- Resolve a procedure's E4 exceptional contract: the optional `throws` type + (checked to be a subtype of the channel root `BaseException`) and the + `onThrow` postconditions (each binding scoped at `BaseException` over a + boolean predicate). Recorded for the verifier; not enforced — Java-style + declare-or-catch is front-end policy. See `laurel_extensions.md` (E4). -/ +def resolveExceptionalContract (proc : Procedure) + : ResolveM (Option HighTypeMd × List OnThrowClause) := do + let throwsType' ← proc.throwsType.mapM fun t => do + let t' ← resolveHighType t + let baseTy ← resolveHighType + { val := .UserDefined (mkId baseExceptionTypeName), source := t.source } + let ctx := (← get).typeLattice + unless isConsistentSubtype ctx t' baseTy do + modify fun s => { s with errors := s.errors.push (diagnosticFromSource t.source + s!"throws type must be a subtype of '{baseExceptionTypeName}'") } + pure t' + let onThrow' ← proc.onThrow.mapM fun c => withScope do + let bindTy ← resolveHighType + { val := .UserDefined (mkId baseExceptionTypeName), source := c.binding.source } + let binding' ← defineNameCheckDup c.binding (.var c.binding bindTy) + let predicate' ← Check.resolveStmtExpr c.predicate { val := .TBool, source := c.predicate.source } + pure ({ binding := binding', predicate := predicate' } : OnThrowClause) + pure (throwsType', onThrow') + /-- (Procedure) ``` T_o-bar = proc.outputs.types @@ -2755,10 +2779,12 @@ def resolveProcedure (proc : Procedure) : ResolveM Procedure := do -- (e.g. destructive assignments) inside a transparent body. So there is -- no transparent-body rejection here, unlike `resolveInstanceProcedure`. let invokeOn' ← proc.invokeOn.mapM resolveStmtExpr + let (throwsType', onThrow') ← resolveExceptionalContract proc return { name := procName', inputs := inputs', outputs := outputs', isFunctional := proc.isFunctional, preconditions := pres', decreases := dec', invokeOn := invokeOn', + throwsType := throwsType', onThrow := onThrow', body := body' } /-- Resolve a field: define its name under the qualified key (OwnerType.fieldName) and resolve its type. -/ @@ -2796,10 +2822,12 @@ def resolveInstanceProcedure (typeName : Identifier) (proc : Procedure) : Resolv modify fun s => { s with errors := s.errors.push diag } let invokeOn' ← proc.invokeOn.mapM resolveStmtExpr modify fun s => { s with instanceTypeName := savedInstType } + let (throwsType', onThrow') ← resolveExceptionalContract proc return { name := procName', inputs := inputs', outputs := outputs', isFunctional := proc.isFunctional, preconditions := pres', decreases := dec', invokeOn := invokeOn', + throwsType := throwsType', onThrow := onThrow', body := body' } /-- Resolve a type definition. -/ diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ExceptionScenarios.lean b/StrataTest/Languages/Laurel/Examples/Objects/ExceptionScenarios.lean new file mode 100644 index 0000000000..80d4e06f8b --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/ExceptionScenarios.lean @@ -0,0 +1,217 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Broad coverage of the exception-handling surface implemented so far +(E1–E4; see `docs/design/laurel_extensions.md`): the `BaseException` +hierarchy, `throw`, predicate-based `try`/`catch`/`finally`, and the +`throws`/`onThrow` procedure contract. + +Two observable behaviors are pinned down here: + * well-formed `throw` / `try` constructs parse, resolve, and type-check, then + reach the `not-yet-implemented` Core lowering (E7, blocked on generics); + * well-formed `throws`/`onThrow` contracts are recorded, ignored at + translation, and so verify cleanly (no diagnostics); + * ill-typed constructs are rejected during resolution. + +Handler bodies are kept free of calls and of dereferences of the catch/onThrow +binding, to stay clear of the known post-`heapParameterization` rough edges. +-/ + +/-! ## Structured handlers (E3/E5) -/ + +-- Multiple ordered catch clauses (first-match-wins). +#eval testLaurel <| +#strata +program Laurel; +composite ParseError extends BaseException {} +composite ArithError extends BaseException {} +procedure multipleCatches() opaque { + try { +//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) + assert true + } catch e when e is ParseError { + assert true + } catch e when e is ArithError { + assert true + } +}; +#end + +-- Union multi-catch: one clause matching either type (F11). +#eval testLaurel <| +#strata +program Laurel; +composite ParseError extends BaseException {} +composite ArithError extends BaseException {} +procedure unionCatch() opaque { + try { +//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) + assert true + } catch e when e is ParseError || e is ArithError { + assert true + } +}; +#end + +-- Catch-all clause (no guard). +#eval testLaurel <| +#strata +program Laurel; +procedure catchAll() opaque { + try { +//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) + assert true + } catch e { + assert true + } +}; +#end + +-- `try` with only a `finally` arm (no catch). +#eval testLaurel <| +#strata +program Laurel; +procedure tryFinally() opaque { + try { +//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) + assert true + } finally { + assert true + } +}; +#end + +-- Nested try/catch (the outer handler is what reaches lowering first). +#eval testLaurel <| +#strata +program Laurel; +composite ParseError extends BaseException {} +procedure nestedTry() opaque { + try { +//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) + try { + assert true + } catch inner { + assert true + } + } catch outer when outer is ParseError { + assert true + } +}; +#end + +/-! ## Throwing (E1/E2) -/ + +-- Throw a value of a declared subtype of BaseException. +#eval testLaurel <| +#strata +program Laurel; +composite ParseError extends BaseException {} +procedure throwsSubtype() opaque { + var e: ParseError := new ParseError; + throw e +//^^^^^^^ not-yet-implemented: throw is not yet supported (requires generic Result lowering, E7) +}; +#end + +/-! ## Exceptional contract (E4) — recorded, verifies clean -/ + +-- Multi-throws modeling: a coarsened `throws` type plus the precise set in an +-- `onThrow` predicate (this is how a Java `throws A, B` is represented). +#eval testLaurel <| +#strata +program Laurel; +composite ParseError extends BaseException {} +composite ArithError extends BaseException {} +procedure multiThrows() + throws BaseException + onThrow (e) e is ParseError || e is ArithError + opaque +{ + assert true +}; +#end + +-- Per-type `onThrow` clauses. Multiple clauses conjoin, so each is written as a +-- guarded implication `e is T ==> `: the guard scopes the claim +-- to its own type, so the clauses coexist. (Contrast bare `onThrow (e) e is A` + +-- `onThrow (e) e is B`, which conjoin to "the value is both A and B" — a +-- contradiction for disjoint siblings, i.e. "throws neither".) +-- +-- With field access on the binding, this same shape would let us state per-type +-- *value* properties, e.g. +-- onThrow (e) e is ParseError ==> (e as ParseError)#position >= 0 +-- Dereferencing the binding (`(e as T)#field`) is deliberately omitted here: it +-- type-checks, but re-resolution after `heapParameterization` (which moves +-- composite fields into the heap) can no longer find the field, so it currently +-- trips a strata-bug. The consequents are kept field-free until that gap is +-- closed (and until E7 lowering actually consumes these contracts). +#eval testLaurel <| +#strata +program Laurel; +composite ParseError extends BaseException {} +composite ArithError extends BaseException {} +procedure perTypeOnThrow() + throws BaseException + onThrow (e) e is ParseError ==> !(e is ArithError) + onThrow (e) e is ArithError ==> !(e is ParseError) + opaque +{ + assert true +}; +#end + +-- Deeper hierarchy: a tighter `throws` type (an intermediate ancestor). +#eval testLaurel <| +#strata +program Laurel; +composite AppException extends BaseException {} +composite ParseError extends AppException {} +procedure tighterThrows() + throws AppException + onThrow (e) e is ParseError + opaque +{ + assert true +}; +#end + +/-! ## Negative cases -/ + +-- A union guard whose operand is not boolean. +#eval testLaurel <| +#strata +program Laurel; +composite ParseError extends BaseException {} +procedure badUnionGuard() opaque { + try { + assert true + } catch e when e is ParseError || 5 { +// ^ error: expected 'bool', got 'int' + assert true + } +}; +#end + +-- A `throws` type that is a composite but not a BaseException subtype. +#eval testLaurel <| +#strata +program Laurel; +composite NotAnError {} +procedure badThrowsComposite() + throws NotAnError +// ^^^^^^^^^^ error: throws type must be a subtype of 'BaseException' + opaque +{ + assert true +}; +#end diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean b/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean new file mode 100644 index 0000000000..7fbf290fc4 --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean @@ -0,0 +1,81 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Exercises the E4 procedure exceptional contract: an optional `throws` type and +`onThrow` exceptional postconditions (see `docs/design/laurel_extensions.md`, +extension E4). Laurel *records* these and resolves/type-checks them — the +`throws` type must be a subtype of the channel root `BaseException`, and each +`onThrow` predicate is checked at `bool` with its binding typed `BaseException`. +Laurel performs no declare-or-catch enforcement (that is front-end policy), and +the contract is not yet consumed by lowering (E7), so a well-formed contract +verifies cleanly (it is ignored during translation). +-/ + +-- Valid: `throws` a BaseException subtype. Recorded and ignored at translation, +-- so the procedure verifies with no diagnostics. +#eval testLaurel <| +#strata +program Laurel; + +composite ArithError extends BaseException {} + +procedure mightThrow() + throws ArithError + opaque +{ + assert true +}; +#end + +-- Valid: an `onThrow` exceptional postcondition with a boolean predicate. +#eval testLaurel <| +#strata +program Laurel; + +composite ArithError extends BaseException {} + +procedure mightThrow2() + throws ArithError + onThrow (e) true + opaque +{ + assert true +}; +#end + +-- Ill-typed: the `throws` type is not a subtype of BaseException. +#eval testLaurel <| +#strata +program Laurel; + +procedure badThrows() + throws int +// ^^^ error: throws type must be a subtype of 'BaseException' + opaque +{ + assert true +}; +#end + +-- Ill-typed: the `onThrow` predicate is an int, not a bool. +#eval testLaurel <| +#strata +program Laurel; + +procedure badOnThrow() + onThrow (e) 5 +// ^ error: expected 'bool', got 'int' + opaque +{ + assert true +}; +#end From 468ffce7b4cbc4b6430de75fecaf7a7f1616057a Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Wed, 1 Jul 2026 14:49:26 +0000 Subject: [PATCH 06/28] fix(laurel): heap-parameterize inside try/catch and throw heapParameterization skipped Try/Throw nodes in both the heap analysis (collectExpr) and the transform (heapTransformExpr). A procedure that calls a heap-using procedure inside a 'try' was therefore never classified as heap-using (the call wasn't counted as a callee), and even when classified, calls inside the 'try' body weren't given the $heap argument. The result was an internal strata-bug at re-resolution ("expected 'Heap', got 'int'") for otherwise ordinary try/catch code. collectExpr/collectExprMd: recurse into Throw and Try (body, catch predicates/bodies, finally). Made partial, since the nested catch-clause list makes structural recursion impractical; consistent with other analysis traversals already marked partial (collectStmtExpr, collectExprNames). heapTransformExpr: recurse into Throw and Try the same way; add the CatchClause sizeOf lemmas to its decreasing_by (kept total). Effect: programs that call heap-using procedures inside try/catch (or throw a freshly allocated exception) now parse, resolve, heap-parameterize, and re-resolve cleanly, reaching the expected not-yet-implemented lowering (E7) instead of crashing with an internal error. Test: TryHeapCalls.lean - a minimal heap-allocating callee invoked inside a try, plus a realistic multi-catch with throwing heap-using callees. --- .../Laurel/HeapParameterization.lean | 35 +++++--- .../Laurel/Examples/Objects/TryHeapCalls.lean | 79 +++++++++++++++++++ 2 files changed, 101 insertions(+), 13 deletions(-) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/TryHeapCalls.lean diff --git a/Strata/Languages/Laurel/HeapParameterization.lean b/Strata/Languages/Laurel/HeapParameterization.lean index b4ae8fc32e..d5077e27be 100644 --- a/Strata/Languages/Laurel/HeapParameterization.lean +++ b/Strata/Languages/Laurel/HeapParameterization.lean @@ -56,11 +56,9 @@ structure AnalysisResult where mutual -def collectExprMd (expr : StmtExprMd) : StateM AnalysisResult Unit := collectExpr expr.val - termination_by sizeOf expr - decreasing_by cases expr; term_by_mem +partial def collectExprMd (expr : StmtExprMd) : StateM AnalysisResult Unit := collectExpr expr.val -def collectExpr (expr : StmtExpr) : StateM AnalysisResult Unit := do +partial def collectExpr (expr : StmtExpr) : StateM AnalysisResult Unit := do match _: expr with | .Var (.Field target _) => modify fun s => { s with readsHeapDirectly := true }; collectExprMd target @@ -93,16 +91,14 @@ def collectExpr (expr : StmtExpr) : StateM AnalysisResult Unit := do | .Assume c => collectExprMd c | .ProveBy v p => collectExprMd v; collectExprMd p | .ContractOf _ f => collectExprMd f + | .Throw v => collectExprMd v + | .Try body catches finally? => + collectExprMd body + for c in catches do + match c.predicate with | some p => collectExprMd p | none => pure () + collectExprMd c.body + match finally? with | some f => collectExprMd f | none => pure () | _ => pure () - termination_by sizeOf expr - decreasing_by - all_goals simp_wf - all_goals (try term_by_mem) - -- For target inside Field in assign target list (attach-based loop): - all_goals ( - have := List.sizeOf_lt_of_mem ‹_› - have := Variable.sizeOf_field_target_lt_of_eq _hav - omega) end def analyzeProc (proc : Procedure) : AnalysisResult := @@ -452,12 +448,25 @@ where | .Assume c => return [⟨ .Assume (← recurseOne c), source ⟩] | .ProveBy v p => return [⟨ .ProveBy (← recurseOne v) (← recurseOne p), source ⟩] | .ContractOf ty f => return [⟨ .ContractOf ty (← recurseOne f), source ⟩] + | .Throw value => return [⟨ .Throw (← recurseOne value), source ⟩] + | .Try body catches finally? => + -- Recurse into every arm so calls/field accesses inside a `try` are + -- heap-transformed (e.g. `$heap` threaded through calls in the body). + let body' ← recurseOne body false + let catches' ← catches.attach.mapM fun ⟨c, _⟩ => do + let predicate' ← c.predicate.attach.mapM fun ⟨p, _⟩ => recurseOne p + let cbody' ← recurseOne c.body false + pure ({ c with predicate := predicate', body := cbody' } : CatchClause) + let finally'? ← finally?.attach.mapM fun ⟨f, _⟩ => recurseOne f false + return [⟨ .Try body' catches' finally'?, source ⟩] | _ => return [exprMd] termination_by (sizeOf exprMd, 0) decreasing_by all_goals simp_wf all_goals (try have := AstNode.sizeOf_val_lt exprMd) all_goals (try have := AstNode.sizeOf_val_lt v) + all_goals (try have := CatchClause.sizeOf_body_lt ‹_›) + all_goals (try have := CatchClause.sizeOf_predicate_lt ‹_›) all_goals (try term_by_mem) all_goals (try (cases exprMd; simp_all; omega)) -- For field inner expressions in attach-based: diff --git a/StrataTest/Languages/Laurel/Examples/Objects/TryHeapCalls.lean b/StrataTest/Languages/Laurel/Examples/Objects/TryHeapCalls.lean new file mode 100644 index 0000000000..75839cb43e --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/TryHeapCalls.lean @@ -0,0 +1,79 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Regression coverage for `heapParameterization` handling `try`/`catch` (and +`throw`). Previously the heap analysis (`collectExpr`) and transform +(`heapTransformExpr`) both skipped `Try`/`Throw` nodes: calls inside a `try` +body were not counted toward heap classification and did not get `$heap` +threaded, so a caller invoking a heap-using procedure inside a `try` failed +re-resolution with an internal `strata-bug` (`expected 'Heap', got 'int'`). + +Now such programs parse, resolve, heap-parameterize, and re-resolve cleanly, +reaching the expected `not-yet-implemented` lowering (E7) instead. +-/ + +-- Minimal: a heap-using callee (`alloc` allocates, so it is a heap writer) is +-- invoked inside a `try` body. This must reach the `try/catch` NYI lowering +-- without any prior `strata-bug`. +#eval testLaurel <| +#strata +program Laurel; +composite ParseError extends BaseException {} +procedure alloc() returns (r: int) opaque { + var e: ParseError := new ParseError; + r := 1 +}; +procedure computeViaTry() returns (r: int) opaque { + try { +//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) + r := alloc() + } catch e { + r := 0 + } +}; +#end + +-- Realistic: multiple heap-using, throwing callees invoked inside a +-- multi-catch `try`. Reaches the throw/try NYIs (no strata-bug). +#eval testLaurel <| +#strata +program Laurel; +composite ArithError extends BaseException {} +composite ParseError extends BaseException {} +procedure parsePositive(s: int) returns (r: int) throws ParseError opaque { + if s < 0 then { + var pe: ParseError := new ParseError; + throw pe +// ^^^^^^^^ not-yet-implemented: throw is not yet supported (requires generic Result lowering, E7) + }; + r := s +}; +procedure safeDivide(a: int, b: int) returns (r: int) throws ArithError opaque { + if b == 0 then { + var ae: ArithError := new ArithError; + throw ae +// ^^^^^^^^ not-yet-implemented: throw is not yet supported (requires generic Result lowering, E7) + }; + r := a / b +}; +procedure compute(s: int) returns (r: int) opaque { + try { +//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) + var n: int := parsePositive(s); + r := safeDivide(100, n) + } catch e when e is ParseError { + r := -1 + } catch e when e is ArithError { + r := -2 + } +}; +#end From 3df5c029cb7d044b3605c25b059c42228aa9848d Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Thu, 2 Jul 2026 13:42:04 +0000 Subject: [PATCH 07/28] feat(laurel): minimal generic datatypes (E7 prerequisite) --- .../AbstractToConcreteTreeTranslator.lean | 15 +++-- .../ConcreteToAbstractTreeTranslator.lean | 18 +++++- .../Laurel/Grammar/LaurelGrammar.lean | 2 +- .../Languages/Laurel/Grammar/LaurelGrammar.st | 8 ++- Strata/Languages/Laurel/LaurelAST.lean | 6 ++ .../Laurel/LaurelToCoreTranslator.lean | 36 +++++++++-- Strata/Languages/Laurel/Resolution.lean | 40 +++++++++++- .../Examples/Objects/GenericDatatype.lean | 61 +++++++++++++++++++ 8 files changed, 171 insertions(+), 15 deletions(-) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/GenericDatatype.lean diff --git a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean index 9314535c5e..8f657dc3fa 100644 --- a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean @@ -51,10 +51,13 @@ partial def highTypeValToArg : HighType → Arg | .TVoid => laurelOp "compositeType" #[ident "void"] -- Type parameters discarded; the grammar cannot represent Set[T] | .TSet _et => laurelOp "compositeType" #[ident "Set"] - | .Applied base _args => - -- Applied types are not directly representable in the grammar; - -- emit the base type as a best-effort approximation - highTypeToArg base + | .Applied base args => + -- Generic type application, e.g. `Option`. Representable only when the + -- base is a named type (which is the only form the grammar produces). + match base.val with + | .UserDefined name => + laurelOp "appliedType" #[ident name.text, commaSep (args.map highTypeToArg |>.toArray)] + | _ => highTypeToArg base | .Pure base => highTypeToArg base | .Intersection types => match types with @@ -317,10 +320,12 @@ private def datatypeConstructorToArg (c : DatatypeConstructor) : Arg := private def datatypeToOp (dt : DatatypeDefinition) : StrataDDM.Operation := let ctors := dt.constructors.map datatypeConstructorToArg |>.toArray let ctorList := laurelOp "datatypeConstructorList" #[commaSep ctors] + let typeParamsArg := optionArg (if dt.typeArgs.isEmpty then none + else some (laurelOp "typeParams" #[commaSep (dt.typeArgs.map (fun p => ident p.text) |>.toArray)])) let datatypeOp : StrataDDM.Operation := { ann := sr name := { dialect := "Laurel", name := "datatype" } - args := #[ident dt.name.text, ctorList] } + args := #[ident dt.name.text, typeParamsArg, ctorList] } { ann := sr name := { dialect := "Laurel", name := "datatypeCommand" } args := #[.op datatypeOp] } diff --git a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean index 75139065f5..f8564ee641 100644 --- a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean @@ -111,6 +111,12 @@ partial def translateHighType (arg : Arg) : TransM HighTypeMd := do | q`Laurel.compositeType, #[nameArg] => let name ← translateIdent nameArg return mkHighTypeMd (.UserDefined name) src + | q`Laurel.appliedType, #[baseArg, argsArg] => + let base ← translateIdent baseArg + let args ← match argsArg with + | .seq _ .comma args => args.toList.mapM translateHighType + | singleArg => do let a ← translateHighType singleArg; pure [a] + return mkHighTypeMd (.Applied (mkHighTypeMd (.UserDefined base) src) args) src | _, _ => TransM.error s!"translateHighType: unsupported type operator {repr op.name}" | _ => TransM.error s!"translateHighType expects operation" @@ -698,8 +704,16 @@ def parseDatatype (arg : Arg) : TransM TypeDefinition := do let .op op := arg | TransM.error s!"parseDatatype expects operation" match op.name, op.args with - | q`Laurel.datatype, #[nameArg, constructorsArg] => + | q`Laurel.datatype, #[nameArg, typeParamsArg, constructorsArg] => let name ← translateIdent nameArg + let typeArgs ← match typeParamsArg with + | .option _ (some (.op tpOp)) => match tpOp.name, tpOp.args with + | q`Laurel.typeParams, #[paramsArg] => + match paramsArg with + | .seq _ .comma args => args.toList.mapM translateIdent + | singleArg => do let p ← translateIdent singleArg; pure [p] + | _, _ => TransM.error s!"Expected typeParams, got {repr tpOp.name}" + | _ => pure [] let constructors ← match constructorsArg with | .op listOp => match listOp.name, listOp.args with | q`Laurel.datatypeConstructorList, #[csArg] => @@ -708,7 +722,7 @@ def parseDatatype (arg : Arg) : TransM TypeDefinition := do | singleArg => do let c ← parseDatatypeConstructor singleArg; pure [c] | _, _ => TransM.error s!"Expected datatypeConstructorList, got {repr listOp.name}" | _ => TransM.error s!"Expected datatypeConstructorList operation" - return .Datatype { name := name, typeArgs := [], constructors := constructors } + return .Datatype { name := name, typeArgs := typeArgs, constructors := constructors } | _, _ => TransM.error s!"parseDatatype expects datatype, got {repr op.name}" diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean index 806fb89d0f..1d33d8e18c 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean @@ -12,7 +12,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: added `throws`/`onThrow` procedure clauses (E4 exceptional contract). +-- Last grammar change: added generic datatype type parameters and type application (`Option`, `Option`). public import StrataDDM.AST import StrataDDM.BuiltinDialects.Init import StrataDDM.Integration.Lean.HashCommands diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st index 888ca03f96..1ab1a2741d 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st @@ -13,6 +13,8 @@ op bvType (width: Num): LaurelType => "bv" width; // Core type passthrough: parsed as Ident, translated to HighType.TCore op coreType (name: Ident): LaurelType => "Core " name; op mapType (keyType: LaurelType, valueType: LaurelType): LaurelType => "Map " keyType " " valueType; +// Generic type application, e.g. `Option` or `Result`. +op appliedType (base: Ident, args: CommaSepBy LaurelType): LaurelType => base "<" args ">"; op compositeType (name: Ident): LaurelType => name; category StmtExpr; @@ -179,8 +181,12 @@ op datatypeConstructorNoArgs (name: Ident): DatatypeConstructor => name; category DatatypeConstructorList; op datatypeConstructorList (constructors: CommaSepBy DatatypeConstructor): DatatypeConstructorList => constructors; +// Optional generic type parameters on a datatype, e.g. `Option` / `Result`. +category TypeParams; +op typeParams (params: CommaSepBy Ident): TypeParams => "<" params ">"; + category Datatype; -op datatype (name: Ident, constructors: DatatypeConstructorList): Datatype => "datatype " name " { " constructors " }"; +op datatype (name: Ident, typeParams: Option TypeParams, constructors: DatatypeConstructorList): Datatype => "datatype " name typeParams " { " constructors " }"; // Procedures category ReturnType; diff --git a/Strata/Languages/Laurel/LaurelAST.lean b/Strata/Languages/Laurel/LaurelAST.lean index 5673c6ca74..b193a4de4a 100644 --- a/Strata/Languages/Laurel/LaurelAST.lean +++ b/Strata/Languages/Laurel/LaurelAST.lean @@ -647,6 +647,12 @@ partial def TypeLattice.unfold (ctx : TypeLattice) (ty : HighTypeMd) else match ctx.unfoldMap.get? name.text with | some target => ctx.unfold target (visited.insert name.text) | none => ty + -- Generic type application is *erased* to its base for Laurel's consistency / + -- subtype checks: `Option` is treated as `Option`. Type-argument + -- checking is deferred to Core (which has real polymorphic datatypes); the + -- args are preserved in the AST and only dropped here, in the type-relation + -- layer, never in translation. + | .Applied base _ => ctx.unfold base visited | _ => ty /-- All ancestors of a composite type (including itself), reachable via diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index aa6d7c71ae..221d5c806b 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -78,7 +78,7 @@ private def invalidCoreType (source : Option FileRange) (reason : String) : Tran /- Translate Laurel HighType to Core Type -/ -def translateType (ty : HighTypeMd) : TranslateM LMonoTy := do +partial def translateType (ty : HighTypeMd) : TranslateM LMonoTy := do let model := (← get).model match _h : ty.val with | .TInt => return LMonoTy.int @@ -97,14 +97,19 @@ def translateType (ty : HighTypeMd) : TranslateM LMonoTy := do return .tcons "Composite" [] | .TCore s => return .tcons s [] | .TReal => return LMonoTy.real + -- Generic type application, e.g. `Option` → Core `.tcons "Option" [int]`. + -- Core has real polymorphic datatypes, so the type arguments are forwarded. + | .Applied base args => + match base.val with + | .UserDefined n => + let coreArgs ← args.mapM translateType + return .tcons n.text coreArgs + | _ => invalidCoreType ty.source "generic type application with a non-named base is not supported" | .MultiValuedExpr _ => invalidCoreType ty.source "MultiValuedExpr type encountered during Core translation" | .Unknown => invalidCoreType ty.source "Unknown type encountered during Core translation" | _ => do 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)) - def lookupType (name : Identifier) : TranslateM LMonoTy := do translateType ((← get).model.get name).getType @@ -784,14 +789,35 @@ def translateProcedureToFunction (options: LaurelTranslateOptions) (isRecursive: } return .func f (identifierToCoreMd proc.name) +/-- +Translate a datatype constructor argument type. A reference to one of the +datatype's type parameters (`typeVars`) becomes a Core type variable +(`.ftvar`); everything else translates normally. Handles type parameters +nested inside `Applied`/`TSet`/`TMap` (e.g. `tail: List`). +-/ +partial def translateCtorArgType (typeVars : List String) (ty : HighTypeMd) + : TranslateM LMonoTy := do + match ty.val with + | .UserDefined name => + if typeVars.contains name.text then return .ftvar name.text + else translateType ty + | .Applied base args => + match base.val with + | .UserDefined n => return .tcons n.text (← args.mapM (translateCtorArgType typeVars)) + | _ => translateType ty + | .TSet et => return Core.mapTy (← translateCtorArgType typeVars et) LMonoTy.bool + | .TMap k v => return Core.mapTy (← translateCtorArgType typeVars k) (← translateCtorArgType typeVars v) + | _ => translateType ty + /-- Translate a Laurel DatatypeDefinition to an `LDatatype Unit`. -/ def translateDatatypeDefinition (dt : DatatypeDefinition) : TranslateM (Lambda.LDatatype Unit) := do + let typeVars := dt.typeArgs.map (·.text) let constrs ← dt.constructors.mapM fun c => do let args ← c.args.mapM fun ⟨ n, ty ⟩ => do - return (⟨n.text, ()⟩, ← translateType ty) + return (⟨n.text, ()⟩, ← translateCtorArgType typeVars ty) return { name := ⟨c.name.text, ()⟩ args := args testerName := s!"{dt.name}..is{c.name}" : Lambda.LConstr Unit } diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index 5618a791f5..baec252e74 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -361,6 +361,29 @@ def resolveHighType (ty : HighTypeMd) : ResolveM HighTypeMd := do | other => pure other return { val := val', source := ty.source } +/-- Resolve a datatype constructor argument type, leaving references to the + datatype's own type parameters (`typeParams`) as bare `.UserDefined` + markers — they are not defined types, so `resolveHighType` would (wrongly) + report them "not defined". Everything else resolves normally. The markers + survive to `translateDatatypeDefinition`, which turns them into Core type + variables (`ftvar`). -/ +partial def resolveDatatypeArgType (typeParams : List String) (ty : HighTypeMd) + : ResolveM HighTypeMd := do + match ty.val with + | .UserDefined name => + if typeParams.contains name.text then pure ty + else resolveHighType ty + | .Applied base args => + let base' ← resolveDatatypeArgType typeParams base + let args' ← args.mapM (resolveDatatypeArgType typeParams) + pure { val := .Applied base' args', source := ty.source } + | .TSet et => + pure { val := .TSet (← resolveDatatypeArgType typeParams et), source := ty.source } + | .TMap k v => + pure { val := .TMap (← resolveDatatypeArgType typeParams k) + (← resolveDatatypeArgType typeParams v), source := ty.source } + | _ => resolveHighType ty + /-- Format a type for use in diagnostics. -/ private def formatType (ty : HighTypeMd) : String := match ty.val with @@ -1768,6 +1791,20 @@ def Synth.staticCall (exprMd : StmtExprMd) let callee' ← resolveRef callee source (expected := #[.parameter, .staticProcedure, .datatypeConstructor, .datatypeDestructor, .constant]) let (retTy, paramTypes) ← getCallInfo callee + -- Datatype constructors are (erased) polymorphic: their declared argument + -- types may be the datatype's own type parameters, so we do NOT check the + -- arguments against them here — Core performs the real polymorphic check. + -- (Same treatment as the polymorphic map primitives above.) Testers, whose + -- names contain "..is", are ordinary and fall through to normal checking. + let isConstructorCall := match (← get).scope.get? callee.text with + | some (_, .datatypeConstructor _ _) => (callee.text.splitOn "..is").length == 1 + | _ => false + if isConstructorCall then + let args' ← args.attach.mapM (fun ⟨a, hMem⟩ => do + have := hMem + let (a', _) ← Synth.resolveStmtExpr a + pure a') + return (.StaticCall callee' args', retTy) let unknownTy : HighTypeMd := { val := .Unknown, source := none } let expectedTys : List HighTypeMd := paramTypes ++ List.replicate (args.length - paramTypes.length) unknownTy @@ -2871,10 +2908,11 @@ def resolveTypeDefinition (td : TypeDefinition) : ResolveM TypeDefinition := do constraint := constraint', witness := witness' } | .Datatype dt => let dtName' ← resolveRef dt.name + let typeParamNames := dt.typeArgs.map (·.text) let ctors' ← dt.constructors.mapM fun ctor => do let ctorName' ← resolveRef ctor.name let args' ← ctor.args.mapM fun (p: Parameter) => do - let ty' ← resolveHighType p.type + let ty' ← resolveDatatypeArgType typeParamNames p.type let resolved ← resolveRef (dt.destructorName p) -- Keep the original parameter name; only take the uniqueId from resolution. -- resolveRef returns text = "DtName..field" (the qualified lookup key), but the diff --git a/StrataTest/Languages/Laurel/Examples/Objects/GenericDatatype.lean b/StrataTest/Languages/Laurel/Examples/Objects/GenericDatatype.lean new file mode 100644 index 0000000000..ce87d3b3d5 --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/GenericDatatype.lean @@ -0,0 +1,61 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Minimal generic (polymorphic) datatypes for Laurel. Laurel's surface gains +type-parameter lists on `datatype` (`Option`, `Result`) and generic +type application in type positions (`Option`), lowering to Strata Core's +already-existing polymorphic datatypes (SMT `(declare-datatype … (par …))`). + +Laurel's own type checking is erased for generics — type arguments are carried +syntactically and checked by Core — so constructor calls are typed at the bare +datatype and `Option` is treated as `Option` for consistency. This unblocks +E7's `Result` lowering. +-/ + +-- Single type parameter: construct, test, and destruct a generic `Option`. +#eval testLaurel <| +#strata +program Laurel; +datatype Option { + Nothing(), + Some(value: T) +} +procedure useOption() + opaque +{ + var o: Option := Some(42); + assert Option..isSome(o); + assert Option..value(o) == 42; + var n: Option := Nothing(); + assert Option..isNothing(n) +}; +#end + +-- Two type parameters: the `Result` shape that E7 lowering targets. +#eval testLaurel <| +#strata +program Laurel; +datatype Result { + Good(value: Val), + Bad(err: Err) +} +procedure useResult() + opaque +{ + var ok: Result := Good(7); + assert Result..isGood(ok); + assert Result..value(ok) == 7; + var err: Result := Bad("boom"); + assert Result..isBad(err); + assert Result..err(err) == "boom" +}; +#end From 9c8c6112c3c26d53b606e555c8ab517a9a60d218 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Mon, 6 Jul 2026 11:00:40 +0000 Subject: [PATCH 08/28] feat(laurel): lower exceptions to Result (E7) Replace the throw/try NotYetImplemented stubs with real lowering to Core, building on the generic Result datatype. Exceptions now parse, resolve, heap-parameterize, lower, and verify end-to-end. Lowering (LaurelToCoreTranslator): - A procedure declaring `throws` returns a single `Result` output; its normal value output becomes an internal local, and inout outputs (notably `$heap`) are preserved. Err is always `Composite`, since after heap parameterization every exception is a heap reference, so the declared throws type is not needed at the Core boundary. - In-flight exception state is carried by synthesized `$thrown`/`$exc` locals; `throw v` sets them and exits to the nearest enclosing `try` label (or `$body` to escape), where the result is built as `Bad($exc)` / `Good(value)`. - `try/catch/finally` reuses Block/Exit: the body runs in a labeled block a throw exits to, followed by a first-match-wins chain of guarded handlers (`$thrown && predicate`, catch binding substituted with `$exc`); an unmatched exception stays in flight and propagates outward; `finally` runs on the fall-through edge. - A call to a throwing procedure binds its Result, then propagates `Bad` outward or unwraps `Good` into the target. - Add the Result datatype to the exception prelude (gated in with BaseException). Supporting changes: - translateStmt is now `partial`: recursion into the catch-clause list and optional finally makes a structural/well-founded termination proof impractical (consistent with existing partial AST-walking helpers). It is a translation function, not used in proofs. - translateType lowers an unresolved `BaseException` (the catch/onThrow binding's type, which has no AST node for heap parameterization to rewrite) to `Composite` instead of emitting a spurious strata-bug. A throw or thrower-call whose exception would escape a procedure that does not declare `throws` reports not-yet-implemented (E4 no-escape enforcement is deferred). Tests: ThrowStatement, TryCatch, ExceptionScenarios, and TryHeapCalls now verify real exception programs instead of stopping at the stubs. --- .../Laurel/CoreDefinitionsForLaurel.lean | 5 + .../Laurel/LaurelToCoreTranslator.lean | 293 +++++++++++++++--- .../Examples/Objects/ExceptionScenarios.lean | 16 +- .../Examples/Objects/ThrowStatement.lean | 33 +- .../Laurel/Examples/Objects/TryCatch.lean | 15 +- .../Laurel/Examples/Objects/TryHeapCalls.lean | 17 +- 6 files changed, 304 insertions(+), 75 deletions(-) diff --git a/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean b/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean index 2e992dfa4c..99719a076c 100644 --- a/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean +++ b/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean @@ -73,6 +73,11 @@ composite BaseException { var message: string } +datatype Result { + Good(value: Val), + Bad(err: Err) +} + #end /-- diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index 221d5c806b..7de87fea3c 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -54,6 +54,20 @@ structure TranslateState where Used by the `.Old (Var (Local n))` arm to defensively check `n` against the procedure's inout list. Empty when not translating a procedure body. -/ currentProcInouts : List String := [] + /-- E7: whether the procedure currently being translated declares `throws`. + When `true`, the procedure returns a `Result` and has the + synthesized `$thrown`/`$exc` locals, so a `throw` lowers to setting those + and exiting (rather than reporting not-yet-implemented). -/ + currentProcThrows : Bool := false + /-- E7: set to `true` while translating a procedure body when a `throw` or + `try` is lowered. Signals that the `$thrown`/`$exc` locals must be declared + even in a procedure that does not itself declare `throws` (e.g. one whose + only exceptional construct is a `try` that catches locally). -/ + currentProcUsedExc : Bool := false + /-- E7: stack of enclosing `try` block labels, innermost first. A `throw` + (or a propagating call) exits to the head of this stack; when empty it + exits `bodyLabel`, escaping the procedure on the exceptional channel. -/ + tryLabelStack : List String := [] /-- 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 @@ -75,6 +89,36 @@ private def invalidCoreType (source : Option FileRange) (reason : String) : Tran emitCoreDiagnostic (diagnosticFromSource source reason DiagnosticType.StrataBug) return .tcons s!"LaurelResolutionErrorPlaceholder" [] +/-! ### E7: exception-lowering names and helpers + +A throwing procedure lowers to one that returns a `Result` +(the generic datatype defined in the exception prelude). In-flight exception +state is carried by two synthesized locals, `$thrown` and `$exc`; after the +body block runs, the result is constructed (`Bad($exc)` when thrown, else +`Good(val)`). All names are `$`-prefixed, so they are outside the user +namespace (no source identifier can contain `$`). -/ + +/-- The generic result datatype's name (from `exceptionDefinitionsForLaurel`). -/ +private def resultDatatypeName : String := "Result" +/-- Synthesized Core output of a throwing procedure: its `Result`. -/ +private def resultVarName : String := "$result" +/-- Synthesized local: `true` once an exception is in flight. -/ +private def thrownVarName : String := "$thrown" +/-- Synthesized local: the in-flight exception value. -/ +private def excVarName : String := "$exc" + +/-- Core type of an in-flight exception value. After heap parameterization every + exception (a composite) is represented as a heap `Composite` reference, so + the `Err` component of the result is always `Composite` — the declared + `throws` type is not needed at this point. (Keyed on the same `"Composite"` + name the heap prelude uses; see `HeapParameterizationConstants`.) -/ +private def exceptionCoreTy : LMonoTy := .tcons "Composite" [] + +/-- Build a datatype constructor application `Ctor(arg)`, the same shape + `translateExpr` produces when lowering a `StaticCall` to a constructor. -/ +private def mkExceptionCtorApp (ctor : String) (arg : Core.Expression.Expr) : Core.Expression.Expr := + .app () (.op () ⟨ctor, ()⟩ none) arg + /- Translate Laurel HighType to Core Type -/ @@ -92,9 +136,20 @@ partial def translateType (ty : HighTypeMd) : TranslateM LMonoTy := do match model.get? name with | some (.datatypeDefinition dt) => return .tcons dt.name.text [] | some (.datatypeConstructor typeName _) => return .tcons typeName.text [] - | _ => do -- resolution should have already emitted a diagnostic - emitCoreDiagnostic (diagnosticFromSource ty.source s!"UserDefined type could not be resolved to a composite or datatype" DiagnosticType.StrataBug) - return .tcons "Composite" [] + | _ => + if name.text == baseExceptionTypeName then + -- E7: the `catch`/`onThrow` binding is typed at the exception-channel + -- root `BaseException`. Unlike an ordinary `var e: BaseException` — whose + -- AST type node heap parameterization rewrites to `Composite` — the + -- binding carries no rewritable type node, and after heap + -- parameterization `BaseException` no longer resolves. The value is a + -- heap `Composite` reference, so lower it as such. (The try lowering also + -- substitutes this binding's fvar with `$exc`, so only the Core type + -- needs to be well-formed here.) + return .tcons "Composite" [] + else do -- resolution should have already emitted a diagnostic + emitCoreDiagnostic (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 -- Generic type application, e.g. `Option` → Core `.tcons "Option" [int]`. @@ -428,7 +483,12 @@ private def buildCallArgs (calleeId : Identifier) (coreArgs : List Core.Expressi Translate Laurel StmtExpr to Core Statements using the `TranslateM` monad. Diagnostics are emitted into the monad state. -/ -def translateStmt (stmt : StmtExprMd) +-- `partial`: `translateStmt` recurses into nested statement lists (block +-- statements, `try` catch-clause bodies) and an optional `finally`, for which a +-- structural/well-founded termination proof is impractical (see the Laurel +-- design notes' rationale for `partial` AST-walking helpers). It always +-- terminates on finite ASTs; it is a translation function, not used in proofs. +partial def translateStmt (stmt : StmtExprMd) : TranslateM (List Core.Statement) := do let s ← get let model := s.model @@ -498,9 +558,52 @@ def translateStmt (stmt : StmtExprMd) let coreArgs ← args.mapM (fun a => translateExpr a) let (inits, lhs) ← initTargetsNondet let (callArgs, _, calleeInoutNames) ← buildCallArgs calleeId coreArgs md - let outArgs : List (Core.CallArg Core.Expression) := - lhs.filter (fun id => !calleeInoutNames.contains id.name) |>.map .outArg - return inits ++ [Core.Statement.call calleeId.text (callArgs ++ outArgs) md] + -- Value (non-inout) targets receive the callee's genuine outputs. + let valueLhs := lhs.filter (fun id => !calleeInoutNames.contains id.name) + let outArgs : List (Core.CallArg Core.Expression) := valueLhs.map .outArg + let calleeProc? : Option Procedure := match model.get calleeId with + | .staticProcedure p => some p + | .instanceProcedure _ p => some p + | _ => none + match calleeProc? with + | some p => + if p.throwsType.isSome then + -- E7: a call to a procedure declaring `throws` returns a + -- `Result`. Bind it to a temp; if `Bad`, put the + -- error in flight and exit to the nearest `try` (or the body, to + -- escape); if `Good`, unwrap the value into the target. + let st ← get + if st.tryLabelStack.isEmpty && !st.currentProcThrows then + throwStmtDiagnostic $ md.toDiagnostic + s!"a call to throwing procedure '{calleeId.text}' whose exception could escape a procedure that does not declare `throws` is not yet supported (E4 no-escape enforcement)" + DiagnosticType.NotYetImplemented + else + modify fun s => { s with currentProcUsedExc := true } + let inNames := p.inputs.map (·.name) + let calleeValTy ← match p.outputs.filter (fun o => !inNames.contains o.name) with + | [o] => translateType o.type + | _ => pure LMonoTy.bool + let resTy : LMonoTy := .tcons resultDatatypeName [calleeValTy, exceptionCoreTy] + let tid ← freshId + let tmpId : Core.CoreIdent := ⟨s!"$callres_{tid}", ()⟩ + let tmpExpr : Core.Expression.Expr := .fvar () tmpId (some resTy) + let tmpInit := Core.Statement.init tmpId (LTy.forAll [] resTy) .nondet md + let callStmt := Core.Statement.call calleeId.text (callArgs ++ [.outArg tmpId]) md + let target := st.tryLabelStack.head?.getD bodyLabel + let badBranch : List Core.Statement := + [ Core.Statement.set ⟨excVarName, ()⟩ (mkExceptionCtorApp "Result..err" tmpExpr) md, + Core.Statement.set ⟨thrownVarName, ()⟩ (.const () (.boolConst true)) md, + Imperative.Stmt.exit target md ] + let goodBranch : List Core.Statement := match valueLhs with + | [vid] => [ Core.Statement.set vid (mkExceptionCtorApp "Result..value" tmpExpr) md ] + | _ => [] + let dispatch := Imperative.Stmt.ite (.det (mkExceptionCtorApp "Result..isBad" tmpExpr)) + badBranch goodBranch md + return inits ++ [tmpInit, callStmt, dispatch] + else + return inits ++ [Core.Statement.call calleeId.text (callArgs ++ outArgs) md] + | none => + return inits ++ [Core.Statement.call calleeId.text (callArgs ++ outArgs) md] -- Match on the value to decide how to translate match _hv : value.val with | .StaticCall callee args => @@ -590,27 +693,73 @@ def translateStmt (stmt : StmtExprMd) -- Hole in statement position: treat as havoc (no-op). -- This can occur when an unmodeled call's Block is flattened. return [] - | .Throw _ => - -- Full `throw` lowering targets a generic `Result` (E7), which - -- Laurel cannot express until it has generic datatypes. Until then, emit a - -- diagnostic rather than silently mis-lowering via the wildcard below. - throwStmtDiagnostic $ md.toDiagnostic - "throw is not yet supported (requires generic Result lowering, E7)" - DiagnosticType.NotYetImplemented - | .Try _ _ _ => - -- `try`/`catch`/`finally` lowering (E3/E5) builds on the same `Result` - -- lowering as `throw` (E7), so it is likewise blocked on generic datatypes. - throwStmtDiagnostic $ md.toDiagnostic - "try/catch is not yet supported (requires generic Result lowering, E7)" - DiagnosticType.NotYetImplemented + | .Throw value => + -- E7: put the thrown value in flight (`$exc`), mark `$thrown`, and exit to + -- the nearest enclosing `try` label — or `bodyLabel` to escape the + -- procedure, where `translateProcedure` constructs `Bad($exc)`. + let st ← get + if st.tryLabelStack.isEmpty && !st.currentProcThrows then + -- A `throw` with no enclosing `try` that would escape a procedure not + -- declaring `throws` is the E4 no-escape violation; enforcement (and + -- lowering of the escape) lands with E7's contract check. + throwStmtDiagnostic $ md.toDiagnostic + "`throw` in a procedure that does not declare `throws` is not yet supported (E4 no-escape enforcement)" + DiagnosticType.NotYetImplemented + else + modify fun s => { s with currentProcUsedExc := true } + let ve ← translateExpr value + let target := st.tryLabelStack.head?.getD bodyLabel + return [ Core.Statement.set ⟨excVarName, ()⟩ ve md, + Core.Statement.set ⟨thrownVarName, ()⟩ (.const () (.boolConst true)) md, + Imperative.Stmt.exit target md ] + | .Try body catches finally? => + -- E7 (E3/E5): lower `try B catch eᵢ when Pᵢ { Hᵢ } … finally { F }` using + -- the existing `Block`/`Exit` control flow. `B` runs inside a labeled + -- block; a `throw` in `B` exits to that label (leaving `$thrown`/`$exc` + -- set). After the block, a first-match-wins chain of guarded handlers runs + -- (each guard is `$thrown && Pᵢ`; a matching handler clears `$thrown` + -- before running). An unmatched exception leaves `$thrown` set so it + -- propagates outward. `finally` runs on the fall-through edge. + -- + -- The catch binding is bound to the in-flight value by substituting `$exc` + -- for it in each predicate/handler (rather than declaring a local), which + -- also sidesteps clauses that reuse the same binding name. + -- + -- NOTE: `return`/`exit` inside `B` with a pending `finally` (F18 masking) + -- is not yet modeled — `finally` is only placed on the fall-through edge. + modify fun s => { s with currentProcUsedExc := true } + let savedStack := (← get).tryLabelStack + let tryId ← freshId + let tryLbl := s!"$try_{tryId}" + modify fun s => { s with tryLabelStack := tryLbl :: savedStack } + let bStmts ← translateStmt body + -- Restore the stack before handlers/finally, so a re-throw there targets + -- the *enclosing* try (or the body), not this same try. + modify fun s => { s with tryLabelStack := savedStack } + let excFvar : Core.Expression.Expr := .fvar () ⟨excVarName, ()⟩ (some exceptionCoreTy) + let thrownFvar : Core.Expression.Expr := .fvar () ⟨thrownVarName, ()⟩ (some LMonoTy.bool) + let clauses ← catches.mapM (fun c => do + let pExpr ← match c.predicate with + | some p => + let pe ← translateExpr p + pure (LExpr.substFvar pe ⟨c.binding.text, ()⟩ excFvar) + | none => pure (.const () (.boolConst true)) + let hStmts ← translateStmt c.body + let hStmts := hStmts.map (fun s => Core.Statement.substFvar s ⟨c.binding.text, ()⟩ excFvar) + let guard := LExpr.mkApp () boolAndOp [thrownFvar, pExpr] + let handler := Core.Statement.set ⟨thrownVarName, ()⟩ (.const () (.boolConst false)) md :: hStmts + pure (guard, handler)) + let catchChain : List Core.Statement := + clauses.foldr + (fun gh elseB => [Imperative.Stmt.ite (.det gh.1) gh.2 elseB md]) + [] + let fStmts ← match finally? with + | some f => translateStmt f + | none => pure [] + return Imperative.Stmt.block tryLbl bStmts md :: (catchChain ++ fStmts) | _ => -- Expression in statement position: preserve as an unused variable init exprAsUnusedInit stmt md - termination_by sizeOf stmt - decreasing_by - all_goals - have hlt := AstNode.sizeOf_val_lt stmt - cases stmt; term_by_mem /-- Translate a list of checks (preconditions or postconditions) to Core checks. @@ -637,6 +786,65 @@ def translateParameterToCore (param : Parameter) : TranslateM (Core.CoreIdent × let ty ← translateType param.type return (ident, ty) +/-- +E7: assemble a procedure's Core outputs and body statements. + +For a non-throwing procedure this is the usual single labeled body block. For a +throwing procedure (one declaring `throws`) the procedure instead returns a +single `Result` output: the normal output becomes an internal +local (assigned by return-elimination), `$thrown`/`$exc` track the in-flight +exception, and after the body block the result is constructed — `Bad($exc)` if +an exception is in flight, otherwise `Good(val)`. +-/ +private def buildProcedureOutputsAndBody + (proc : Procedure) (procThrows : Bool) (bodyStmts : List Core.Statement) + : TranslateM (List (Core.CoreIdent × LMonoTy) × List Core.Statement) := do + let bodyBlock : Core.Statement := .block bodyLabel bodyStmts mdWithUnknownLoc + -- The `$thrown`/`$exc` locals are needed whenever the body uses the exceptional + -- channel: a throwing procedure always does, and a non-throwing one does if it + -- lowered a `throw`/`try` (recorded in `currentProcUsedExc`). + let usedExc := (← get).currentProcUsedExc + let excStateInit : List Core.Statement := + if procThrows || usedExc then + [ Core.Statement.init ⟨thrownVarName, ()⟩ (LTy.forAll [] LMonoTy.bool) + (.det (.const () (.boolConst false))) mdWithUnknownLoc, + Core.Statement.init ⟨excVarName, ()⟩ (LTy.forAll [] exceptionCoreTy) + .nondet mdWithUnknownLoc ] + else [] + if !procThrows then + let outputs ← proc.outputs.mapM translateParameterToCore + return (outputs, excStateInit ++ [bodyBlock]) + -- Throwing procedure: return a single `Result`, but keep any + -- inout outputs (a parameter appearing in both inputs and outputs — notably + -- the heap `$heap` added by heap parameterization, needed by the two-state + -- `old($heap)` postcondition). Only the genuine *value* return is folded into + -- the `Result`. + let inputNames := proc.inputs.map (·.name) + let inoutOutputs := proc.outputs.filter (fun o => inputNames.contains o.name) + let valueOutputs := proc.outputs.filter (fun o => !inputNames.contains o.name) + let coreInoutOutputs ← inoutOutputs.mapM translateParameterToCore + let valTy ← match valueOutputs with + | [outParam] => translateType outParam.type + | _ => pure LMonoTy.bool -- no value output (void): unit placeholder, matching TVoid + let resultTy : LMonoTy := .tcons resultDatatypeName [valTy, exceptionCoreTy] + let resultIdent : Core.CoreIdent := ⟨resultVarName, ()⟩ + let excIdent : Core.CoreIdent := ⟨excVarName, ()⟩ + -- The value output becomes a local the body assigns via return-elimination; + -- capture it to wrap in `Good` on the normal path (unit placeholder if none). + let (origOutInit, goodArg) ← + match valueOutputs with + | [outParam] => + let outIdent : Core.CoreIdent := ⟨outParam.name.text, ()⟩ + pure (([Core.Statement.init outIdent (LTy.forAll [] valTy) .nondet mdWithUnknownLoc] : List Core.Statement), + ((.fvar () outIdent (some valTy)) : Core.Expression.Expr)) + | _ => pure (([] : List Core.Statement), ((.const () (.boolConst true)) : Core.Expression.Expr)) + let construct : Core.Statement := + Imperative.Stmt.ite (.det (.fvar () ⟨thrownVarName, ()⟩ (some LMonoTy.bool))) + [ Core.Statement.set resultIdent (mkExceptionCtorApp "Bad" (.fvar () excIdent (some exceptionCoreTy))) mdWithUnknownLoc ] + [ Core.Statement.set resultIdent (mkExceptionCtorApp "Good" goodArg) mdWithUnknownLoc ] + mdWithUnknownLoc + return (coreInoutOutputs ++ [(resultIdent, resultTy)], excStateInit ++ origOutInit ++ [bodyBlock, construct]) + /-- Translate Laurel Procedure to Core Procedure using `TranslateM`. Diagnostics from disallowed constructs in preconditions, postconditions, and body @@ -644,17 +852,17 @@ are emitted into the monad state. -/ def translateProcedure (proc : Procedure) : TranslateM Core.Procedure := do -- Track inout parameter names for the `.Old (Var (Local n))` defensive check. - -- Reset to [] after the procedure so siblings start fresh. - modify fun s => { s with currentProcInouts := procInoutNames proc } - let inputPairs ← proc.inputs.mapM translateParameterToCore - let inputs := inputPairs - let outputs ← proc.outputs.mapM translateParameterToCore - let header : Core.Procedure.Header := { - name := proc.name.text - typeArgs := [] - inputs := inputs - outputs := outputs - } + -- `currentProcThrows` (E7) records whether this procedure declares `throws`, + -- so `throw` in its body lowers to `$thrown`/`$exc` + exit; the try-label + -- stack is reset per procedure. All are set fresh here (implicitly resetting + -- any leftover state from a sibling procedure). + let procThrows := proc.throwsType.isSome + modify fun s => { s with + currentProcInouts := procInoutNames proc + currentProcThrows := procThrows + currentProcUsedExc := false + tryLabelStack := [] } + let inputs ← proc.inputs.mapM translateParameterToCore -- Translate preconditions let preconditions ← translateChecks proc.preconditions "requires" false @@ -677,9 +885,16 @@ def translateProcedure (proc : Procedure) : TranslateM Core.Procedure := do | .Opaque postconds _ _ | .Abstract postconds => translateChecks postconds s!"postcondition" bodyStmts.isNone | _ => pure [] - -- Wrap body in a labeled block so early returns (exit) work correctly. - -- `bodyLabel` is the shared "$body" constant the resolver pre-registers. - let body : List Core.Statement := [.block bodyLabel (bodyStmts.getD []) mdWithUnknownLoc] + -- Assemble outputs + body: a labeled block so early returns (exit) work, plus + -- the `Result` wrapping for throwing procedures (E7). `bodyLabel` is the + -- shared "$body" constant the resolver pre-registers. + let (outputs, body) ← buildProcedureOutputsAndBody proc procThrows (bodyStmts.getD []) + let header : Core.Procedure.Header := { + name := proc.name.text + typeArgs := [] + inputs := inputs + outputs := outputs + } let spec : Core.Procedure.Spec := { preconditions, postconditions } return { header, spec, body := .structured body } diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ExceptionScenarios.lean b/StrataTest/Languages/Laurel/Examples/Objects/ExceptionScenarios.lean index 80d4e06f8b..8ebdf66ec6 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/ExceptionScenarios.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/ExceptionScenarios.lean @@ -16,8 +16,8 @@ hierarchy, `throw`, predicate-based `try`/`catch`/`finally`, and the `throws`/`onThrow` procedure contract. Two observable behaviors are pinned down here: - * well-formed `throw` / `try` constructs parse, resolve, and type-check, then - reach the `not-yet-implemented` Core lowering (E7, blocked on generics); + * well-formed `throw` (in a procedure declaring `throws`) and `try` / `catch` / + `finally` constructs lower to Core (E7) and verify; * well-formed `throws`/`onThrow` contracts are recorded, ignored at translation, and so verify cleanly (no diagnostics); * ill-typed constructs are rejected during resolution. @@ -36,7 +36,6 @@ composite ParseError extends BaseException {} composite ArithError extends BaseException {} procedure multipleCatches() opaque { try { -//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) assert true } catch e when e is ParseError { assert true @@ -54,7 +53,6 @@ composite ParseError extends BaseException {} composite ArithError extends BaseException {} procedure unionCatch() opaque { try { -//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) assert true } catch e when e is ParseError || e is ArithError { assert true @@ -68,7 +66,6 @@ procedure unionCatch() opaque { program Laurel; procedure catchAll() opaque { try { -//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) assert true } catch e { assert true @@ -82,7 +79,6 @@ procedure catchAll() opaque { program Laurel; procedure tryFinally() opaque { try { -//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) assert true } finally { assert true @@ -97,7 +93,6 @@ program Laurel; composite ParseError extends BaseException {} procedure nestedTry() opaque { try { -//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) try { assert true } catch inner { @@ -111,15 +106,16 @@ procedure nestedTry() opaque { /-! ## Throwing (E1/E2) -/ --- Throw a value of a declared subtype of BaseException. +-- Throw a value of a declared subtype of BaseException. The procedure declares +-- `throws`, so this lowers to a `Result`-returning Core procedure (E7) and +-- verifies (no proof obligations). #eval testLaurel <| #strata program Laurel; composite ParseError extends BaseException {} -procedure throwsSubtype() opaque { +procedure throwsSubtype() throws BaseException opaque { var e: ParseError := new ParseError; throw e -//^^^^^^^ not-yet-implemented: throw is not yet supported (requires generic Result lowering, E7) }; #end diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean b/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean index da4dffcd1b..8e32e7b0c2 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean @@ -14,11 +14,12 @@ Exercises the E2 `throw` statement (see `docs/design/laurel_extensions.md`, extension E2). `throw`'s operand is typed at the prelude root `BaseException` (E1); any declared subtype is accepted. -Full lowering to Core targets a generic `Result` (E7), which Laurel -cannot express until it gains generic datatypes, so a well-typed `throw` -currently reaches translation and reports `not-yet-implemented` there. These -tests pin down the front half of the pipeline: parsing, resolution, and the -`BaseException` type rule. +E7 lowering: a `throw` in a procedure that declares `throws` lowers to a +`Result`-returning Core procedure — an in-flight exception sets +the synthesized `$thrown`/`$exc` locals and exits, and the procedure's result is +constructed as `Bad(exc)`. A `throw` whose exception would escape a procedure +that does *not* declare `throws` is the E4 no-escape case, which is not yet +enforced/lowered. -/ -- Ill-typed: the operand is an `int`, not a `BaseException`. The type error is @@ -35,17 +36,33 @@ procedure throwsNonException() }; #end --- Well-typed: the operand is a `BaseException`. Parsing, resolution, and the --- `BaseException` type rule all succeed; only the Core lowering is missing (E7). +-- Well-typed and declared `throws`: lowers to a `Result`-returning procedure +-- (E7) and verifies — there are no proof obligations to discharge. #eval testLaurel <| #strata program Laurel; procedure throwsException() + throws BaseException opaque { var e: BaseException := new BaseException; throw e -//^^^^^^^ not-yet-implemented: throw is not yet supported (requires generic Result lowering, E7) +}; +#end + +-- A `throw` whose exception would escape a procedure that does not declare +-- `throws` is the E4 no-escape case: reported as not-yet-implemented pending +-- contract enforcement, rather than silently dropping the escape. +#eval testLaurel <| +#strata +program Laurel; + +procedure throwsWithoutDeclaring() + opaque +{ + var e: BaseException := new BaseException; + throw e +//^^^^^^^ not-yet-implemented: `throw` in a procedure that does not declare `throws` is not yet supported (E4 no-escape enforcement) }; #end diff --git a/StrataTest/Languages/Laurel/Examples/Objects/TryCatch.lean b/StrataTest/Languages/Laurel/Examples/Objects/TryCatch.lean index ae6cde38a1..bf174d5b66 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/TryCatch.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/TryCatch.lean @@ -15,15 +15,14 @@ Exercises the E3/E5 structured handler: `try` / predicate-based `catch` / `catch` binds the caught value (typed at the channel root `BaseException`, E1) and may carry a `when` guard (checked at `bool`). -Like `throw` (E2), full lowering to Core targets a generic `Result` -(E7), which Laurel cannot express until it gains generic datatypes. So a -well-typed `try` reaches translation and reports `not-yet-implemented` there. -These tests pin down the front half: parsing, resolution, catch-binding -scoping, and guard type-checking. +`try`/`catch`/`finally` now lowers to Core (E7): the body runs in a labeled +block, a `throw` exits to it, a first-match-wins chain of guarded handlers runs +after it, and `finally` runs on the fall-through edge. These well-typed cases +lower and verify; the negative case is rejected during resolution. -/ --- Well-typed try / catch / finally: parses, resolves, type-checks; only the --- Core lowering is missing (E7). +-- Well-typed try / catch / finally: parses, resolves, type-checks, lowers, and +-- verifies (the bodies have no proof obligations that fail). #eval testLaurel <| #strata program Laurel; @@ -32,7 +31,6 @@ procedure tryCatchFinally() opaque { try { -//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) assert true } catch e { assert true @@ -51,7 +49,6 @@ procedure tryWithGuard() opaque { try { -//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) assert true } catch e when true { assert true diff --git a/StrataTest/Languages/Laurel/Examples/Objects/TryHeapCalls.lean b/StrataTest/Languages/Laurel/Examples/Objects/TryHeapCalls.lean index 75839cb43e..6ec5332b87 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/TryHeapCalls.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/TryHeapCalls.lean @@ -17,13 +17,13 @@ body were not counted toward heap classification and did not get `$heap` threaded, so a caller invoking a heap-using procedure inside a `try` failed re-resolution with an internal `strata-bug` (`expected 'Heap', got 'int'`). -Now such programs parse, resolve, heap-parameterize, and re-resolve cleanly, -reaching the expected `not-yet-implemented` lowering (E7) instead. +Now such programs parse, resolve, heap-parameterize, re-resolve, lower (E7), and +verify cleanly (no `strata-bug`). -/ -- Minimal: a heap-using callee (`alloc` allocates, so it is a heap writer) is --- invoked inside a `try` body. This must reach the `try/catch` NYI lowering --- without any prior `strata-bug`. +-- invoked inside a `try` body. This lowers and verifies without any prior +-- `strata-bug`. #eval testLaurel <| #strata program Laurel; @@ -34,7 +34,6 @@ procedure alloc() returns (r: int) opaque { }; procedure computeViaTry() returns (r: int) opaque { try { -//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) r := alloc() } catch e { r := 0 @@ -43,7 +42,10 @@ procedure computeViaTry() returns (r: int) opaque { #end -- Realistic: multiple heap-using, throwing callees invoked inside a --- multi-catch `try`. Reaches the throw/try NYIs (no strata-bug). +-- multi-catch `try`. The throwing callees lower to `Result`-returning +-- procedures (E7), and the calls inside the `try` bind and unwrap those results +-- (propagating `Bad` to the matching catch); the whole program verifies with no +-- strata-bug. #eval testLaurel <| #strata program Laurel; @@ -53,7 +55,6 @@ procedure parsePositive(s: int) returns (r: int) throws ParseError opaque { if s < 0 then { var pe: ParseError := new ParseError; throw pe -// ^^^^^^^^ not-yet-implemented: throw is not yet supported (requires generic Result lowering, E7) }; r := s }; @@ -61,13 +62,11 @@ procedure safeDivide(a: int, b: int) returns (r: int) throws ArithError opaque { if b == 0 then { var ae: ArithError := new ArithError; throw ae -// ^^^^^^^^ not-yet-implemented: throw is not yet supported (requires generic Result lowering, E7) }; r := a / b }; procedure compute(s: int) returns (r: int) opaque { try { -//^ not-yet-implemented: try/catch is not yet supported (requires generic Result lowering, E7) var n: int := parsePositive(s); r := safeDivide(100, n) } catch e when e is ParseError { From 299870b6d057a95d4b49f634b5729b1963abb2dd Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Mon, 6 Jul 2026 15:19:52 +0000 Subject: [PATCH 09/28] feat(laurel): enforce exception contracts (E4) Add a static "check, don't trust" escape analysis in resolution that enforces the two invariants the design assigns to Laurel: - No-escape: a procedure that declares no `throws` may not let any exception escape, whether thrown directly or propagated from a callee. - Upper-bound: a procedure declaring `throws T` may only let exceptions whose type is a subtype of T escape. Analysis (Resolution.lean): - exceptionEscapes over-approximates the exception types (with source locations) that can leave a statement uncaught: a `throw` contributes its operand type (only when it is a BaseException subtype, so an ill-typed throw is not double-reported), a call to a `throws T` procedure contributes T, and a `try` removes a body type only when some `catch` clause provably handles it (a catch-all, or an `x is T` guard / disjunction thereof with the type a subtype of T). Any other guard catches nothing, keeping the analysis sound. - checkProcedureThrows turns escaping types into no-escape or subtype upper-bound diagnostics per procedure. - Wired into resolve alongside the diamond-field check, gated on the initial resolution (existingModel = none), where throw operands still carry their declared types and `is`-guards are not yet lowered. Java-style declare-or-catch at call sites remains front-end policy and is not enforced here. Tests: - ThrowStatement: `throwsWithoutDeclaring` now fails at resolution with the no-escape error instead of the translation-time NYI stub. - ThrowsContract: header updated; add upper-bound violation, call-based no-escape, coarsened-throws-allowed, and caught-so-no-escape cases. --- Strata/Languages/Laurel/Resolution.lean | 120 +++++++++++++++++- .../Examples/Objects/ThrowStatement.lean | 11 +- .../Examples/Objects/ThrowsContract.lean | 93 +++++++++++++- 3 files changed, 211 insertions(+), 13 deletions(-) diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index baec252e74..ba492abd62 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -3283,6 +3283,117 @@ private def preRegisterTopLevel (program : Program) : ResolveM Unit := do for proc in program.staticProcedures do let _ ← defineNameCheckDup proc.name (.staticProcedure proc) +/-! ## E4 exception-escape enforcement + +Static "check, don't trust" analysis (the design's E4 enforcement): a procedure +that does not declare `throws` must not let any exception escape, and one that +declares `throws T` must only let exceptions whose type is a subtype of `T` +escape. + +`exceptionEscapes` over-approximates the set of exception types that can leave a +statement uncaught. A `try` removes a body type only when some `catch` clause +*provably* handles it — a catch-all, or an `x is T` guard (or a disjunction of +such guards) with the type a subtype of `T`. Any other guard is treated as +catching nothing, so the analysis stays sound: it never claims an escape is +impossible when it might not be. It runs only on the initial resolution, where +`throw` operands still carry their declared types and `is`-guards have not yet +been lowered by `typeHierarchyTransform`. -/ + +/-- Whether `pred`, the guard of a `catch when pred`, provably holds + for every value of type `ty` — i.e. that clause definitely catches `ty`. -/ +partial def catchGuardCatches (lattice : TypeLattice) (binding : Identifier) + (pred : StmtExprMd) (ty : HighTypeMd) : Bool := + match pred.val with + | .LiteralBool true => true + | .IsType target guardTy => + match target.val with + | .Var (.Local n) => n.text == binding.text && isSubtype lattice ty guardTy + | _ => false + | .PrimitiveOp .Or [p1, p2] _ | .PrimitiveOp .OrElse [p1, p2] _ => + catchGuardCatches lattice binding p1 ty || catchGuardCatches lattice binding p2 ty + | _ => false + +/-- Whether a `catch` clause definitely catches every value of type `ty`. + An absent guard is a catch-all. -/ +def clauseCatches (lattice : TypeLattice) (c : CatchClause) (ty : HighTypeMd) : Bool := + match c.predicate with + | none => true + | some p => catchGuardCatches lattice c.binding p ty + +/-- Over-approximate the exception types (each with a source location) that can + escape `expr` uncaught. -/ +partial def exceptionEscapes (model : SemanticModel) (lattice : TypeLattice) + (expr : StmtExprMd) : List (HighTypeMd × Option FileRange) := + let calleeThrows (callee : Identifier) : List (HighTypeMd × Option FileRange) := + match model.get callee with + | .staticProcedure p | .instanceProcedure _ p => + match p.throwsType with + | some t => [(t, expr.source)] + | none => [] + | _ => [] + match expr.val with + | .Throw e => + -- Only count a `throw` whose operand is actually on the exceptional channel. + -- An operand that is not a `BaseException` subtype is already an + -- (independently reported) type error, so don't pile on an escape error. + let ty := computeExprType model e + if isSubtype lattice ty ⟨.UserDefined (mkId baseExceptionTypeName), none⟩ + then [(ty, expr.source)] else [] + | .StaticCall callee args => + calleeThrows callee ++ args.flatMap (exceptionEscapes model lattice) + | .InstanceCall target callee args => + calleeThrows callee ++ exceptionEscapes model lattice target + ++ args.flatMap (exceptionEscapes model lattice) + | .Try body catches finally? => + let bodyEsc := exceptionEscapes model lattice body + let uncaught := bodyEsc.filter (fun p => !catches.any (fun c => clauseCatches lattice c p.1)) + let handlersEsc := catches.flatMap (fun c => exceptionEscapes model lattice c.body) + let finallyEsc := match finally? with + | some f => exceptionEscapes model lattice f + | none => [] + uncaught ++ handlersEsc ++ finallyEsc + | .Block stmts _ => stmts.flatMap (exceptionEscapes model lattice) + | .IfThenElse c t e => + exceptionEscapes model lattice c ++ exceptionEscapes model lattice t + ++ (match e with | some eb => exceptionEscapes model lattice eb | none => []) + | .While c _ _ b => + exceptionEscapes model lattice c ++ exceptionEscapes model lattice b + | .Assign _ value => exceptionEscapes model lattice value + | .Return (some v) => exceptionEscapes model lattice v + | .PrimitiveOp _ args _ => args.flatMap (exceptionEscapes model lattice) + | .ProveBy v pf => exceptionEscapes model lattice v ++ exceptionEscapes model lattice pf + | _ => [] + +/-- Check one procedure's body against its `throws` declaration (E4): + no-escape when nothing is declared, subtype upper-bound when `throws T` is. -/ +def checkProcedureThrows (model : SemanticModel) (lattice : TypeLattice) + (proc : Procedure) : List DiagnosticModel := + let body? := match proc.body with + | .Transparent b => some b + | .Opaque _ (some impl) _ => some impl + | _ => none + match body? with + | none => [] + | some body => + let escs := exceptionEscapes model lattice body + match proc.throwsType with + | none => + escs.map (fun (ty, src) => + diagnosticFromSource src + s!"procedure '{proc.name.text}' may let an exception of type '{formatType ty}' escape, but does not declare a `throws` clause" + DiagnosticType.UserError) + | some declared => + escs.filterMap (fun (ty, src) => + if isSubtype lattice ty declared then none + else some (diagnosticFromSource src + s!"procedure '{proc.name.text}' may throw '{formatType ty}', which is not a subtype of its declared `throws` type '{formatType declared}'" + DiagnosticType.UserError)) + +/-- Validate the whole program's exception contracts (E4 enforcement). -/ +def validateExceptionEscapes (model : SemanticModel) (lattice : TypeLattice) + (program : Program) : List DiagnosticModel := + program.staticProcedures.flatMap (checkProcedureThrows model lattice) + /-! ## Entry point -/ /-- Run the full resolution pass on a Laurel program. -/ @@ -3307,9 +3418,16 @@ public def resolve (program : Program) (existingModel: Option SemanticModel := n nextId := finalState.nextId } let diamondErrors := validateDiamondFieldAccesses semanticModel program' + -- E4 exception-contract enforcement runs only on the initial resolution, when + -- `throw` operands still carry their declared (pre-heap-parameterization) + -- types and `is`-guards are un-lowered. Re-resolutions (existingModel = some) + -- see `Composite`-typed operands and would misjudge the subtype checks. + let escapeErrors := + if existingModel.isNone then validateExceptionEscapes semanticModel typeLattice program' + else [] { program := program', model := semanticModel, - errors := finalState.errors ++ diamondErrors + errors := finalState.errors ++ diamondErrors ++ escapeErrors } /-! ## Resolution for UnorderedCoreWithLaurelTypes -/ diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean b/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean index 8e32e7b0c2..7c65b584ef 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean @@ -18,8 +18,8 @@ E7 lowering: a `throw` in a procedure that declares `throws` lowers to a `Result`-returning Core procedure — an in-flight exception sets the synthesized `$thrown`/`$exc` locals and exits, and the procedure's result is constructed as `Bad(exc)`. A `throw` whose exception would escape a procedure -that does *not* declare `throws` is the E4 no-escape case, which is not yet -enforced/lowered. +that does *not* declare `throws` is the E4 no-escape case, now rejected during +resolution (E4 enforcement). -/ -- Ill-typed: the operand is an `int`, not a `BaseException`. The type error is @@ -51,9 +51,8 @@ procedure throwsException() }; #end --- A `throw` whose exception would escape a procedure that does not declare --- `throws` is the E4 no-escape case: reported as not-yet-implemented pending --- contract enforcement, rather than silently dropping the escape. +-- E4 no-escape enforcement: a `throw` whose exception would escape a procedure +-- that does not declare `throws` is rejected during resolution. #eval testLaurel <| #strata program Laurel; @@ -63,6 +62,6 @@ procedure throwsWithoutDeclaring() { var e: BaseException := new BaseException; throw e -//^^^^^^^ not-yet-implemented: `throw` in a procedure that does not declare `throws` is not yet supported (E4 no-escape enforcement) +//^^^^^^^ error: procedure 'throwsWithoutDeclaring' may let an exception of type 'BaseException' escape, but does not declare a `throws` clause }; #end diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean b/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean index 7fbf290fc4..c5675e53f8 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean @@ -12,12 +12,15 @@ open Strata /- Exercises the E4 procedure exceptional contract: an optional `throws` type and `onThrow` exceptional postconditions (see `docs/design/laurel_extensions.md`, -extension E4). Laurel *records* these and resolves/type-checks them — the -`throws` type must be a subtype of the channel root `BaseException`, and each -`onThrow` predicate is checked at `bool` with its binding typed `BaseException`. -Laurel performs no declare-or-catch enforcement (that is front-end policy), and -the contract is not yet consumed by lowering (E7), so a well-formed contract -verifies cleanly (it is ignored during translation). +extension E4). The `throws` type must be a subtype of the channel root +`BaseException`, and each `onThrow` predicate is checked at `bool` with its +binding typed `BaseException`. + +E4 enforcement (the "check, don't trust" analysis): a procedure may only let an +exception escape whose type is a subtype of its declared `throws` type, and a +procedure that declares no `throws` may not let any exception escape (whether +thrown directly or propagated from a callee). Java-style declare-or-catch at +call sites remains front-end policy. -/ -- Valid: `throws` a BaseException subtype. Recorded and ignored at translation, @@ -79,3 +82,81 @@ procedure badOnThrow() assert true }; #end + +/-! ## E4 enforcement: no-escape and the throws upper-bound -/ + +-- Upper-bound violation: declares `throws ArithError` but throws a sibling +-- `ParseError`, which is not a subtype of the declared type. +#eval testLaurel <| +#strata +program Laurel; +composite ArithError extends BaseException {} +composite ParseError extends BaseException {} +procedure wrongThrows() + throws ArithError + opaque +{ + var e: ParseError := new ParseError; + throw e +//^^^^^^^ error: procedure 'wrongThrows' may throw 'ParseError', which is not a subtype of its declared `throws` type 'ArithError' +}; +#end + +-- No-escape via a propagated call: `callsThrower` invokes a throwing procedure +-- without catching it and without declaring `throws` itself. +#eval testLaurel <| +#strata +program Laurel; +procedure thrower() + returns (r: int) + throws BaseException + opaque +{ + var e: BaseException := new BaseException; + throw e +}; +procedure callsThrower() + returns (r: int) + opaque +{ + r := thrower() +// ^^^^^^^^^ error: procedure 'callsThrower' may let an exception of type 'BaseException' escape, but does not declare a `throws` clause +}; +#end + +-- Allowed: the declared `throws` type is a supertype of what is thrown, so the +-- coarsened contract holds (this is how a Java `throws Exception` covering a +-- more specific throw is represented). +#eval testLaurel <| +#strata +program Laurel; +composite ParseError extends BaseException {} +procedure coarsenedThrows() + throws BaseException + opaque +{ + var e: ParseError := new ParseError; + throw e +}; +#end + +-- Allowed (no-escape via catch): `handled` throws inside a `try` whose `catch` +-- handles the thrown type, so nothing escapes and no `throws` declaration is +-- required. Must produce no diagnostics. +#eval testLaurel <| +#strata +program Laurel; +composite ParseError extends BaseException {} +procedure handled() + returns (r: int) + opaque +{ + var e: ParseError := new ParseError; + try { + throw e + } catch c when c is ParseError { + r := -1 + }; + r := 0 +}; +#end From e54be518ecb38ebf023c405892387b73ae09b06c Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Tue, 7 Jul 2026 12:50:48 +0000 Subject: [PATCH 10/28] fix(laurel): clearer no-escape diagnostic (E4) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The no-escape error now names both remedies — catch the exception or declare a `throws` clause — matching Java's "must be caught or declared to be thrown". Updates the two annotations that pin the message. --- Strata/Languages/Laurel/Resolution.lean | 2 +- .../Languages/Laurel/Examples/Objects/ThrowStatement.lean | 2 +- .../Languages/Laurel/Examples/Objects/ThrowsContract.lean | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index ba492abd62..35dadf9592 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -3380,7 +3380,7 @@ def checkProcedureThrows (model : SemanticModel) (lattice : TypeLattice) | none => escs.map (fun (ty, src) => diagnosticFromSource src - s!"procedure '{proc.name.text}' may let an exception of type '{formatType ty}' escape, but does not declare a `throws` clause" + s!"procedure '{proc.name.text}' may let an exception of type '{formatType ty}' escape; catch it with a `try`/`catch` or declare a `throws` clause" DiagnosticType.UserError) | some declared => escs.filterMap (fun (ty, src) => diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean b/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean index 7c65b584ef..212ae734b2 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/ThrowStatement.lean @@ -62,6 +62,6 @@ procedure throwsWithoutDeclaring() { var e: BaseException := new BaseException; throw e -//^^^^^^^ error: procedure 'throwsWithoutDeclaring' may let an exception of type 'BaseException' escape, but does not declare a `throws` clause +//^^^^^^^ error: procedure 'throwsWithoutDeclaring' may let an exception of type 'BaseException' escape; catch it with a `try`/`catch` or declare a `throws` clause }; #end diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean b/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean index c5675e53f8..297b0a892f 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean @@ -120,7 +120,7 @@ procedure callsThrower() opaque { r := thrower() -// ^^^^^^^^^ error: procedure 'callsThrower' may let an exception of type 'BaseException' escape, but does not declare a `throws` clause +// ^^^^^^^^^ error: procedure 'callsThrower' may let an exception of type 'BaseException' escape; catch it with a `try`/`catch` or declare a `throws` clause }; #end From 80543ddf3362934442f2f2e490402b47bef68761 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Tue, 7 Jul 2026 12:50:48 +0000 Subject: [PATCH 11/28] test(laurel): behavioral E3/E5 try/catch/finally tests Add TryCatchBehavior.lean asserting observable outcomes of the lowered control flow, not just that the constructs lower/verify: - a caught throw skips the rest of the body and resumes after the handler - finally runs on both the normal and caught-exception paths - predicate dispatch skips a non-matching clause and takes the matching one - first-match-wins when guards overlap (parent clause before child clause) --- .../Examples/Objects/TryCatchBehavior.lean | 121 ++++++++++++++++++ 1 file changed, 121 insertions(+) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean diff --git a/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean b/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean new file mode 100644 index 0000000000..14c2e2bdb3 --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean @@ -0,0 +1,121 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Behavioral coverage of the E3/E5 handler semantics (see +`docs/design/laurel_extensions.md`, extensions E3 and E5). Unlike `TryCatch` / +`ExceptionScenarios` — which mostly pin parsing, typing, and that the construct +lowers — these tests assert *observable outcomes* of the lowered control flow: +a caught `throw` skips the rest of the body and resumes after the handler, +`finally` runs on every fall-through path, and predicate dispatch is +first-match-wins (including when guards overlap). + +Exceptions are constructed *before* the `try` (a `new` inside a `try` body hits +a known lifting-pass gap), and all throws are direct so the verifier knows each +value's runtime type and can discharge the `is`-guards precisely. +-/ + +-- A caught `throw` skips the rest of the try body; the handler runs and control +-- resumes after the `try`, so the handler's assignment is what is observed. The +-- guard `c is MyError` is satisfied by the thrown value, so the clause fires. +#eval testLaurel <| +#strata +program Laurel; +composite MyError extends BaseException {} +procedure caughtResumes() + returns (r: int) + opaque +{ + var e: MyError := new MyError; + r := 0; + try { + throw e; + r := 1 + } catch c when c is MyError { + r := 2 + }; + assert r == 2 +}; +#end + +-- `finally` runs on both the normal (no-throw) and the caught-exception paths. +-- `doThrow` is a symbolic input, so the verifier checks both. +#eval testLaurel <| +#strata +program Laurel; +procedure finallyAlwaysRuns(doThrow: bool) + returns (r: int) + opaque +{ + var e: BaseException := new BaseException; + var ran: int := 0; + try { + if doThrow then { + throw e + }; + r := 1 + } catch c { + r := 2 + } finally { + ran := 99 + }; + assert ran == 99 +}; +#end + +-- Predicate dispatch skips a non-matching earlier clause and takes the matching +-- later one: an `ErrorB` value is not caught by `is ErrorA` but is by `is ErrorB`. +#eval testLaurel <| +#strata +program Laurel; +composite ErrorA extends BaseException {} +composite ErrorB extends BaseException {} +procedure dispatchSkipsNonMatching() + returns (r: int) + opaque +{ + var b: ErrorB := new ErrorB; + r := 0; + try { + throw b + } catch c when c is ErrorA { + r := 1 + } catch c when c is ErrorB { + r := 2 + }; + assert r == 2 +}; +#end + +-- First-match-wins with overlapping guards: a `ChildError` matches both the +-- earlier `is ParentError` clause and the later `is ChildError` clause; the +-- earlier one wins (r == 1, not 2). +#eval testLaurel <| +#strata +program Laurel; +composite ParentError extends BaseException {} +composite ChildError extends ParentError {} +procedure firstMatchWinsOnOverlap() + returns (r: int) + opaque +{ + var ce: ChildError := new ChildError; + r := 0; + try { + throw ce + } catch c when c is ParentError { + r := 1 + } catch c when c is ChildError { + r := 2 + }; + assert r == 1 +}; +#end From 9259e15e4bec5351741e49659fb61c3e5a84a708 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Tue, 7 Jul 2026 13:01:24 +0000 Subject: [PATCH 12/28] fix(laurel): lift expressions inside try/catch/finally and throw MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit LiftImperativeExpressions.transformStmt skipped Try/Throw via its wildcard, so assignments and imperative calls inside a try region — notably the heap operations a lowered `new` expands to — were not lifted out of expression position and hit a strata-bug ("destructive assignments ... should have been lifted") at Core translation. Add Throw and Try arms that recurse into the thrown operand, the try body, each handler body, and the finally arm. Catch guards are left as-is (post-typeHierarchyTransform they are pure). The transformExpr/transformStmt mutual block is now `partial`: recursion into the catch-clause list and optional finally makes a structural/well-founded termination proof impractical (same as translateStmt); they are transforms, not used in proofs. Add TryLifting.lean regression tests: `new` inside the try body, inside a catch handler, and inside a finally body all lower and verify. --- .../Laurel/LiftImperativeExpressions.lean | 42 +++++++++--- .../Laurel/Examples/Objects/TryLifting.lean | 67 +++++++++++++++++++ 2 files changed, 100 insertions(+), 9 deletions(-) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/TryLifting.lean diff --git a/Strata/Languages/Laurel/LiftImperativeExpressions.lean b/Strata/Languages/Laurel/LiftImperativeExpressions.lean index 2d15f56c2f..b95dc43f95 100644 --- a/Strata/Languages/Laurel/LiftImperativeExpressions.lean +++ b/Strata/Languages/Laurel/LiftImperativeExpressions.lean @@ -236,7 +236,7 @@ mutual Process an expression in expression context, traversing arguments right to left. Assignments are lifted to prependedStmts and replaced with snapshot variable references. -/ -def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do +partial def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do match expr with | AstNode.mk val source => match val with @@ -394,15 +394,17 @@ def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do return expr | _ => return expr - termination_by (sizeOf expr, 0) - decreasing_by - all_goals (simp_all; try term_by_mem) /-- Process a statement, handling any assignments in its sub-expressions. Returns a list of statements (the original may expand into multiple). + +`partial`: recursion into the `try` catch-clause list (and its optional +`finally`) makes a structural/well-founded termination proof impractical, the +same situation the design notes accept for AST-walking transforms. It always +terminates on finite ASTs and is a transform, not used in proofs. -/ -def transformStmt (stmt : StmtExprMd) : LiftM (List StmtExprMd) := do +partial def transformStmt (stmt : StmtExprMd) : LiftM (List StmtExprMd) := do match stmt with | AstNode.mk val source => match val with @@ -515,12 +517,34 @@ def transformStmt (stmt : StmtExprMd) : LiftM (List StmtExprMd) := do modify fun s => { s with subst := [] } return prepends ++ [⟨.Return (some seqRet), source⟩] + | .Throw value => + -- Lift any assignments/imperative calls in the thrown operand to before + -- the throw (the operand is evaluated before control leaves). + let seqValue ← transformExpr value + let prepends ← takePrepends + modify fun s => { s with subst := [] } + return prepends ++ [⟨.Throw seqValue, source⟩] + + | .Try body catches finally? => + -- Recurse into the body, each handler body, and the `finally` arm so that + -- statements needing lifting inside a `try` (e.g. the heap operations a + -- lowered `new` expands to) are lifted within their own region. Catch + -- guards are left as-is: post-`typeHierarchyTransform` they are pure + -- (`is`-checks / booleans) and need no lifting. + let bodyStmts ← transformStmt body + let newCatches ← catches.mapM (fun c => do + let cbodyStmts ← transformStmt c.body + pure ({ c with body := ⟨.Block cbodyStmts none, c.body.source⟩ } : CatchClause)) + let finally'? ← match finally? with + | some f => do + let fs ← transformStmt f + pure (some ⟨.Block fs none, f.source⟩) + | none => pure none + modify fun s => { s with subst := [] } + return [⟨.Try ⟨.Block bodyStmts none, body.source⟩ newCatches finally'?, source⟩] + | _ => return [stmt] - termination_by (sizeOf stmt, 0) - decreasing_by - all_goals (try term_by_mem) - all_goals (apply Prod.Lex.left; try term_by_mem) end def transformProcedureBody (proc : Procedure) (body : StmtExprMd) : LiftM StmtExprMd := do diff --git a/StrataTest/Languages/Laurel/Examples/Objects/TryLifting.lean b/StrataTest/Languages/Laurel/Examples/Objects/TryLifting.lean new file mode 100644 index 0000000000..1951da3c07 --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/TryLifting.lean @@ -0,0 +1,67 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Regression coverage for `LiftImperativeExpressions` handling `try`/`catch`/ +`finally` and `throw`. The lift pass (which moves assignments and imperative +calls out of expression position — e.g. the heap operations a lowered `new` +expands to) previously skipped `Try`/`Throw` via its wildcard, so a `new` (or +other lift-needing statement) *inside* a `try` region reached Core translation +unlifted and failed with a `strata-bug` ("destructive assignments ... should +have been lifted"). Both `transformStmt` arms now recurse into the body, each +handler, and the `finally`, so these programs lower and verify. +-/ + +-- `new` inside the try body: the heap ops it expands to are lifted within the +-- body; the throw is caught and control resumes (r == 2). +#eval testLaurel <| +#strata +program Laurel; +composite MyError extends BaseException {} +procedure newInsideTry() + returns (r: int) + opaque +{ + r := 0; + try { + var e: MyError := new MyError; + throw e + } catch c when c is MyError { + r := 2 + }; + assert r == 2 +}; +#end + +-- `new` inside a catch handler and inside a finally body are both lifted. The +-- handler sets r := 1, finally runs on the fall-through and adds 1 (r == 2). +#eval testLaurel <| +#strata +program Laurel; +composite MyError extends BaseException {} +procedure newInHandlerAndFinally() + returns (r: int) + opaque +{ + var e: MyError := new MyError; + r := 0; + try { + throw e + } catch c when c is MyError { + var h: MyError := new MyError; + r := 1 + } finally { + var f: MyError := new MyError; + r := r + 1 + }; + assert r == 2 +}; +#end From 8f1d8baa905609b5ba9f79084949b012699c56db Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Tue, 7 Jul 2026 13:51:55 +0000 Subject: [PATCH 13/28] feat(laurel): enforce exception escape for instance methods (E4) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The E4 escape check previously ran inside the initial `resolve` and only scanned top-level `staticProcedures`, so instance-method bodies were never checked — a throwing method that did not declare `throws` slipped through. Move the check to a dedicated `ExceptionEscapeCheck` pipeline pass placed after `LiftInstanceProcedures` (methods are now lifted top-level procedures, so their bodies are scanned uniformly and a method calling another throwing method resolves the callee's `throws`) and before `HeapParameterization` (so `throw` operands and `throws` types still carry their real, un-erased types). A `comesBefore heapParameterizationPass` constraint makes the ordering a load-time-checked invariant rather than a silent assumption. Diagnostics render a lifted method name `Composite$method` with a dot (`Composite.method`); user procedure names cannot contain `$`, so top-level procedure names are unaffected. Add MethodExceptionEscape.lean: a throwing method without `throws` is rejected, a declaring method verifies, and method->method propagation is caught (the case that motivated running after lifting). --- .../Laurel/LaurelCompilationPipeline.lean | 13 +++ Strata/Languages/Laurel/Resolution.lean | 31 +++++--- .../Objects/MethodExceptionEscape.lean | 79 +++++++++++++++++++ 3 files changed, 110 insertions(+), 13 deletions(-) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/MethodExceptionEscape.lean diff --git a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean index 247655485c..414cfcdee9 100644 --- a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean +++ b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean @@ -98,6 +98,19 @@ def laurelPipeline : Array LaurelPass := #[ typeAliasElimPass, filterNonCompositeModifiesPass, liftInstanceProceduresPass, + -- E4 enforcement. Placed after LiftInstanceProcedures (so instance-method + -- bodies are checked as ordinary procedures and method→method `throws` + -- resolve through the lifted procedures) and before HeapParameterization (so + -- `throw` operands and `throws` types still carry their real, un-erased + -- types). Emits no-escape / subtype upper-bound diagnostics; does not + -- transform the program. + { name := "ExceptionEscapeCheck" + documentation := "Enforces the E4 exception contract: a procedure that declares no `throws` may not let an exception escape (thrown directly or propagated from a callee), and a `throws T` procedure may only let exceptions whose type is a subtype of T escape. Static analysis; emits diagnostics only." + comesBefore := [⟨heapParameterizationPass, + "escape analysis reads `throw` operand and `throws` types, which heap parameterization erases to `Composite`"⟩] + run := fun p m => + let lattice := TypeLattice.ofTypes p.types + (p, validateExceptionEscapes m lattice p, {}) }, eliminateValueInReturnsPass, heapParameterizationPass, typeHierarchyTransformPass, diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index 35dadf9592..733498f586 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -3295,9 +3295,11 @@ statement uncaught. A `try` removes a body type only when some `catch` clause *provably* handles it — a catch-all, or an `x is T` guard (or a disjunction of such guards) with the type a subtype of `T`. Any other guard is treated as catching nothing, so the analysis stays sound: it never claims an escape is -impossible when it might not be. It runs only on the initial resolution, where -`throw` operands still carry their declared types and `is`-guards have not yet -been lowered by `typeHierarchyTransform`. -/ +impossible when it might not be. It runs as the `ExceptionEscapeCheck` pipeline +pass — after `LiftInstanceProcedures` (so instance-method bodies are checked and +method→method `throws` resolve through the lifted procedures) and before +`HeapParameterization` (so `throw` operands and `throws` types still carry their +real types and `is`-guards are un-lowered). -/ /-- Whether `pred`, the guard of a `catch when pred`, provably holds for every value of type `ty` — i.e. that clause definitely catches `ty`. -/ @@ -3375,18 +3377,23 @@ def checkProcedureThrows (model : SemanticModel) (lattice : TypeLattice) match body? with | none => [] | some body => + -- Instance methods reach this check after being lifted to top-level + -- procedures named `Composite$method`; render that with a dot for the user. + -- (User procedure names cannot contain `$`, so this only affects lifted + -- method names.) + let displayName := proc.name.text.replace "$" "." let escs := exceptionEscapes model lattice body match proc.throwsType with | none => escs.map (fun (ty, src) => diagnosticFromSource src - s!"procedure '{proc.name.text}' may let an exception of type '{formatType ty}' escape; catch it with a `try`/`catch` or declare a `throws` clause" + s!"procedure '{displayName}' may let an exception of type '{formatType ty}' escape; catch it with a `try`/`catch` or declare a `throws` clause" DiagnosticType.UserError) | some declared => escs.filterMap (fun (ty, src) => if isSubtype lattice ty declared then none else some (diagnosticFromSource src - s!"procedure '{proc.name.text}' may throw '{formatType ty}', which is not a subtype of its declared `throws` type '{formatType declared}'" + s!"procedure '{displayName}' may throw '{formatType ty}', which is not a subtype of its declared `throws` type '{formatType declared}'" DiagnosticType.UserError)) /-- Validate the whole program's exception contracts (E4 enforcement). -/ @@ -3418,16 +3425,14 @@ public def resolve (program : Program) (existingModel: Option SemanticModel := n nextId := finalState.nextId } let diamondErrors := validateDiamondFieldAccesses semanticModel program' - -- E4 exception-contract enforcement runs only on the initial resolution, when - -- `throw` operands still carry their declared (pre-heap-parameterization) - -- types and `is`-guards are un-lowered. Re-resolutions (existingModel = some) - -- see `Composite`-typed operands and would misjudge the subtype checks. - let escapeErrors := - if existingModel.isNone then validateExceptionEscapes semanticModel typeLattice program' - else [] + -- Note: E4 exception-escape enforcement (`validateExceptionEscapes`) is *not* + -- run here. It runs as the dedicated `ExceptionEscapeCheck` pipeline pass, + -- after `LiftInstanceProcedures` (so instance-method bodies are checked and + -- method→method `throws` resolve) and before `HeapParameterization` (so + -- `throw` operands and `throws` types still carry their real types). { program := program', model := semanticModel, - errors := finalState.errors ++ diamondErrors ++ escapeErrors + errors := finalState.errors ++ diamondErrors } /-! ## Resolution for UnorderedCoreWithLaurelTypes -/ diff --git a/StrataTest/Languages/Laurel/Examples/Objects/MethodExceptionEscape.lean b/StrataTest/Languages/Laurel/Examples/Objects/MethodExceptionEscape.lean new file mode 100644 index 0000000000..14126848d3 --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/MethodExceptionEscape.lean @@ -0,0 +1,79 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +E4 escape enforcement for *instance methods*. The escape analysis runs as the +`ExceptionEscapeCheck` pipeline pass, after `LiftInstanceProcedures` — so method +bodies are checked as ordinary (lifted) procedures, and a method that calls +another throwing method resolves that callee's `throws`. Diagnostics name the +lifted method with a dot (`Composite.method`). +-/ + +-- A method that throws without declaring `throws` is rejected (the hole that +-- existed while the check only scanned top-level procedures). +#eval testLaurel <| +#strata +program Laurel; +composite Account { + var balance: int + procedure risky(self: Account) + opaque + { + var e: BaseException := new BaseException; + throw e +// ^^^^^^^ error: procedure 'Account.risky' may let an exception of type 'BaseException' escape; catch it with a `try`/`catch` or declare a `throws` clause + }; +} +procedure useIt() opaque { + var a: Account := new Account; + a#risky() +}; +#end + +-- A method that declares `throws` and throws it: allowed (verifies). +#eval testLaurel <| +#strata +program Laurel; +composite Account2 { + var balance: int + procedure risky(self: Account2) + throws BaseException + opaque + { + var e: BaseException := new BaseException; + throw e + }; +} +#end + +-- method -> method propagation: `caller` invokes a throwing method without +-- catching it and without declaring `throws`. This is caught only because the +-- check runs after lifting, when `self#risky()`'s callee `throws` resolves. +#eval testLaurel <| +#strata +program Laurel; +composite Account3 { + var balance: int + procedure risky(self: Account3) + throws BaseException + opaque + { + var e: BaseException := new BaseException; + throw e + }; + procedure caller(self: Account3) + opaque + { + self#risky() +// ^^^^^^^^^^^^ error: procedure 'Account3.caller' may let an exception of type 'BaseException' escape; catch it with a `try`/`catch` or declare a `throws` clause + }; +} +#end From 2f55549e5d447bd3d622739aff7826cf4639dd66 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Tue, 7 Jul 2026 16:14:25 +0000 Subject: [PATCH 14/28] feat(laurel): verify throwing-procedure ensures and onThrow (E4) A throwing procedure's Core output is a single Result. Its contract is now split by channel and verified (checked on exit, assumed at call sites) instead of being dropped at translation: - normal `ensures P` -> Result..isGood($result) ==> P[out := Result..value($result)] - each `onThrow (e) Q` -> Result..isBad($result) ==> Q[e := Result..err($result)] Changes: - LaurelToCoreTranslator.lean: build Good/Bad-path postconditions; translateChecks gains a `wrap` hook for the Good-path guard. - Resolution.lean: collectProcedure registers onThrow bindings in the model, fixing an "Unknown type" strata-bug when an onThrow predicate references its binding. - HeapParameterization.lean: onThrow predicates are heap-parameterized (analyzeProc + heapTransformProcedure), so an onThrow consequent may dereference a composite parameter (e.g. i >= a#length). Tests (ThrowsPostconditions.lean): good-path ensures checked on exit and assumed across a throwing call; onThrow checked against a thrown value (positive + negative); and an array read whose onThrow dereferences a#length. --- .../Laurel/HeapParameterization.lean | 23 +- .../Laurel/LaurelToCoreTranslator.lean | 45 +++- Strata/Languages/Laurel/Resolution.lean | 9 + .../Objects/ThrowsPostconditions.lean | 202 ++++++++++++++++++ 4 files changed, 274 insertions(+), 5 deletions(-) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/ThrowsPostconditions.lean diff --git a/Strata/Languages/Laurel/HeapParameterization.lean b/Strata/Languages/Laurel/HeapParameterization.lean index d5077e27be..640d6a2f2c 100644 --- a/Strata/Languages/Laurel/HeapParameterization.lean +++ b/Strata/Languages/Laurel/HeapParameterization.lean @@ -123,9 +123,14 @@ def analyzeProc (proc : Procedure) : AnalysisResult := | .External => {} -- Also analyze preconditions let precondResult := (proc.preconditions.forM (collectExprMd ·.condition)).run {} |>.2 - { readsHeapDirectly := bodyResult.readsHeapDirectly || precondResult.readsHeapDirectly, - writesHeapDirectly := bodyResult.writesHeapDirectly || precondResult.writesHeapDirectly, - callees := bodyResult.callees ++ precondResult.callees } + -- ...and `onThrow` exceptional postconditions (E4): they may dereference + -- composite parameters (e.g. `e is IndexError ==> i >= a#length`), so their + -- heap use must count toward the reads/writes classification, just like an + -- ordinary postcondition. + let onThrowResult := (proc.onThrow.forM (collectExprMd ·.predicate)).run {} |>.2 + { readsHeapDirectly := bodyResult.readsHeapDirectly || precondResult.readsHeapDirectly || onThrowResult.readsHeapDirectly, + writesHeapDirectly := bodyResult.writesHeapDirectly || precondResult.writesHeapDirectly || onThrowResult.writesHeapDirectly, + callees := bodyResult.callees ++ precondResult.callees ++ onThrowResult.callees } def computeReadsHeap (procs : List Procedure) : List Identifier := let info := procs.map fun p => (p.name, analyzeProc p) @@ -515,10 +520,16 @@ def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : Transform pure (.Abstract postconds') | .External => pure .External + -- `onThrow` predicates may dereference composite parameters, so they are + -- heap-transformed like postconditions (field reads become `readField $heap …`). + let onThrow' ← proc.onThrow.mapM fun c => do + pure { c with predicate := ← heapTransformExpr heapName model c.predicate } + return { proc with inputs := inputs', outputs := outputs', preconditions := preconditions', + onThrow := onThrow', body := body' } else if readsHeap then @@ -544,9 +555,15 @@ def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : Transform pure (.Abstract postconds') | .External => pure .External + -- `onThrow` predicates may dereference composite parameters, so they are + -- heap-transformed like postconditions (field reads become `readField $heap …`). + let onThrow' ← proc.onThrow.mapM fun c => do + pure { c with predicate := ← heapTransformExpr heapName model c.predicate } + return { proc with inputs := inputs', preconditions := preconditions', + onThrow := onThrow', body := body' } else diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index 7de87fea3c..458d2142fd 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -766,10 +766,11 @@ Translate a list of checks (preconditions or postconditions) to Core checks. Each check gets a label like `"requires"` or `"requires_0"`, `"requires_1"`, etc. -/ private def translateChecks (checks : List Condition) (labelBase : String) (overrideFree: Bool) + (wrap : Core.Expression.Expr → Core.Expression.Expr := id) : TranslateM (ListMap Core.CoreLabel Core.Procedure.Check) := checks.mapIdxM (fun i check => do let label := if checks.length == 1 then labelBase else s!"{labelBase}_{i}" - let checkExpr ← translateExpr check.condition [] (isPureContext := true) + let checkExpr := wrap (← translateExpr check.condition [] (isPureContext := true)) let baseMd := astNodeToCoreMd check.condition let md := match check.summary with | some msg => baseMd.pushElem Imperative.MetaData.propertySummary (.msg msg) @@ -877,14 +878,54 @@ def translateProcedure (proc : Procedure) : TranslateM Core.Procedure := do | _ => pure none + -- E4/E7: a throwing procedure's Core output is a single `Result` + -- (`$result`). Normal (`ensures`) postconditions describe the *Good* path only, + -- and the `onThrow` clauses describe the *Bad* path. Build the `Result` + -- projections used to phrase both as ordinary Core postconditions so the + -- exceptional contract is checked on exit and assumed at call sites. + let inputNames := proc.inputs.map (·.name) + let valueOutputs := proc.outputs.filter (fun o => !inputNames.contains o.name) + let valTy ← match valueOutputs with + | [outParam] => translateType outParam.type + | _ => pure LMonoTy.bool + let resultTy : LMonoTy := .tcons resultDatatypeName [valTy, exceptionCoreTy] + let resultFvar : Core.Expression.Expr := .fvar () ⟨resultVarName, ()⟩ (some resultTy) + let mkResultApp (fn : String) : Core.Expression.Expr := mkExceptionCtorApp fn resultFvar + -- Good-path wrapper: guard a normal postcondition with `Result..isGood($result)` + -- and rewrite the (single) value output to `Result..value($result)`. Identity + -- for a non-throwing procedure. + let goodWrap (e : Core.Expression.Expr) : Core.Expression.Expr := + if procThrows then + let e' := match valueOutputs with + | [o] => LExpr.substFvar e ⟨o.name.text, ()⟩ (mkResultApp "Result..value") + | _ => e + .ite () (mkResultApp "Result..isGood") e' (.boolConst () true) + else e -- Translate postconditions for Opaque and Abstract bodies. A bodiless -- procedure (bodyStmts = none) gets its postconditions marked `free` -- (overrideFree) so they are assumed, not checked — and an empty body. let postconditions : ListMap Core.CoreLabel Core.Procedure.Check ← match proc.body with | .Opaque postconds _ _ | .Abstract postconds => - translateChecks postconds s!"postcondition" bodyStmts.isNone + translateChecks postconds s!"postcondition" bodyStmts.isNone (wrap := goodWrap) | _ => pure [] + -- E4: `onThrow` exceptional postconditions constrain the Bad path. Each is + -- `Result..isBad($result) ==> P[binding := Result..err($result)]`, mirroring the + -- `catch`-binding substitution in the `try` lowering. Checked on exit when the + -- procedure has a body; assumed (free) for a bodiless procedure. + let onThrowChecks : ListMap Core.CoreLabel Core.Procedure.Check ← + if procThrows then + proc.onThrow.mapIdxM (fun i c => do + let pe ← translateExpr c.predicate + let pe' := LExpr.substFvar pe ⟨c.binding.text, ()⟩ (mkResultApp "Result..err") + let guarded : Core.Expression.Expr := + .ite () (mkResultApp "Result..isBad") pe' (.boolConst () true) + let label := if proc.onThrow.length == 1 then "onThrow" else s!"onThrow_{i}" + let attr := if bodyStmts.isNone then Core.Procedure.CheckAttr.Free else .Default + let md := astNodeToCoreMd c.predicate + pure (label, ({ expr := guarded, attr, md } : Core.Procedure.Check))) + else pure [] + let postconditions := postconditions.union onThrowChecks -- Assemble outputs + body: a labeled block so early returns (exit) work, plus -- the `Result` wrapping for throwing procedures (E7). `bodyLabel` is the -- shared "$body" constant the resolver pre-registers. diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index 733498f586..45c3b97983 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -3058,6 +3058,15 @@ private def collectProcedure (map : Std.HashMap Nat ResolvedNode) (proc : Proced let map := proc.outputs.foldl collectParameter map let map := proc.preconditions.foldl (fun map c => collectStmtExpr map c.condition) map let map := match proc.decreases with | some d => collectStmtExpr map d | none => map + -- E4: register each `onThrow` binding (typed at the channel root + -- `BaseException`, like a `catch` binding) so that references to it in the + -- exceptional postcondition resolve during Core translation. Mirrors the + -- `.Try`/catch handling in `collectStmtExpr`. Without this, the binding is + -- absent from `refToDef` and its type reads back as `Unknown`. + let map := proc.onThrow.foldl (fun map c => + let bindTy : HighTypeMd := ⟨.UserDefined (mkId baseExceptionTypeName), c.binding.source⟩ + let map := register map c.binding (.var c.binding bindTy) + collectStmtExpr map c.predicate) map collectBody map proc.body private def collectField (map : Std.HashMap Nat ResolvedNode) (ownerName : Identifier) (field : Field) diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ThrowsPostconditions.lean b/StrataTest/Languages/Laurel/Examples/Objects/ThrowsPostconditions.lean new file mode 100644 index 0000000000..c85f0a4e4b --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/ThrowsPostconditions.lean @@ -0,0 +1,202 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Exercises the E4/E7 exceptional *contract* on the verification side: a throwing +procedure's normal (`ensures`) postconditions and its `onThrow` exceptional +postconditions (see `docs/design/laurel_extensions.md`, extension E4). + +A procedure that declares `throws` lowers to one returning a single +`Result` (`$result`). Its contract is split by which channel it +describes: + - a normal `ensures P` holds only on the *Good* path, so it lowers to + `Result..isGood($result) ==> P[out := Result..value($result)]`; + - each `onThrow (e) Q` holds only on the *Bad* path, lowering to + `Result..isBad($result) ==> Q[e := Result..err($result)]`. +Both become ordinary Core postconditions, so each is *checked* on the +procedure's exit (when it has a body) and *assumed* at call sites. These tests +pin both directions: proven-on-exit, assumed-by-caller, and the two failing +cases. + +`onThrow` predicates constrain the caught value only by *reference* (e.g. +`e is T`); field dereference on the binding remains a known gap (see +`ExceptionScenarios.lean`). +-/ + +-- Good-path `ensures` is checked on exit: `safeInc` establishes `r > x` on the +-- (only, non-throwing) path, so the guarded postcondition discharges. +#eval testLaurel <| +#strata +program Laurel; +composite Err extends BaseException {} +procedure safeInc(x: int) + returns (r: int) + throws Err + opaque + ensures r > x +{ + r := x + 1 +}; +#end + +-- Good-path `ensures` is assumed at a call site: inside the `try`, the call to +-- `produce` returns on the Good path, so the caller may rely on `ensures r > 10` +-- for the unwrapped value and prove `out > 10`. +#eval testLaurel <| +#strata +program Laurel; +composite Err extends BaseException {} +procedure produce() + returns (r: int) + throws Err + opaque + ensures r > 10 +{ + r := 20 +}; +procedure consume() + returns (out: int) + opaque +{ + try { + out := produce(); + assert out > 10 + } catch c { + out := 0 + } +}; +#end + +-- `onThrow` is checked on the exceptional path: `alwaysThrows` throws a value of +-- type `Err`, so `onThrow (e) e is Err` holds on the Bad path. (The normal +-- `ensures r > 0` is vacuous here — the Good path is never taken.) +#eval testLaurel <| +#strata +program Laurel; +composite Err extends BaseException {} +procedure alwaysThrows() + returns (r: int) + throws Err + onThrow (e) e is Err + opaque + ensures r > 0 +{ + var x: Err := new Err; + throw x +}; +#end + +-- Negative: the good-path `ensures` does not hold — `badInc` returns `x - 1`, +-- which is not `> x` — so the guarded postcondition fails on the Good path. +#eval testLaurel <| +#strata +program Laurel; +composite Err extends BaseException {} +procedure badInc(x: int) + returns (r: int) + throws Err + opaque + ensures r > x +// ^^^^^ error: assertion does not hold +{ + r := x - 1 +}; +#end + +-- Negative: `onThrow` claims the escaping value is `Other`, but `wrongOnThrow` +-- throws an `Err` (a disjoint sibling), so the exceptional postcondition cannot +-- be proved on the Bad path. +#eval testLaurel <| +#strata +program Laurel; +composite Err extends BaseException {} +composite Other extends BaseException {} +procedure wrongOnThrow() + returns (r: int) + throws Err + onThrow (e) e is Other +// ^^^^^^^^^^ error: assertion could not be proved + opaque + ensures r > 0 +{ + var x: Err := new Err; + throw x +}; +#end +/-! ## Per-type `onThrow` dereferencing a composite parameter + +An array read `value(a, i)`, translated as a Java front-end would emit it: the +array bounds check is made explicit (Core has no implicit exceptions), and the +`onThrow` clause records the pre-state that causes the exception. The array is a +composite `IntArray` carrying its `length`; the element store is a separate +`Map int int` (composite fields cannot be map-typed). The out-of-bounds +`onThrow` consequent *dereferences the composite parameter* — `i >= a#length` — +which is heap-parameterized just like a normal postcondition. + +(The Java source also throws `NullPointerException` when `a == null`; that arm +is omitted because Laurel does not yet model null composite references.) + +Unlike the `perTypeOnThrow` scenario in `ExceptionScenarios.lean` (whose body +never throws, so its `onThrow` clause holds vacuously), the body here actually +throws on the out-of-bounds condition, so the clause is checked non-vacuously. -/ + +-- Positive: the out-of-bounds path throws `IndexError` (with `i >= a#length`), +-- and the in-bounds fall-through returns `select(elems, i)` — so the `onThrow` +-- clause and the `ensures` discharge. +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite IndexError extends Exception {} +composite IntArray { + length: int +} +procedure value(a: IntArray, elems: Map int int, i: int) + returns (r: int) + throws Exception + onThrow (e) e is IndexError ==> (i < 0) || (i >= a#length) + opaque + ensures r == select(elems, i) +{ + if (i < 0) || (i >= a#length) then { + var ei: IndexError := new IndexError; + throw ei + }; + r := select(elems, i) +}; +#end + +-- Negative: a wrong `onThrow` clause — claiming `IndexError` implies the index +-- is in bounds, when it is thrown precisely when out of bounds — cannot be +-- proved on the Bad path. +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite IndexError extends Exception {} +composite IntArray { + length: int +} +procedure valueBad(a: IntArray, elems: Map int int, i: int) + returns (r: int) + throws Exception + onThrow (e) e is IndexError ==> (i >= 0) && (i < a#length) +// ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion could not be proved + opaque + ensures r == select(elems, i) +{ + if (i < 0) || (i >= a#length) then { + var ei: IndexError := new IndexError; + throw ei + }; + r := select(elems, i) +}; +#end From 8448a0a71b696669043c0e9bd32ff0fe940587c1 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Tue, 7 Jul 2026 16:39:25 +0000 Subject: [PATCH 15/28] feat(laurel): run finally on return out of a try body (F18) A `return` inside a `try` body previously jumped straight to `bodyLabel`, skipping the enclosing `finally`. It now unwinds through each enclosing `try` so their `finally` arms run: - a synthesized `$returning` bool is set, and the `return` exits to the nearest `try` label (landing ahead of the catch chain, which is guarded on `$thrown` and so skipped), letting `finally` run; - each `try`'s tail re-checks `$returning` and exits to the next enclosing `try` label (or `bodyLabel`), so outer `finally` arms run too. `$returning` is declared alongside `$thrown`/`$exc` whenever the exceptional channel is used (every `try` sets that flag). Still open: a `return` inside a `catch` handler (and explicit `exit`) is not yet routed through the pending `finally`. Tests (TryCatchBehavior.lean): earlyReturnRunsFinally, returnSkipsCatchRunsFinally, nestedReturnRunsAllFinally. --- .../Laurel/LaurelToCoreTranslator.lean | 50 +++++++++++--- .../Examples/Objects/TryCatchBehavior.lean | 65 +++++++++++++++++++ 2 files changed, 106 insertions(+), 9 deletions(-) diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index 458d2142fd..c33469a3a6 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -106,6 +106,12 @@ private def resultVarName : String := "$result" private def thrownVarName : String := "$thrown" /-- Synthesized local: the in-flight exception value. -/ private def excVarName : String := "$exc" +/-- Synthesized local (F18): `true` once a `return` is unwinding out of one or + more enclosing `try` blocks, so their `finally` arms run on the way out. A + `return` inside a `try` sets it and exits to the nearest `try` label (rather + than jumping straight to `bodyLabel`); each `try`'s tail re-checks it and + keeps unwinding to the next enclosing `try` (or `bodyLabel`). -/ +private def returningVarName : String := "$returning" /-- Core type of an in-flight exception value. After heap parameterization every exception (a composite) is represented as a heap `Composite` reference, so @@ -666,13 +672,23 @@ partial def translateStmt (stmt : StmtExprMd) -- Instance method call as statement: no return value, treated as no-op return ([]) | .Return valueOpt => + -- A value payload should have been eliminated by EliminateValueReturns; + -- flag it but continue as a valueless return. match valueOpt with - | none => - return [.exit bodyLabel md] + | none => pure () | some _ => - let d := md.toDiagnostic "Return statement with value should have been eliminated by EliminateValueReturns pass" DiagnosticType.StrataBug - emitCoreDiagnostic d - return [.exit bodyLabel md] + emitCoreDiagnostic $ md.toDiagnostic "Return statement with value should have been eliminated by EliminateValueReturns pass" DiagnosticType.StrataBug + -- F18: if this `return` is inside a `try`, exit to the nearest `try` label + -- (setting `$returning`) so that `try`'s `finally` runs on the way out; the + -- `try` tail re-checks `$returning` and keeps unwinding. With no enclosing + -- `try`, jump straight to `bodyLabel` as before. + let st ← get + match st.tryLabelStack.head? with + | none => return [.exit bodyLabel md] + | some tryLbl => + modify fun s => { s with currentProcUsedExc := true } + return [ Core.Statement.set ⟨returningVarName, ()⟩ (.const () (.boolConst true)) md, + Imperative.Stmt.exit tryLbl md ] | .While cond invariants decreasesExpr body => let condExpr ← translateExpr cond let invExprs ← invariants.mapM (fun i => do return ("", ← translateExpr i)) @@ -725,8 +741,12 @@ partial def translateStmt (stmt : StmtExprMd) -- for it in each predicate/handler (rather than declaring a local), which -- also sidesteps clauses that reuse the same binding name. -- - -- NOTE: `return`/`exit` inside `B` with a pending `finally` (F18 masking) - -- is not yet modeled — `finally` is only placed on the fall-through edge. + -- F18: a `return` inside `B` sets `$returning` and exits to `tryLbl` (not + -- straight to `bodyLabel`), so it lands ahead of the catch chain — which is + -- guarded on `$thrown` and therefore skipped — and the `finally` still + -- runs. After `finally`, a `$returning` re-check unwinds to the enclosing + -- `try` (or `bodyLabel`), so outer `finally` arms run too. (A `return` + -- inside a `catch` handler is not yet routed through this `finally`.) modify fun s => { s with currentProcUsedExc := true } let savedStack := (← get).tryLabelStack let tryId ← freshId @@ -756,7 +776,14 @@ partial def translateStmt (stmt : StmtExprMd) let fStmts ← match finally? with | some f => translateStmt f | none => pure [] - return Imperative.Stmt.block tryLbl bStmts md :: (catchChain ++ fStmts) + -- F18 re-dispatch: if a `return` unwound into this `try` (so `finally` has + -- now run), keep unwinding to the enclosing `try` label — or `bodyLabel` + -- if this is the outermost — so any outer `finally` arms run too. + let outerTarget := savedStack.head?.getD bodyLabel + let returnDispatch : List Core.Statement := + [ Imperative.Stmt.ite (.det (.fvar () ⟨returningVarName, ()⟩ (some LMonoTy.bool))) + [Imperative.Stmt.exit outerTarget md] [] md ] + return Imperative.Stmt.block tryLbl bStmts md :: (catchChain ++ fStmts ++ returnDispatch) | _ => -- Expression in statement position: preserve as an unused variable init exprAsUnusedInit stmt md @@ -810,7 +837,12 @@ private def buildProcedureOutputsAndBody [ Core.Statement.init ⟨thrownVarName, ()⟩ (LTy.forAll [] LMonoTy.bool) (.det (.const () (.boolConst false))) mdWithUnknownLoc, Core.Statement.init ⟨excVarName, ()⟩ (LTy.forAll [] exceptionCoreTy) - .nondet mdWithUnknownLoc ] + .nondet mdWithUnknownLoc, + -- F18: `$returning` tracks a `return` unwinding through enclosing `try` + -- blocks so their `finally` arms run. Declared whenever the exceptional + -- channel is used (every `try` sets `currentProcUsedExc`). + Core.Statement.init ⟨returningVarName, ()⟩ (LTy.forAll [] LMonoTy.bool) + (.det (.const () (.boolConst false))) mdWithUnknownLoc ] else [] if !procThrows then let outputs ← proc.outputs.mapM translateParameterToCore diff --git a/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean b/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean index 14c2e2bdb3..6b84ca5f96 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean @@ -119,3 +119,68 @@ procedure firstMatchWinsOnOverlap() assert r == 1 }; #end +-- `finally` runs on an early `return` out of the try body (F18): the return +-- unwinds through the `try`, so `finally` sets `ran := 99` before the procedure +-- exits, and the statement after the `try` is skipped. +#eval testLaurel <| +#strata +program Laurel; +procedure earlyReturnRunsFinally() + returns (ran: int) + opaque + ensures ran == 99 +{ + ran := 0; + try { + return + } finally { + ran := 99 + }; + ran := 7 +}; +#end + +-- A `return` in the try body skips the `catch` (no exception is in flight) but +-- still runs `finally`: the handler's `r := 1` does not fire; `finally` sets +-- `r := 5`. +#eval testLaurel <| +#strata +program Laurel; +procedure returnSkipsCatchRunsFinally() + returns (r: int) + opaque + ensures r == 5 +{ + r := 0; + try { + return + } catch c { + r := 1 + } finally { + r := 5 + } +}; +#end + +-- Nested try/finally: a `return` in the innermost body runs both `finally` arms +-- on the way out (inner then outer), so `log` ends at 3. +#eval testLaurel <| +#strata +program Laurel; +procedure nestedReturnRunsAllFinally() + returns (log: int) + opaque + ensures log == 3 +{ + log := 0; + try { + try { + return + } finally { + log := log + 1 + } + } finally { + log := log + 2 + } +}; +#end From 43b77f08fa04e4886fd55246f7169921f0645bd9 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Wed, 8 Jul 2026 09:35:53 +0000 Subject: [PATCH 16/28] feat(laurel): run finally on return/re-throw out of a catch handler (F18) Lowers `try`/`catch`/`finally` with two nested blocks so `finally` runs on every exit edge: block $tryfin { block $try { B } -- throw in B -> $try (enters catch chain) } F if $thrown then exit if $returning then exit - throw in the body targets $try (runs the catch chain); - re-throw in a handler targets $tryfin (skips the chain, still runs F); - return anywhere in the body or a handler sets $returning and targets $tryfin (skips the chain, runs F); - after F, the re-dispatch keeps a pending exception or return unwinding through the enclosing try (so its finally runs too) or to $body. This extends the earlier body-only fix to returns inside catch handlers, makes re-throw run finally, and makes unhandled/re-thrown exceptions propagate (skip subsequent statements) instead of falling through with $thrown set. The tryLabelStack now carries per-try throw/finally targets (TryTarget). Tests (TryCatchBehavior.lean): returnInCatchRunsFinally, returnInCatchNestedFinally. --- .../Laurel/LaurelToCoreTranslator.lean | 107 ++++++++++++------ .../Examples/Objects/TryCatchBehavior.lean | 50 ++++++++ 2 files changed, 121 insertions(+), 36 deletions(-) diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index c33469a3a6..b51d22d7f2 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -38,6 +38,26 @@ def isFieldName (fieldNames : List Identifier) (name : Identifier) : Bool := /-- Set of names that are translated to Core functions (not procedures) -/ @[expose] abbrev FunctionNames := List Identifier +/-- Per-`try` exit targets used while lowering a `try`/`catch`/`finally` (E3/E5, + F18). A `try` is lowered as two nested blocks: + ``` + block $tryfin { + block $try { } -- `throwTarget`: a `throw` in the body enters the catch chain + + } + -- reached by falling out of, or `exit`-ing, $tryfin + + ``` + - `throwTarget` is where an in-flight `throw` jumps: `$try` while lowering the + body (so the catch chain runs), `$tryfin` while lowering a catch handler (so + a re-throw skips the chain but still runs `finally`). + - `finallyTarget` (`$tryfin`) is where a `return` unwinds to so that `finally` + runs before control leaves the `try`. -/ +structure TryTarget where + throwTarget : String + finallyTarget : String + deriving Inhabited + /-- State threaded through expression and statement translation -/ structure TranslateState where /-- Diagnostics accumulated during translation -/ @@ -64,10 +84,11 @@ structure TranslateState where even in a procedure that does not itself declare `throws` (e.g. one whose only exceptional construct is a `try` that catches locally). -/ currentProcUsedExc : Bool := false - /-- E7: stack of enclosing `try` block labels, innermost first. A `throw` - (or a propagating call) exits to the head of this stack; when empty it - exits `bodyLabel`, escaping the procedure on the exceptional channel. -/ - tryLabelStack : List String := [] + /-- E7/F18: stack of enclosing `try` exit targets, innermost first. A `throw` + (or a propagating call) exits to the head's `throwTarget`; a `return` exits + to the head's `finallyTarget` so pending `finally` arms run. When empty, + both fall back to `bodyLabel`, escaping the procedure. -/ + tryLabelStack : List TryTarget := [] /-- 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 @@ -595,7 +616,7 @@ partial def translateStmt (stmt : StmtExprMd) let tmpExpr : Core.Expression.Expr := .fvar () tmpId (some resTy) let tmpInit := Core.Statement.init tmpId (LTy.forAll [] resTy) .nondet md let callStmt := Core.Statement.call calleeId.text (callArgs ++ [.outArg tmpId]) md - let target := st.tryLabelStack.head?.getD bodyLabel + let target := (st.tryLabelStack.head?.map (·.throwTarget)).getD bodyLabel let badBranch : List Core.Statement := [ Core.Statement.set ⟨excVarName, ()⟩ (mkExceptionCtorApp "Result..err" tmpExpr) md, Core.Statement.set ⟨thrownVarName, ()⟩ (.const () (.boolConst true)) md, @@ -685,10 +706,10 @@ partial def translateStmt (stmt : StmtExprMd) let st ← get match st.tryLabelStack.head? with | none => return [.exit bodyLabel md] - | some tryLbl => + | some entry => modify fun s => { s with currentProcUsedExc := true } return [ Core.Statement.set ⟨returningVarName, ()⟩ (.const () (.boolConst true)) md, - Imperative.Stmt.exit tryLbl md ] + Imperative.Stmt.exit entry.finallyTarget md ] | .While cond invariants decreasesExpr body => let condExpr ← translateExpr cond let invExprs ← invariants.mapM (fun i => do return ("", ← translateExpr i)) @@ -724,38 +745,45 @@ partial def translateStmt (stmt : StmtExprMd) else modify fun s => { s with currentProcUsedExc := true } let ve ← translateExpr value - let target := st.tryLabelStack.head?.getD bodyLabel + let target := (st.tryLabelStack.head?.map (·.throwTarget)).getD bodyLabel return [ Core.Statement.set ⟨excVarName, ()⟩ ve md, Core.Statement.set ⟨thrownVarName, ()⟩ (.const () (.boolConst true)) md, Imperative.Stmt.exit target md ] | .Try body catches finally? => - -- E7 (E3/E5): lower `try B catch eᵢ when Pᵢ { Hᵢ } … finally { F }` using - -- the existing `Block`/`Exit` control flow. `B` runs inside a labeled - -- block; a `throw` in `B` exits to that label (leaving `$thrown`/`$exc` - -- set). After the block, a first-match-wins chain of guarded handlers runs - -- (each guard is `$thrown && Pᵢ`; a matching handler clears `$thrown` - -- before running). An unmatched exception leaves `$thrown` set so it - -- propagates outward. `finally` runs on the fall-through edge. + -- E7 (E3/E5/F18): lower `try B catch eᵢ when Pᵢ { Hᵢ } … finally { F }` with + -- two nested labeled blocks so `finally` runs on *every* exit edge: -- - -- The catch binding is bound to the in-flight value by substituting `$exc` - -- for it in each predicate/handler (rather than declaring a local), which - -- also sidesteps clauses that reuse the same binding name. + -- block $tryfin { + -- block $try { B } -- a `throw` in B exits $try → runs the catch chain + -- -- first-match-wins; a match clears `$thrown` + -- } + -- F -- reached by falling out of, or exiting, $tryfin + -- if $thrown then exit -- (re-)propagate + -- if $returning then exit -- keep unwinding + -- + -- A `throw` in B targets $try (so the catch chain runs); a `throw` in a + -- handler (re-throw) targets $tryfin (so it skips the chain but still runs + -- F). A `return` anywhere in B or a handler targets $tryfin, landing ahead + -- of F (the catch chain is guarded on `$thrown`, so a return skips it). + -- After F, the re-dispatch keeps a pending throw/return unwinding through + -- the enclosing `try` (so its F runs too), or to `$body` to leave the proc. -- - -- F18: a `return` inside `B` sets `$returning` and exits to `tryLbl` (not - -- straight to `bodyLabel`), so it lands ahead of the catch chain — which is - -- guarded on `$thrown` and therefore skipped — and the `finally` still - -- runs. After `finally`, a `$returning` re-check unwinds to the enclosing - -- `try` (or `bodyLabel`), so outer `finally` arms run too. (A `return` - -- inside a `catch` handler is not yet routed through this `finally`.) + -- The catch binding is bound to the in-flight value by substituting `$exc` + -- for it in each predicate/handler (rather than declaring a local). modify fun s => { s with currentProcUsedExc := true } let savedStack := (← get).tryLabelStack let tryId ← freshId let tryLbl := s!"$try_{tryId}" - modify fun s => { s with tryLabelStack := tryLbl :: savedStack } + let tryFinLbl := s!"$tryfin_{tryId}" + -- Body phase: a `throw` enters the catch chain ($try); a `return` runs + -- `finally` first ($tryfin). + modify fun s => { s with tryLabelStack := + { throwTarget := tryLbl, finallyTarget := tryFinLbl } :: savedStack } let bStmts ← translateStmt body - -- Restore the stack before handlers/finally, so a re-throw there targets - -- the *enclosing* try (or the body), not this same try. - modify fun s => { s with tryLabelStack := savedStack } + -- Catch phase: a re-`throw` or `return` in a handler exits $tryfin, so it + -- skips the (remaining) catch chain but still runs `finally`. + modify fun s => { s with tryLabelStack := + { throwTarget := tryFinLbl, finallyTarget := tryFinLbl } :: savedStack } let excFvar : Core.Expression.Expr := .fvar () ⟨excVarName, ()⟩ (some exceptionCoreTy) let thrownFvar : Core.Expression.Expr := .fvar () ⟨thrownVarName, ()⟩ (some LMonoTy.bool) let clauses ← catches.mapM (fun c => do @@ -773,17 +801,24 @@ partial def translateStmt (stmt : StmtExprMd) clauses.foldr (fun gh elseB => [Imperative.Stmt.ite (.det gh.1) gh.2 elseB md]) [] + -- Finally phase: a `throw`/`return` in F itself targets the enclosing `try`. + modify fun s => { s with tryLabelStack := savedStack } let fStmts ← match finally? with | some f => translateStmt f | none => pure [] - -- F18 re-dispatch: if a `return` unwound into this `try` (so `finally` has - -- now run), keep unwinding to the enclosing `try` label — or `bodyLabel` - -- if this is the outermost — so any outer `finally` arms run too. - let outerTarget := savedStack.head?.getD bodyLabel - let returnDispatch : List Core.Statement := - [ Imperative.Stmt.ite (.det (.fvar () ⟨returningVarName, ()⟩ (some LMonoTy.bool))) - [Imperative.Stmt.exit outerTarget md] [] md ] - return Imperative.Stmt.block tryLbl bStmts md :: (catchChain ++ fStmts ++ returnDispatch) + -- Re-dispatch: after `finally`, keep any pending exception or return + -- unwinding to the enclosing `try` (running its `finally` too) or to + -- `$body`. `$thrown`/`$returning` are mutually exclusive on any one path. + let enclosing := savedStack.head? + let thrownExit := (enclosing.map (·.throwTarget)).getD bodyLabel + let returnExit := (enclosing.map (·.finallyTarget)).getD bodyLabel + let returningFvar : Core.Expression.Expr := .fvar () ⟨returningVarName, ()⟩ (some LMonoTy.bool) + let reDispatch : List Core.Statement := + [ Imperative.Stmt.ite (.det thrownFvar) [Imperative.Stmt.exit thrownExit md] [] md, + Imperative.Stmt.ite (.det returningFvar) [Imperative.Stmt.exit returnExit md] [] md ] + let tryFinBlock := Imperative.Stmt.block tryFinLbl + (Imperative.Stmt.block tryLbl bStmts md :: catchChain) md + return tryFinBlock :: (fStmts ++ reDispatch) | _ => -- Expression in statement position: preserve as an unused variable init exprAsUnusedInit stmt md diff --git a/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean b/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean index 6b84ca5f96..58fd5cdde0 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean @@ -184,3 +184,53 @@ procedure nestedReturnRunsAllFinally() } }; #end +-- `finally` also runs on a `return` from inside a `catch` handler (the +-- two-label case): the caught `throw` runs the handler, whose `return` unwinds +-- through `finally` (`r := 5`) before leaving the procedure. +#eval testLaurel <| +#strata +program Laurel; +composite MyError extends BaseException {} +procedure returnInCatchRunsFinally() + returns (r: int) + opaque + ensures r == 5 +{ + var e: MyError := new MyError; + r := 0; + try { + throw e + } catch c when c is MyError { + return + } finally { + r := 5 + } +}; +#end + +-- A `return` from a `catch` handler runs both the inner and outer `finally` +-- arms (nested), so `log` ends at 3. +#eval testLaurel <| +#strata +program Laurel; +composite MyError extends BaseException {} +procedure returnInCatchNestedFinally() + returns (log: int) + opaque + ensures log == 3 +{ + var e: MyError := new MyError; + log := 0; + try { + try { + throw e + } catch c when c is MyError { + return + } finally { + log := log + 1 + } + } finally { + log := log + 2 + } +}; +#end From 44a81c7d9a90763206dc94f8546c12909d9b5806 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Wed, 8 Jul 2026 09:56:32 +0000 Subject: [PATCH 17/28] feat(laurel): reject multi-value-output throwing procedures (E7) A throwing procedure lowers to a single Result output, so it can carry at most one value output on the Good path. Previously a `throws` procedure with two or more value outputs silently degraded its Result payload to a bool placeholder, which could misrepresent the result. translateProcedure now emits a clear not-yet-implemented diagnostic at the procedure name instead. Void throwers (no value output) and single-value-output throwers are unchanged. Test (ThrowsContract.lean): twoOut is rejected loudly. --- .../Laurel/LaurelToCoreTranslator.lean | 8 ++++++++ .../Examples/Objects/ThrowsContract.lean | 19 +++++++++++++++++++ 2 files changed, 27 insertions(+) diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index b51d22d7f2..37c8498e4c 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -952,6 +952,14 @@ def translateProcedure (proc : Procedure) : TranslateM Core.Procedure := do -- exceptional contract is checked on exit and assumed at call sites. let inputNames := proc.inputs.map (·.name) let valueOutputs := proc.outputs.filter (fun o => !inputNames.contains o.name) + -- E7 limitation: a throwing procedure lowers to a single `Result` + -- output, so it can carry at most one value output on the Good path. Reject a + -- multi-value-output thrower loudly rather than silently degrading `Val` to a + -- `bool` placeholder (which would misrepresent the result). + if procThrows && valueOutputs.length >= 2 then + emitCoreDiagnostic (diagnosticFromSource proc.name.source + s!"throwing procedure '{proc.name.text}' has {valueOutputs.length} value outputs; a procedure declaring `throws` may have at most one value output (its result is a single `Result` value). Combine the outputs (e.g. into a composite) or drop the `throws` clause." + DiagnosticType.NotYetImplemented) let valTy ← match valueOutputs with | [outParam] => translateType outParam.type | _ => pure LMonoTy.bool diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean b/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean index 297b0a892f..851c6c2a9c 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/ThrowsContract.lean @@ -160,3 +160,22 @@ procedure handled() r := 0 }; #end + +-- A throwing procedure lowers to a single `Result` output, so it +-- can carry at most one value output. A `throws` procedure with two value +-- outputs is rejected loudly (rather than silently degrading the `Result` +-- payload to a placeholder). +#eval testLaurel <| +#strata +program Laurel; +composite E extends BaseException {} +procedure twoOut() +// ^^^^^^ not-yet-implemented: at most one value output + returns (a: int, b: int) + throws E + opaque +{ + a := 1; + b := 2 +}; +#end From 97195d56b03eaa883811cbcfa2fc2501326ed86b Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Wed, 8 Jul 2026 12:06:35 +0000 Subject: [PATCH 18/28] feat(laurel): dereference the exception binding via a cast (E4) A `catch`/`onThrow` predicate can now narrow the binding with a cast and read a field of the thrown value, e.g. `onThrow (e) e is IndexError ==> (e as IndexError)#badIndex >= alen`. Three fixes, one per blocking layer: - Resolution.targetTypeName: add an AsType case so `(e as T)#f` resolves `f` on `T` (this affected any `(x as T)#f`, not just the exception binding). - LaurelAST.isConsistent: treat the erased binding type `BaseException` as consistent with the synthesized `Composite`, so a heap `readField` on the binding type-checks after heap parameterization. - HeapParameterization.dropCastAsserts: a cast `(e as T)` heap-lowers to `Block [assert (e is T); e]`; strip that downcast assert from `onThrow` predicates, since a contract cannot execute an `assert` and the clause guard already conditions validity. Body statements (incl. `catch` handlers) keep the assert, so a downcast there is still checked. Tests: ThrowsPostconditions.lean (relational and concrete field reads in `onThrow`) and TryCatchBehavior.lean (a `catch` handler checking a condition on the caught exception's field). --- .../Laurel/HeapParameterization.lean | 24 +++- Strata/Languages/Laurel/LaurelAST.lean | 13 ++ Strata/Languages/Laurel/Resolution.lean | 8 ++ .../Objects/ThrowsPostconditions.lean | 111 ++++++++++++++++++ .../Examples/Objects/TryCatchBehavior.lean | 30 +++++ 5 files changed, 182 insertions(+), 4 deletions(-) diff --git a/Strata/Languages/Laurel/HeapParameterization.lean b/Strata/Languages/Laurel/HeapParameterization.lean index 640d6a2f2c..5bc49a4f7d 100644 --- a/Strata/Languages/Laurel/HeapParameterization.lean +++ b/Strata/Languages/Laurel/HeapParameterization.lean @@ -485,6 +485,18 @@ where simp_all omega) +/-- Drop the downcast `assert` introduced when heap-lowering a cast `(e as T)` + (which becomes `Block [assert (e is T); e]`). Used only on `onThrow` + predicates: those are pure contracts (which cannot execute an `assert`, and + where a user `assert` is impossible), and any cast validity is conditioned by + the clause's own guard (e.g. `e is T ==> (e as T)#f …`). Body statements + (including `catch` handlers) keep the assert, so a downcast there is still + checked. -/ +private def dropCastAsserts (e : StmtExprMd) : StmtExprMd := + mapStmtExpr (fun node => match node.val with + | .Block [⟨.Assert _, _⟩, v] none => v + | _ => node) e + def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : TransformM Procedure := do let heapName := heapVarName let readsHeap := (← get).heapReaders.contains proc.name @@ -521,9 +533,11 @@ def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : Transform | .External => pure .External -- `onThrow` predicates may dereference composite parameters, so they are - -- heap-transformed like postconditions (field reads become `readField $heap …`). + -- heap-transformed like postconditions (field reads become `readField $heap …`), + -- then cast-assert coercions are dropped (see `dropCastAsserts`). let onThrow' ← proc.onThrow.mapM fun c => do - pure { c with predicate := ← heapTransformExpr heapName model c.predicate } + let p ← heapTransformExpr heapName model c.predicate + pure { c with predicate := dropCastAsserts p } return { proc with inputs := inputs', @@ -556,9 +570,11 @@ def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : Transform | .External => pure .External -- `onThrow` predicates may dereference composite parameters, so they are - -- heap-transformed like postconditions (field reads become `readField $heap …`). + -- heap-transformed like postconditions (field reads become `readField $heap …`), + -- then cast-assert coercions are dropped (see `dropCastAsserts`). let onThrow' ← proc.onThrow.mapM fun c => do - pure { c with predicate := ← heapTransformExpr heapName model c.predicate } + let p ← heapTransformExpr heapName model c.predicate + pure { c with predicate := dropCastAsserts p } return { proc with inputs := inputs', diff --git a/Strata/Languages/Laurel/LaurelAST.lean b/Strata/Languages/Laurel/LaurelAST.lean index b193a4de4a..2c07b8aca0 100644 --- a/Strata/Languages/Laurel/LaurelAST.lean +++ b/Strata/Languages/Laurel/LaurelAST.lean @@ -745,6 +745,19 @@ def isConsistent (ctx : TypeLattice) (a b : HighTypeMd) : Bool := match a'.val, b'.val with | .Unknown, _ | _, .Unknown => true | .TCore _, _ | _, .TCore _ => true + | .UserDefined n1, .UserDefined n2 => + -- After heap parameterization every composite reference is erased to the + -- synthesized `Composite` type, but the `catch`/`onThrow` exception binding + -- keeps its declared root type `BaseException` (it has no AST type node to + -- rewrite, decision #12). Treat the two names as consistent so a heap + -- operation on the binding — e.g. `readField $heap e …` produced by + -- lowering `(e as T)#f` — type-checks. Pre-heap-parameterization the + -- synthesized `Composite` type does not appear in user code, so this only + -- fires post-erasure. (String-keyed like the rest of the `Composite` / + -- `BaseException` boundary; see the design notes' §5.4 caveat.) + highEq a' b' + || ((n1.text == baseExceptionTypeName || n1.text == "Composite") + && (n2.text == baseExceptionTypeName || n2.text == "Composite")) | _, _ => highEq a' b' termination_by (SizeOf.sizeOf a) decreasing_by diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index 45c3b97983..a9810421c6 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -260,6 +260,14 @@ private def targetTypeName (target : StmtExprMd) : ResolveM (Option String) := d | .UserDefined typRef => pure (some typRef.text) | _ => pure none | none => pure none + | .AsType _ castTy => + -- A cast `(e as T)` fixes the static type to `T` for a following field + -- access, e.g. `(e as IndexError)#index`. This is what lets a `catch`/ + -- `onThrow` binding (typed at the root `BaseException`) be narrowed to a + -- subtype before dereferencing its fields. + match castTy.val with + | .UserDefined typRef => pure (some typRef.text) + | _ => pure none | _ => pure none termination_by sizeOf target decreasing_by diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ThrowsPostconditions.lean b/StrataTest/Languages/Laurel/Examples/Objects/ThrowsPostconditions.lean index c85f0a4e4b..c01175c8d2 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/ThrowsPostconditions.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/ThrowsPostconditions.lean @@ -200,3 +200,114 @@ procedure valueBad(a: IntArray, elems: Map int int, i: int) r := select(elems, i) }; #end +/-! ## `onThrow` dereferencing the exception binding + +An `onThrow` predicate may narrow the binding with a cast and read a field of the +thrown value: `onThrow (e) e is T ==> (e as T)#f ...`. It is an exceptional +postcondition of the form "if the procedure exits by throwing a `T`, then this +property of the thrown value holds". + +Here the offending index is recorded on the exception (`IndexError#badIndex`) and +the `onThrow` states the *condition* that it is out of bounds — not a specific +value. The array is a `Map int int` with a separate `alen` length. -/ + +-- Positive: `value(a, i)` throws `IndexError` recording the offending index when +-- `i` is out of bounds, and the `onThrow` states that the recorded index is out +-- of bounds (a condition, no specific value) — which holds because it equals `i` +-- on the throwing path. +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite IndexError extends Exception { + badIndex: int +} +procedure value(a: Map int int, alen: int, i: int) + returns (r: int) + throws Exception + onThrow (e) e is IndexError ==> ((e as IndexError)#badIndex < 0) || ((e as IndexError)#badIndex >= alen) + opaque + ensures r == select(a, i) +{ + if (i < 0) || (i >= alen) then { + var ei: IndexError := new IndexError; + ei#badIndex := i; + throw ei + }; + r := select(a, i) +}; +#end + +-- Negative: the `onThrow` claims the recorded index is *in* bounds, which +-- contradicts the throwing condition, so it cannot be proved. +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite IndexError extends Exception { + badIndex: int +} +procedure valueBadContract(a: Map int int, alen: int, i: int) + returns (r: int) + throws Exception + onThrow (e) e is IndexError ==> ((e as IndexError)#badIndex >= 0) && ((e as IndexError)#badIndex < alen) +// ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion could not be proved + opaque + ensures r == select(a, i) +{ + if (i < 0) || (i >= alen) then { + var ei: IndexError := new IndexError; + ei#badIndex := i; + throw ei + }; + r := select(a, i) +}; +#end +/-! ## Simple field-value demos (concrete numbers) + +The same binding field-dereference, in its simplest form: the thrown exception +carries a concrete value and the `onThrow` / `catch` reads it back. Easier to +follow at a glance than the relational versions above. -/ + +-- onThrow reads back a concrete field value (42). +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite IndexError extends Exception { + index: int +} +procedure throwsFortyTwo() + throws Exception + onThrow (e) e is IndexError ==> (e as IndexError)#index == 42 + opaque +{ + var ei: IndexError := new IndexError; + ei#index := 42; + throw ei +}; +#end + +-- catch handler reads back a concrete field value (5), so `... - 5 == 0`. +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite IndexError extends Exception { + index: int +} +procedure catchReadsFortyTwo() + returns (r: int) + opaque + ensures r == 0 +{ + r := 0; + var ei: IndexError := new IndexError; + ei#index := 5; + try { + throw ei + } catch c when c is IndexError { + r := (c as IndexError)#index - 5 + } +}; +#end diff --git a/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean b/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean index 58fd5cdde0..1a8ff15614 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean @@ -234,3 +234,33 @@ procedure returnInCatchNestedFinally() } }; #end +-- A `catch` handler dereferences a field of the (cast) exception binding and +-- checks a *condition* on it: the caught `IndexError` records the offending +-- index, and on the handler path (reached only via the out-of-bounds throw) that +-- recorded index is provably out of bounds. +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite IndexError extends Exception { + badIndex: int +} +procedure catchReadsField(alen: int, i: int) + returns (r: int) + opaque + ensures r >= 0 +{ + r := 0; + var ei: IndexError := new IndexError; + ei#badIndex := i; + try { + if (i < 0) || (i >= alen) then { + throw ei + }; + r := i + } catch c when c is IndexError { + assert ((c as IndexError)#badIndex < 0) || ((c as IndexError)#badIndex >= alen); + r := 0 + } +}; +#end From 5396c2c7535a10e3f18f4b73e9c3e26959c65fdb Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Wed, 8 Jul 2026 12:06:52 +0000 Subject: [PATCH 19/28] test(laurel): model Java runtime exceptions (NPE, AIOOBE, arithmetic, cast) Add UncheckedExceptions.lean: four one-line Java methods whose implicit runtime exception is desugared into an explicit guarded throw, with the triggering condition captured as an onThrow contract ("if the procedure exits by throwing X, then C held"): - NullPointerException x.f (nullness via a boolean flag) + a negative - IndexOutOfBoundsException a[i] (array as Map int int + alen) - ArithmeticException a / b (guard also discharges the built-in div check) - ClassCastException (Sub) x --- .../Examples/Objects/UncheckedExceptions.lean | 177 ++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/UncheckedExceptions.lean diff --git a/StrataTest/Languages/Laurel/Examples/Objects/UncheckedExceptions.lean b/StrataTest/Languages/Laurel/Examples/Objects/UncheckedExceptions.lean new file mode 100644 index 0000000000..805d632704 --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/UncheckedExceptions.lean @@ -0,0 +1,177 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Modeling Java's runtime exceptions with the current exception feature set. + +Laurel has no implicit exceptions, no first-class null, and no native arrays, so +a runtime failure that Java raises implicitly is modeled as an explicit +check-and-`throw` — exactly what a Java front-end would emit when it desugars the +operation. Each procedure below is the desugaring of a one-line Java method, and +each `onThrow (e) e is X ==> C` reads as an exceptional postcondition: "if the +procedure exits by throwing an `X`, then condition `C` held". That is the +property attached to each risky operation: + + * NullPointerException e.f thrown exactly when the reference is null + * IndexOutOfBoundsException a[i] thrown exactly when the index is out of bounds + * ArithmeticException a / b thrown exactly when the divisor is zero + * ClassCastException (Sub) x thrown exactly when x is not a Sub + +Conventions forced by the current feature set: nullness/arrays are modeled +explicitly (a boolean flag for null, a `Map int int` + length for an array), and +`throws Exception` is the coarse declaration standing in for these otherwise +undeclared runtime exceptions. +-/ + +/-! ## NullPointerException — `x.f` + +Java: + int getF(Obj x) { return x.f; } +`x.f` throws a `NullPointerException` when `x` is null. The contract records +that the result equals `x.f` on the normal path, and that an escaping +`NullPointerException` implies `x` was null. -/ + +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite NullPointerException extends Exception {} +composite Obj { + f: int +} +procedure getF(xIsNull: bool, x: Obj) + returns (r: int) + throws Exception + onThrow (e) e is NullPointerException ==> xIsNull + opaque + ensures r == x#f +{ + if xIsNull then { + var npe: NullPointerException := new NullPointerException; + throw npe + }; + r := x#f +}; +#end + +-- Negative: the contract claims an escaping NPE implies the reference was +-- NON-null, contradicting the guard, so it cannot be proved. +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite NullPointerException extends Exception {} +composite Obj { + f: int +} +procedure getFBad(xIsNull: bool, x: Obj) + returns (r: int) + throws Exception + onThrow (e) e is NullPointerException ==> !xIsNull +// ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion could not be proved + opaque + ensures r == x#f +{ + if xIsNull then { + var npe: NullPointerException := new NullPointerException; + throw npe + }; + r := x#f +}; +#end + +/-! ## IndexOutOfBoundsException — `a[i]` + +Java: + int get(int[] a, int i) { return a[i]; } +`a[i]` throws when `i < 0 || i >= a.length`. The contract records that the +result equals `a[i]` on the normal path, and that an escaping `IndexError` +implies the index was out of bounds. -/ + +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite IndexError extends Exception {} +procedure get(a: Map int int, alen: int, i: int) + returns (r: int) + throws Exception + onThrow (e) e is IndexError ==> (i < 0) || (i >= alen) + opaque + ensures r == select(a, i) +{ + if (i < 0) || (i >= alen) then { + var ei: IndexError := new IndexError; + throw ei + }; + r := select(a, i) +}; +#end + +/-! ## ArithmeticException — `a / b` + +Java: + int div(int a, int b) { return a / b; } +`a / b` throws when `b == 0`; the contract records that an escaping +`ArithmeticException` implies the divisor was zero. The guard makes the division +provably safe on the normal path (it also discharges Laurel's built-in +division-by-zero obligation). A postcondition mentioning `a / b` directly is +avoided, since evaluating a partial operation in a contract raises the safety +obligation outside the guard's scope. -/ + +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite ArithmeticException extends Exception {} +procedure div(a: int, b: int) + returns (r: int) + throws Exception + onThrow (e) e is ArithmeticException ==> b == 0 + opaque +{ + if b == 0 then { + var ae: ArithmeticException := new ArithmeticException; + throw ae + }; + r := a / b +}; +#end + +/-! ## ClassCastException — `(Sub) x` + +Java: + int useAsSub(Base x) { return ((Sub) x).v; } +The cast `(Sub) x` throws when `x` is not actually a `Sub`; the contract records +that an escaping `ClassCastException` implies `x` was not a `Sub`. -/ + +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite ClassCastException extends Exception {} +composite Base {} +composite Sub extends Base { + v: int +} +procedure useAsSub(x: Base) + returns (r: int) + throws Exception + onThrow (e) e is ClassCastException ==> !(x is Sub) + opaque +{ + if !(x is Sub) then { + var cce: ClassCastException := new ClassCastException; + throw cce + }; + r := (x as Sub)#v +}; +#end From 5690ad6dbac43db7e01f853848a0d0c48e8fcd65 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Wed, 8 Jul 2026 14:22:28 +0000 Subject: [PATCH 20/28] feat(laurel): add `when C throws (e) P` exceptional behavior case (E4) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Adds a procedure/function clause pairing a pre-state trigger with an exceptional postcondition: `when C throws (e) P` means "if C holds on entry, the procedure exits exceptionally and P holds of the thrown value e". It lowers to a Core postcondition `C ==> (Result..isBad($result) ∧ P[e := err])` — checked on exit and assumed at call sites, so a caller can prove a throw will happen (and what then holds). Complements the existing `onThrow (e) P` (`isBad ==> P`, a postcondition on every exceptional exit): the two are converse directions, mirroring JML's `signals` and `exceptional_behavior`. The exception variable is bound per-clause (not procedure-wide), consistent with `catch`/`onThrow`. Threaded through grammar (+ tree translators), AST (`OnThrowsClause`), resolution (+ collectProcedure, mapProcedureM), heap parameterization, and the translator. The `when` keyword mirrors the `catch e when ...` guard. Tests: OnThrows.lean (positive, negative, caller proves the throw from an opaque contract) and an added array behavior-case in UncheckedExceptions.lean. --- .../AbstractToConcreteTreeTranslator.lean | 3 + .../ConcreteToAbstractTreeTranslator.lean | 20 ++++- .../Laurel/Grammar/LaurelGrammar.lean | 2 +- .../Languages/Laurel/Grammar/LaurelGrammar.st | 10 ++- .../Laurel/HeapParameterization.lean | 27 +++++- Strata/Languages/Laurel/LaurelAST.lean | 27 ++++++ .../Laurel/LaurelToCoreTranslator.lean | 19 ++++ Strata/Languages/Laurel/MapStmtExpr.lean | 4 +- Strata/Languages/Laurel/Resolution.lean | 31 +++++-- .../Laurel/Examples/Objects/OnThrows.lean | 88 +++++++++++++++++++ .../Examples/Objects/UncheckedExceptions.lean | 12 ++- 11 files changed, 224 insertions(+), 19 deletions(-) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/OnThrows.lean diff --git a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean index 8f657dc3fa..f00143a4c0 100644 --- a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean @@ -262,6 +262,8 @@ private def procedureToOp (proc : Procedure) : StrataDDM.Operation := laurelOp "throwsClause" #[highTypeToArg t]) let onThrowArgs := proc.onThrow.map (fun c => laurelOp "onThrowClause" #[ident c.binding.text, stmtExprToArg c.predicate]) |>.toArray + let onThrowsArgs := proc.onThrows.map (fun c => + laurelOp "onThrowsClause" #[stmtExprToArg c.condition, ident c.binding.text, stmtExprToArg c.postcondition]) |>.toArray let invokeOnArg := optionArg (proc.invokeOn.map fun e => laurelOp "invokeOnClause" #[stmtExprToArg e]) let (opaqueSpecArg, bodyArg) := match proc.body with @@ -287,6 +289,7 @@ private def procedureToOp (proc : Procedure) : StrataDDM.Operation := seqArg requiresArgs, throwsArg, seqArg onThrowArgs, + seqArg onThrowsArgs, invokeOnArg, opaqueSpecArg, bodyArg diff --git a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean index f8564ee641..bfb6410794 100644 --- a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean @@ -536,9 +536,9 @@ def parseProcedure (arg : Arg) : TransM Procedure := do match op.name, op.args with | q`Laurel.procedure, #[nameArg, paramArg, returnTypeArg, returnParamsArg, - requiresArg, throwsArg, onThrowArg, invokeOnArg, opaqueSpecArg, bodyArg] + requiresArg, throwsArg, onThrowArg, onThrowsArg, invokeOnArg, opaqueSpecArg, bodyArg] | q`Laurel.function, #[nameArg, paramArg, returnTypeArg, returnParamsArg, - requiresArg, throwsArg, onThrowArg, invokeOnArg, opaqueSpecArg, bodyArg] => + requiresArg, throwsArg, onThrowArg, onThrowsArg, invokeOnArg, opaqueSpecArg, bodyArg] => let name ← translateIdent nameArg let parameters ← translateParameters paramArg -- Either returnTypeArg or returnParamsArg may have a value, not both @@ -577,6 +577,19 @@ def parseProcedure (arg : Arg) : TransM Procedure := do | _, _ => TransM.error s!"Expected onThrowClause, got {repr cOp.name}" | _ => TransM.error "Expected operation in onThrow sequence" | _ => pure [] + -- Parse `when C throws (e) P` exceptional behavior cases (E4 - zero or more) + let onThrows ← match onThrowsArg with + | .seq _ _ clauses => clauses.toList.mapM fun arg => match arg with + | .op cOp => match cOp.name, cOp.args with + | q`Laurel.onThrowsClause, #[condArg, bindingArg, postArg] => do + let condition ← translateStmtExpr condArg + let binding ← translateIdent bindingArg + let postcondition ← translateStmtExpr postArg + pure ({ condition := condition, binding := binding, + postcondition := postcondition } : OnThrowsClause) + | _, _ => TransM.error s!"Expected onThrowsClause, got {repr cOp.name}" + | _ => TransM.error "Expected operation in onThrows sequence" + | _ => pure [] -- Parse optional invokeOn clause let invokeOn ← match invokeOnArg with | .option _ (some (.op invokeOnOp)) => match invokeOnOp.name, invokeOnOp.args with @@ -625,11 +638,12 @@ def parseProcedure (arg : Arg) : TransM Procedure := do invokeOn := invokeOn throwsType := throwsType onThrow := onThrow + onThrows := onThrows body := procBody } | q`Laurel.procedure, args | q`Laurel.function, args => - TransM.error s!"parseProcedure expects 10 arguments, got {args.size}" + TransM.error s!"parseProcedure expects 11 arguments, got {args.size}" | _, _ => TransM.error s!"parseProcedure expects procedure or function, got {repr op.name}" diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean index 1d33d8e18c..690ba7ccbd 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean @@ -12,7 +12,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: added generic datatype type parameters and type application (`Option`, `Option`). +-- Last grammar change: added `when C throws (e) P` exceptional behavior-case clause on procedures/functions. public import StrataDDM.AST import StrataDDM.BuiltinDialects.Init import StrataDDM.Integration.Lean.HashCommands diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st index 1ab1a2741d..4d37f8e455 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st @@ -219,6 +219,10 @@ op throwsClause(throwsType: LaurelType): ThrowsClause => "\n throws " throwsTyp category OnThrowClause; op onThrowClause(binding: Ident, predicate: StmtExpr): OnThrowClause => "\n onThrow (" binding ") " predicate:0; +category OnThrowsClause; +op onThrowsClause(condition: StmtExpr, binding: Ident, postcondition: StmtExpr): OnThrowsClause => + "\n when " condition:0 " throws (" binding ") " postcondition:0; + category Body; op body(body: StmtExpr): Body => "\n" body:0; op externalBody: Body => "external"; @@ -230,10 +234,11 @@ op procedure (name : Ident, parameters: CommaSepBy Parameter, requires: Seq RequiresClause, throws: Option ThrowsClause, onThrow: Seq OnThrowClause, + onThrows: Seq OnThrowsClause, invokeOn: Option InvokeOnClause, opaqueSpec: Option OpaqueSpec, body : Option Body) : Procedure => - "procedure " name "(" parameters ")" returnType returnParameters requires throws onThrow invokeOn opaqueSpec body ";"; + "procedure " name "(" parameters ")" returnType returnParameters requires throws onThrow onThrows invokeOn opaqueSpec body ";"; op function (name : Ident, parameters: CommaSepBy Parameter, returnType: Option ReturnType, @@ -241,10 +246,11 @@ op function (name : Ident, parameters: CommaSepBy Parameter, requires: Seq RequiresClause, throws: Option ThrowsClause, onThrow: Seq OnThrowClause, + onThrows: Seq OnThrowsClause, invokeOn: Option InvokeOnClause, opaqueSpec: Option OpaqueSpec, body : Option Body) : Procedure => - "function " name "(" parameters ")" returnType returnParameters requires throws onThrow invokeOn opaqueSpec body ";"; + "function " name "(" parameters ")" returnType returnParameters requires throws onThrow onThrows invokeOn opaqueSpec body ";"; op composite (name: Ident, extending: Option Extends, fields: Seq Field, procedures: Seq Procedure): Composite => "composite " name extending " {" fields procedures " }"; diff --git a/Strata/Languages/Laurel/HeapParameterization.lean b/Strata/Languages/Laurel/HeapParameterization.lean index 5bc49a4f7d..c1d4b2d0ff 100644 --- a/Strata/Languages/Laurel/HeapParameterization.lean +++ b/Strata/Languages/Laurel/HeapParameterization.lean @@ -128,9 +128,12 @@ def analyzeProc (proc : Procedure) : AnalysisResult := -- heap use must count toward the reads/writes classification, just like an -- ordinary postcondition. let onThrowResult := (proc.onThrow.forM (collectExprMd ·.predicate)).run {} |>.2 - { readsHeapDirectly := bodyResult.readsHeapDirectly || precondResult.readsHeapDirectly || onThrowResult.readsHeapDirectly, - writesHeapDirectly := bodyResult.writesHeapDirectly || precondResult.writesHeapDirectly || onThrowResult.writesHeapDirectly, - callees := bodyResult.callees ++ precondResult.callees ++ onThrowResult.callees } + -- ...and `when C throws (e) P` behavior cases (E4), whose trigger/postcondition + -- may dereference composite parameters, just like a precondition. + let onThrowsResult := (proc.onThrows.forM (fun c => do collectExprMd c.condition; collectExprMd c.postcondition)).run {} |>.2 + { readsHeapDirectly := bodyResult.readsHeapDirectly || precondResult.readsHeapDirectly || onThrowResult.readsHeapDirectly || onThrowsResult.readsHeapDirectly, + writesHeapDirectly := bodyResult.writesHeapDirectly || precondResult.writesHeapDirectly || onThrowResult.writesHeapDirectly || onThrowsResult.writesHeapDirectly, + callees := bodyResult.callees ++ precondResult.callees ++ onThrowResult.callees ++ onThrowsResult.callees } def computeReadsHeap (procs : List Procedure) : List Identifier := let info := procs.map fun p => (p.name, analyzeProc p) @@ -539,11 +542,20 @@ def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : Transform let p ← heapTransformExpr heapName model c.predicate pure { c with predicate := dropCastAsserts p } + -- `when C throws (e) P` cases: transform the trigger (like a precondition) and + -- the postcondition (like `onThrow`, dropping cast-assert coercions since `P` + -- may dereference the binding via a cast). + let onThrows' ← proc.onThrows.mapM fun c => do + let cond ← heapTransformExpr heapName model c.condition + let post ← heapTransformExpr heapName model c.postcondition + pure { c with condition := dropCastAsserts cond, postcondition := dropCastAsserts post } + return { proc with inputs := inputs', outputs := outputs', preconditions := preconditions', onThrow := onThrow', + onThrows := onThrows', body := body' } else if readsHeap then @@ -576,10 +588,19 @@ def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : Transform let p ← heapTransformExpr heapName model c.predicate pure { c with predicate := dropCastAsserts p } + -- `when C throws (e) P` cases: transform the trigger (like a precondition) and + -- the postcondition (like `onThrow`, dropping cast-assert coercions since `P` + -- may dereference the binding via a cast). + let onThrows' ← proc.onThrows.mapM fun c => do + let cond ← heapTransformExpr heapName model c.condition + let post ← heapTransformExpr heapName model c.postcondition + pure { c with condition := dropCastAsserts cond, postcondition := dropCastAsserts post } + return { proc with inputs := inputs', preconditions := preconditions', onThrow := onThrow', + onThrows := onThrows', body := body' } else diff --git a/Strata/Languages/Laurel/LaurelAST.lean b/Strata/Languages/Laurel/LaurelAST.lean index 2c07b8aca0..ceb2441233 100644 --- a/Strata/Languages/Laurel/LaurelAST.lean +++ b/Strata/Languages/Laurel/LaurelAST.lean @@ -237,6 +237,15 @@ structure Procedure : Type where /-- Exceptional postconditions (E4): predicates that hold when the procedure exits on the exceptional channel. Recorded, not enforced. -/ onThrow : List OnThrowClause := [] + /-- Exceptional behavior cases (E4): each `when C throws (e) P` clause pairs a + pre-state trigger `C` with an exceptional postcondition `P` (with `e` bound + to the thrown value). Meaning: if `C` holds on entry, the procedure exits + exceptionally *and* `P` holds. Lowered to a Core postcondition + `C ==> (Result..isBad($result) ∧ P[e := err])` — checked on exit and assumed + at call sites, so a caller can conclude a throw *will* happen (and what then + holds). Distinct from `onThrow` (`isBad ==> P`), which constrains every + exceptional exit without forcing one. -/ + onThrows : List OnThrowsClause := [] /-- A typed parameter for a procedure. @@ -291,6 +300,24 @@ structure OnThrowClause where /-- The exceptional-postcondition predicate (checked at `TBool`). -/ predicate : AstNode StmtExpr +/-- +An `when C throws (e) P` exceptional *behavior case* (E4). It pairs a pre-state +trigger condition `C` (a boolean predicate over the procedure's inputs) with an +exceptional postcondition `P` in which `e` is bound to the thrown value (typed at +the channel root `BaseException`). Meaning: if `C` holds on entry, the procedure +exits on the exceptional channel and `P` holds of the thrown value. Compare +`OnThrowClause`, which constrains *every* exceptional exit but does not force +one. See `docs/design/laurel_extensions.md` (extension E4). +-/ +structure OnThrowsClause where + /-- The pre-state trigger predicate `C` (checked at `TBool`; `e` not in scope). -/ + condition : AstNode StmtExpr + /-- The identifier bound to the thrown value in `P` (typed `BaseException`). -/ + binding : Identifier + /-- The exceptional postcondition `P` that holds when `C` triggers a throw + (checked at `TBool`, with `binding` in scope). -/ + postcondition : AstNode StmtExpr + /-- The body of a procedure. A body can be transparent (with a visible implementation), opaque (with a postcondition and optional implementation), diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index 37c8498e4c..1929ba2aa0 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -1001,6 +1001,25 @@ def translateProcedure (proc : Procedure) : TranslateM Core.Procedure := do pure (label, ({ expr := guarded, attr, md } : Core.Procedure.Check))) else pure [] let postconditions := postconditions.union onThrowChecks + -- E4: `when C throws (e) P` behavior cases constrain *when* the Bad path is taken + -- and what then holds. Each lowers to `C ==> (Result..isBad($result) ∧ + -- P[e := Result..err($result)])`: so a caller can conclude the procedure throws + -- when `C` holds and that `P` holds of the thrown value. Checked on exit when + -- the procedure has a body; assumed (free) for a bodiless procedure. + let onThrowsChecks : ListMap Core.CoreLabel Core.Procedure.Check ← + if procThrows then + proc.onThrows.mapIdxM (fun i c => do + let ce ← translateExpr c.condition [] (isPureContext := true) + let pe ← translateExpr c.postcondition [] (isPureContext := true) + let pe' := LExpr.substFvar pe ⟨c.binding.text, ()⟩ (mkResultApp "Result..err") + let conj := LExpr.mkApp () boolAndOp [mkResultApp "Result..isBad", pe'] + let guarded : Core.Expression.Expr := .ite () ce conj (.boolConst () true) + let label := if proc.onThrows.length == 1 then "onThrows" else s!"onThrows_{i}" + let attr := if bodyStmts.isNone then Core.Procedure.CheckAttr.Free else .Default + let md := astNodeToCoreMd c.condition + pure (label, ({ expr := guarded, attr, md } : Core.Procedure.Check))) + else pure [] + let postconditions := postconditions.union onThrowsChecks -- Assemble outputs + body: a labeled block so early returns (exit) work, plus -- the `Result` wrapping for throwing procedures (E7). `bodyLabel` is the -- shared "$body" constant the resolver pre-registers. diff --git a/Strata/Languages/Laurel/MapStmtExpr.lean b/Strata/Languages/Laurel/MapStmtExpr.lean index e47f49a341..ceb7305d31 100644 --- a/Strata/Languages/Laurel/MapStmtExpr.lean +++ b/Strata/Languages/Laurel/MapStmtExpr.lean @@ -234,7 +234,9 @@ def mapProcedureM [Monad m] (f : StmtExprMd → m StmtExprMd) (proc : Procedure) preconditions := ← proc.preconditions.mapM (·.mapM f) decreases := ← proc.decreases.mapM f invokeOn := ← proc.invokeOn.mapM f - onThrow := ← proc.onThrow.mapM (fun c => do pure { c with predicate := ← f c.predicate }) } + onThrow := ← proc.onThrow.mapM (fun c => do pure { c with predicate := ← f c.predicate }) + onThrows := ← proc.onThrows.mapM (fun c => do + pure { c with condition := ← f c.condition, postcondition := ← f c.postcondition }) } /-- 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 a9810421c6..547076a2e1 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -2771,7 +2771,7 @@ def resolveBody (body : Body) : ResolveM Body := do boolean predicate). Recorded for the verifier; not enforced — Java-style declare-or-catch is front-end policy. See `laurel_extensions.md` (E4). -/ def resolveExceptionalContract (proc : Procedure) - : ResolveM (Option HighTypeMd × List OnThrowClause) := do + : ResolveM (Option HighTypeMd × List OnThrowClause × List OnThrowsClause) := do let throwsType' ← proc.throwsType.mapM fun t => do let t' ← resolveHighType t let baseTy ← resolveHighType @@ -2787,7 +2787,19 @@ def resolveExceptionalContract (proc : Procedure) let binding' ← defineNameCheckDup c.binding (.var c.binding bindTy) let predicate' ← Check.resolveStmtExpr c.predicate { val := .TBool, source := c.predicate.source } pure ({ binding := binding', predicate := predicate' } : OnThrowClause) - pure (throwsType', onThrow') + -- `when C throws (e) P` behavior cases: the trigger `C` is a pre-state predicate + -- over the inputs (no exception binder), resolved at `bool` like a + -- precondition; the postcondition `P` is resolved at `bool` with the binding + -- `e` (typed at `BaseException`) in scope, like an `onThrow`. + let onThrows' ← proc.onThrows.mapM fun c => do + let condition' ← Check.resolveStmtExpr c.condition { val := .TBool, source := c.condition.source } + withScope do + let bindTy ← resolveHighType + { val := .UserDefined (mkId baseExceptionTypeName), source := c.binding.source } + let binding' ← defineNameCheckDup c.binding (.var c.binding bindTy) + let postcondition' ← Check.resolveStmtExpr c.postcondition { val := .TBool, source := c.postcondition.source } + pure ({ condition := condition', binding := binding', postcondition := postcondition' } : OnThrowsClause) + pure (throwsType', onThrow', onThrows') /-- (Procedure) ``` @@ -2824,12 +2836,12 @@ def resolveProcedure (proc : Procedure) : ResolveM Procedure := do -- (e.g. destructive assignments) inside a transparent body. So there is -- no transparent-body rejection here, unlike `resolveInstanceProcedure`. let invokeOn' ← proc.invokeOn.mapM resolveStmtExpr - let (throwsType', onThrow') ← resolveExceptionalContract proc + let (throwsType', onThrow', onThrows') ← resolveExceptionalContract proc return { name := procName', inputs := inputs', outputs := outputs', isFunctional := proc.isFunctional, preconditions := pres', decreases := dec', invokeOn := invokeOn', - throwsType := throwsType', onThrow := onThrow', + throwsType := throwsType', onThrow := onThrow', onThrows := onThrows', body := body' } /-- Resolve a field: define its name under the qualified key (OwnerType.fieldName) and resolve its type. -/ @@ -2867,12 +2879,12 @@ def resolveInstanceProcedure (typeName : Identifier) (proc : Procedure) : Resolv modify fun s => { s with errors := s.errors.push diag } let invokeOn' ← proc.invokeOn.mapM resolveStmtExpr modify fun s => { s with instanceTypeName := savedInstType } - let (throwsType', onThrow') ← resolveExceptionalContract proc + let (throwsType', onThrow', onThrows') ← resolveExceptionalContract proc return { name := procName', inputs := inputs', outputs := outputs', isFunctional := proc.isFunctional, preconditions := pres', decreases := dec', invokeOn := invokeOn', - throwsType := throwsType', onThrow := onThrow', + throwsType := throwsType', onThrow := onThrow', onThrows := onThrows', body := body' } /-- Resolve a type definition. -/ @@ -3075,6 +3087,13 @@ private def collectProcedure (map : Std.HashMap Nat ResolvedNode) (proc : Proced let bindTy : HighTypeMd := ⟨.UserDefined (mkId baseExceptionTypeName), c.binding.source⟩ let map := register map c.binding (.var c.binding bindTy) collectStmtExpr map c.predicate) map + -- E4: `when C throws (e) P` behavior cases — register the binding `e` (like an + -- `onThrow`) and collect both the trigger and the postcondition. + let map := proc.onThrows.foldl (fun map c => + let bindTy : HighTypeMd := ⟨.UserDefined (mkId baseExceptionTypeName), c.binding.source⟩ + let map := register map c.binding (.var c.binding bindTy) + let map := collectStmtExpr map c.condition + collectStmtExpr map c.postcondition) map collectBody map proc.body private def collectField (map : Std.HashMap Nat ResolvedNode) (ownerName : Identifier) (field : Field) diff --git a/StrataTest/Languages/Laurel/Examples/Objects/OnThrows.lean b/StrataTest/Languages/Laurel/Examples/Objects/OnThrows.lean new file mode 100644 index 0000000000..8b48e2a326 --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/OnThrows.lean @@ -0,0 +1,88 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +The `when C throws (e) P` exceptional behavior case (E4). + +`onThrow (e) P` is a postcondition on the Bad path ("if it throws, `P` holds"). +`when C throws (e) P` is a *behavior case*: it pairs a pre-state trigger `C` with an +exceptional postcondition `P` (with `e` bound to the thrown value). Meaning: "if +`C` holds on entry, the procedure exits exceptionally and `P` holds of the thrown +value." It lowers to a Core postcondition +`C ==> (Result..isBad($result) ∧ P[e := err])` — checked on exit (so the body +must honor it) and assumed at call sites (so a caller can prove a throw *will* +happen and what then holds). Scoped to triggers over inputs, partial semantics. +-/ + +-- Positive: the body throws exactly when `b == 0`, and the thrown value is an +-- `ArithmeticException`, so `when b == 0 throws (e) e is ArithmeticException` holds. +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite ArithmeticException extends Exception {} +procedure div(a: int, b: int) + returns (r: int) + throws Exception + when b == 0 throws (e) e is ArithmeticException + opaque +{ + if b == 0 then { + var ae: ArithmeticException := new ArithmeticException; + throw ae + }; + r := a / b +}; +#end + +-- Negative: the case declares a throw when `b == 0`, but the body never throws, +-- so the trigger part cannot be proved on exit. +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +composite ArithmeticException extends Exception {} +procedure divBad(a: int, b: int) + returns (r: int) + throws Exception + when b == 0 throws (e) e is ArithmeticException +// ^^^^^^ error: assertion could not be proved + opaque +{ + r := 0 +}; +#end + +-- Caller-side use: from an opaque (bodiless) procedure's behavior case, the +-- caller proves the throw definitely happens — calling with `b == 0` must take +-- the `catch` branch (so `out` ends at 99, never 1). +#eval testLaurel <| +#strata +program Laurel; +composite Exception extends BaseException {} +procedure mustThrow(a: int, b: int) + returns (r: int) + throws Exception + when b == 0 throws (e) true; +procedure caller() + returns (out: int) + opaque + ensures out == 99 +{ + out := 0; + try { + var z: int := mustThrow(5, 0); + out := 1 + } catch c { + out := 99 + } +}; +#end diff --git a/StrataTest/Languages/Laurel/Examples/Objects/UncheckedExceptions.lean b/StrataTest/Languages/Laurel/Examples/Objects/UncheckedExceptions.lean index 805d632704..9a4796d102 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/UncheckedExceptions.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/UncheckedExceptions.lean @@ -92,9 +92,14 @@ procedure getFBad(xIsNull: bool, x: Obj) Java: int get(int[] a, int i) { return a[i]; } -`a[i]` throws when `i < 0 || i >= a.length`. The contract records that the -result equals `a[i]` on the normal path, and that an escaping `IndexError` -implies the index was out of bounds. -/ +`a[i]` throws when `i < 0 || i >= a.length`. This example uses both exceptional +contract forms together: + * `onThrow (e) e is IndexError ==> …` — a postcondition on *every* exceptional + exit: "if it threw an `IndexError`, the index was out of bounds"; + * `when (i < 0) || (i >= alen) throws (e) e is IndexError` — a behavior case: + "if the index is out of bounds on entry, it *does* throw an `IndexError`". +The first lets a caller reason backward from a caught exception; the second lets +a caller conclude a throw *will* happen for a bad index. -/ #eval testLaurel <| #strata @@ -105,6 +110,7 @@ procedure get(a: Map int int, alen: int, i: int) returns (r: int) throws Exception onThrow (e) e is IndexError ==> (i < 0) || (i >= alen) + when (i < 0) || (i >= alen) throws (e) e is IndexError opaque ensures r == select(a, i) { From eb9a2c85dd266180b29aacc6c16d3d72f08b6e2e Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Wed, 8 Jul 2026 15:13:02 +0000 Subject: [PATCH 21/28] test(laurel): model JS throw-anything via BaseException boxing (E2) --- .../Examples/Objects/ThrowArbitraryValue.lean | 123 ++++++++++++++++++ 1 file changed, 123 insertions(+) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/ThrowArbitraryValue.lean diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ThrowArbitraryValue.lean b/StrataTest/Languages/Laurel/Examples/Objects/ThrowArbitraryValue.lean new file mode 100644 index 0000000000..b30a2c1acb --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/ThrowArbitraryValue.lean @@ -0,0 +1,123 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +Modeling JavaScript-style "throw *any* value" on top of the `BaseException`-rooted +channel. + +Laurel requires a thrown value to be a subtype of `BaseException`, but JS lets you +`throw` an arbitrary value (`throw 42`, `throw "boom"`, an object, …). A JS→Laurel +front-end bridges the two by *boxing*: it wraps the thrown value in a single +carrier composite that extends `BaseException`, and unwraps it in the handler. + + // JS + throw v; + try { … } catch (x) { … x … } + + // desugared to Laurel + var t: AnyThrown := new AnyThrown; t#value := v; throw t; + try { … } catch e when e is AnyThrown { var x := (e as AnyThrown)#value; … x … } + +The arbitrary payload is a `JsValue` tagged union — the same "any value" +representation a JS front-end needs anyway. The exceptional channel, `Result` +lowering, and `catch`/`is` dispatch are all unchanged; the arbitrariness lives in +the box's field, not in the thrown type. + +Note: `JsValue` here has just `JsNum`/`JsStr` to keep the example small. JS's +value space is a fixed, finite set of kinds, so this datatype can be extended as +needed with further constructors — `JsBool`, `JsUndefined`, `JsNull`, +`JsObj(ref: …)` for objects/Errors, etc. — to represent any JS value. +-/ + +-- `throw 42` — a number (not an Error) is boxed, caught, and unwrapped. +#eval testLaurel <| +#strata +program Laurel; +datatype JsValue { + JsNum(num: int), + JsStr(str: string) +} +composite AnyThrown extends BaseException { + value: JsValue +} +procedure jsThrowNumber() + returns (r: int) + opaque + ensures r == 42 +{ + r := 0; + var t: AnyThrown := new AnyThrown; + t#value := JsNum(42); + try { + throw t + } catch e when e is AnyThrown { + var v: JsValue := (e as AnyThrown)#value; + assert JsValue..isJsNum(v); + r := JsValue..num(v) + } +}; +#end + +-- `throw "boom"` — a string value is boxed and caught; the handler observes it +-- is a `JsStr`. +#eval testLaurel <| +#strata +program Laurel; +datatype JsValue { + JsNum(num: int), + JsStr(str: string) +} +composite AnyThrown extends BaseException { + value: JsValue +} +procedure jsThrowString() + returns (r: bool) + opaque + ensures r +{ + r := false; + var t: AnyThrown := new AnyThrown; + t#value := JsStr("boom"); + try { + throw t + } catch e when e is AnyThrown { + var v: JsValue := (e as AnyThrown)#value; + r := JsValue..isJsStr(v) + } +}; +#end + +-- Negative: the boxed payload's kind is tracked — a string value is not a +-- number, so asserting `isJsNum` in the handler cannot be proved. +#eval testLaurel <| +#strata +program Laurel; +datatype JsValue { + JsNum(num: int), + JsStr(str: string) +} +composite AnyThrown extends BaseException { + value: JsValue +} +procedure jsThrowStringBad() + opaque +{ + var t: AnyThrown := new AnyThrown; + t#value := JsStr("boom"); + try { + throw t + } catch e when e is AnyThrown { + var v: JsValue := (e as AnyThrown)#value; + assert JsValue..isJsNum(v) +// ^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion could not be proved + } +}; +#end From 45fd5e7b45cc4525316088d3cef480ac11a19040 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Wed, 8 Jul 2026 18:01:07 +0000 Subject: [PATCH 22/28] refactor(laurel): extract exception lowering into EliminateExceptions pass (E7) Move the exception->Result lowering (throw, try/catch/finally, throws/onThrow/when-throws) out of LaurelToCoreTranslator into a dedicated Laurel-to-Laurel pass so the transformation is reviewable as Laurel in / Laurel out. The translator is now exception-agnostic. Adds a before/after reviewability test that runs the pipeline on a progression of small programs (minimal throw through nested try/finally, each with its Java equivalent) and prints the procedures before and after the pass. --- .../Languages/Laurel/EliminateExceptions.lean | 485 ++++++++++++++++++ .../Laurel/LaurelCompilationPipeline.lean | 19 +- .../Laurel/LaurelToCoreTranslator.lean | 388 ++------------ .../Objects/EliminateExceptionsPass.lean | 354 +++++++++++++ 4 files changed, 888 insertions(+), 358 deletions(-) create mode 100644 Strata/Languages/Laurel/EliminateExceptions.lean create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean diff --git a/Strata/Languages/Laurel/EliminateExceptions.lean b/Strata/Languages/Laurel/EliminateExceptions.lean new file mode 100644 index 0000000000..d6960f81b9 --- /dev/null +++ b/Strata/Languages/Laurel/EliminateExceptions.lean @@ -0,0 +1,485 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ +module + +public import Strata.Languages.Laurel.LaurelAST +public import Strata.Languages.Laurel.LaurelPass +public import Strata.Languages.Laurel.SemanticModel +import Strata.Languages.Laurel.MapStmtExpr +import Strata.Languages.Laurel.HeapParameterization +import Strata.Util.Tactics + +/-! +# Eliminate Exceptions (E7) + +A Laurel-to-Laurel pass that lowers the exceptional channel — `throw`, `try` / +`catch` / `finally`, and the `throws` / `onThrow` / `when C throws` procedure +contract — into ordinary Laurel (labeled `Block`s, `Exit`s, assignments, and +`Result` datatype construction). After this pass no `Throw`/`Try` statements and +no `throwsType`/`onThrow`/`onThrows` clauses remain, so the final +`LaurelToCoreTranslator` never needs to know about exceptions. + +This mirrors the encoding that used to live inside the translator, but expressed +one level up so the transformation is reviewable as Laurel before/after (see the +`EliminateExceptions` reviewability test). + +## Encoding + +A procedure that declares `throws` returns a single `Result` +output (`$result`). While the body runs, the in-flight exception is tracked by +two synthesized locals, `$thrown : bool` and `$exc : Composite`; `$returning` +tracks a `return` unwinding out of enclosing `try` blocks so their `finally` +arms run (F18). All synthesized names are `$`-prefixed, outside the user +namespace. + +- `throw v` → `$exc := v; $thrown := true; exit `. +- `try B catch eᵢ when Pᵢ { Hᵢ } … finally { F }` → two nested labeled blocks + `block $tryfin { block $try { B } } F ` so `finally` + runs on every exit edge (the catch binding is substituted by `$exc`). +- a call to a `throws` procedure → bind its `Result` to a temp, then `if + isBad(tmp) then propagate else unwrap value(tmp)`. +- the body is wrapped in `block $exnexit { … }`; after it, `$result` is built + (`Bad($exc)` if thrown, else `Good(val)`). +- `ensures P` → Good-path `isGood($result) ==> P[out := value($result)]`; + each `onThrow (e) Q` → `isBad($result) ==> Q[e := err($result)]`; each + `when C throws (e) P` → `C ==> (isBad($result) ∧ P[e := err($result)])`. + +Runs last (after heap parameterization, so exceptions are heap `Composite` +references and `is`-tests are already lowered) and needs a re-resolve so the +synthesized locals get uniqueIds. +-/ + +namespace Strata.Laurel + +/-! ### Synthesized names -/ + +/-- Synthesized local: `true` once an exception is in flight. -/ +private def exnThrownVar : String := "$thrown" +/-- Synthesized local: the in-flight exception value (a heap `Composite`). -/ +private def exnExcVar : String := "$exc" +/-- Synthesized local (F18): `true` once a `return` is unwinding through + enclosing `try` blocks so their `finally` arms run. -/ +private def exnReturningVar : String := "$returning" +/-- Synthesized output of a throwing procedure: its `Result`. -/ +private def exnResultVar : String := "$result" +/-- Label of the block a `throw`/`return` exits to leave the body region; the + `Result` construction is placed immediately after this block. Distinct from + the translator's `$body` label (which it auto-wraps around every body). -/ +private def exnExitLabel : String := "$exnexit" + +/-- The generic result datatype's name (from `exceptionDefinitionsForLaurel`). -/ +private def resultDatatypeName : String := "Result" +/-- The heap composite reference datatype name (from the heap prelude). -/ +private def compositeTypeName : String := "Composite" + +/-! ### Laurel AST constructors (synthesized nodes carry no source) -/ + +private def nn (e : StmtExpr) : StmtExprMd := ⟨e, none⟩ +private def tyNode (t : HighType) : HighTypeMd := ⟨t, none⟩ +private def boolTy : HighTypeMd := tyNode .TBool +private def compositeTy : HighTypeMd := tyNode (.UserDefined (mkId compositeTypeName)) +private def resultTyOf (valTy : HighTypeMd) : HighTypeMd := + tyNode (.Applied (tyNode (.UserDefined (mkId resultDatatypeName))) [valTy, compositeTy]) + +private def litBool (b : Bool) : StmtExprMd := nn (.LiteralBool b) +private def localRef (name : String) : StmtExprMd := nn (.Var (.Local (mkId name))) +/-- Assignment to an existing local. -/ +private def setLocal (name : String) (val : StmtExprMd) : StmtExprMd := + nn (.Assign [⟨.Local (mkId name), none⟩] val) +/-- Variable declaration without an initializer (standalone statement). -/ +private def declNoInit (name : String) (ty : HighTypeMd) : StmtExprMd := + nn (.Var (.Declare ⟨mkId name, ty⟩)) +/-- Variable declaration with an initializer. -/ +private def declInit (name : String) (ty : HighTypeMd) (val : StmtExprMd) : StmtExprMd := + nn (.Assign [⟨.Declare ⟨mkId name, ty⟩, none⟩] val) +private def callStatic (name : String) (args : List StmtExprMd) : StmtExprMd := + nn (.StaticCall (mkId name) args) +/-- `Ctor(arg)` / `Datatype..fn(arg)` — a single-argument datatype op. -/ +private def resultApp (fn : String) (arg : StmtExprMd) : StmtExprMd := callStatic fn [arg] +private def exitTo (label : String) : StmtExprMd := nn (.Exit label) +private def blockOf (stmts : List StmtExprMd) (label : Option String := none) : StmtExprMd := + nn (.Block stmts label) +private def iteOf (c t : StmtExprMd) (e : Option StmtExprMd) : StmtExprMd := + nn (.IfThenElse c t e) +private def impliesOf (a b : StmtExprMd) : StmtExprMd := nn (.PrimitiveOp .Implies [a, b]) +private def andOf (a b : StmtExprMd) : StmtExprMd := nn (.PrimitiveOp .And [a, b]) + +/-- Attach a source range to a (synthesized) node so verification-condition + diagnostics point at the originating clause rather than at nowhere. -/ +private def withSrc (src : Option FileRange) (e : StmtExprMd) : StmtExprMd := { e with source := src } + +/-- Substitute every reference `Var (.Local name)` with `repl` throughout `e`. -/ +private def substLocal (name : String) (repl : StmtExprMd) (e : StmtExprMd) : StmtExprMd := + mapStmtExpr (fun n => match n.val with + | .Var (.Local id) => if id.text == name then repl else n + | _ => n) e + +/-! ### Callee lookup -/ + +/-- The resolved callee procedure, if `callee` names one. -/ +private def calleeProc (model : SemanticModel) (callee : Identifier) : Option Procedure := + match model.get callee with + | .staticProcedure p => some p + | .instanceProcedure _ p => some p + | _ => none + +private def calleeThrows (model : SemanticModel) (callee : Identifier) : Bool := + (calleeProc model callee).map (·.throwsType.isSome) |>.getD false + +/-- A procedure's value outputs: outputs that are not also inputs (i.e. not + inout, notably not the heap `$heap`). -/ +private def valueOutputsOf (proc : Procedure) : List Parameter := + let inputNames := proc.inputs.map (·.name.text) + proc.outputs.filter (fun o => !inputNames.contains o.name.text) + +/-- The `Val` type carried on the Good path: the (single) value output's type, + or `bool` as a placeholder for a void return. -/ +private def valTyOf (proc : Procedure) : HighTypeMd := + match valueOutputsOf proc with + | [o] => o.type + | _ => boolTy + +/-! ### Pass state -/ + +private structure EState where + /-- Next fresh id for synthesized labels/temps. -/ + nextId : Nat := 0 + /-- Set while lowering a procedure body when a `throw`/`try`/throwing-call is + lowered — signals that the `$thrown`/`$exc`/`$returning` locals are needed. -/ + usedExc : Bool := false + diags : List DiagnosticModel := [] + model : SemanticModel + +private abbrev EM := StateM EState + +private def freshNat : EM Nat := modifyGet (fun s => (s.nextId, { s with nextId := s.nextId + 1 })) +private def markUsedExc : EM Unit := modify (fun s => { s with usedExc := true }) +private def emitDiag (d : DiagnosticModel) : EM Unit := modify (fun s => { s with diags := s.diags ++ [d] }) + +/-- Per-procedure lowering context. -/ +private structure Ctx where + /-- Whether the enclosing procedure declares `throws`. -/ + procThrows : Bool + /-- Enclosing `try` exit targets, innermost first: `(throwTarget, finallyTarget)`. + A `throw` exits to the head's `throwTarget`; a `return` to its + `finallyTarget`. Empty ⇒ both fall back to `$exnexit` (leave the body). -/ + tryStack : List (String × String) + +private def throwTargetOf (ctx : Ctx) : String := (ctx.tryStack.head?.map Prod.fst).getD exnExitLabel +private def finallyTargetOf (ctx : Ctx) : String := (ctx.tryStack.head?.map Prod.snd).getD exnExitLabel + +/-! ### Statement lowering -/ + +mutual + +/-- Lower a list of statements, concatenating the (possibly expanded) results. + Statements after an unconditional terminator (`throw`/`return`/`exit`, which + all lower to an `exit`) are unreachable and dropped, so re-resolution does + not flag dead code after the synthesized `exit`. -/ +private partial def lowerStmts (ctx : Ctx) (stmts : List StmtExprMd) : EM (List StmtExprMd) := do + let mut acc : List StmtExprMd := [] + for s in stmts do + acc := acc ++ (← lowerStmt ctx s) + match s.val with + | .Throw _ | .Return _ | .Exit _ => break + | _ => pure () + pure acc + +/-- Lower a single statement into a list of exception-free statements. -/ +private partial def lowerStmt (ctx : Ctx) (stmt : StmtExprMd) : EM (List StmtExprMd) := do + let src := stmt.source + match stmt.val with + | .Block stmts label => + let stmts' ← lowerStmts ctx stmts + pure [⟨.Block stmts' label, src⟩] + | .IfThenElse c t e => + let t' ← lowerStmt ctx t + let e' ← match e with + | some eb => do pure (some (blockOf (← lowerStmt ctx eb))) + | none => pure none + pure [⟨.IfThenElse c (blockOf t') e', src⟩] + | .While c invs dec body => + let body' ← lowerStmt ctx body + pure [⟨.While c invs dec (blockOf body'), src⟩] + | .Throw value => + markUsedExc + pure [ setLocal exnExcVar value, + setLocal exnThrownVar (litBool true), + exitTo (throwTargetOf ctx) ] + | .Return _ => + -- Value payloads were removed by EliminateValueInReturns, so this is a + -- valueless return. Route it so that any enclosing `finally` runs (F18), + -- else jump to `$exnexit` to build the result / leave the body. + markUsedExc + match ctx.tryStack.head? with + | none => pure [exitTo exnExitLabel] + | some (_, finTarget) => + pure [ setLocal exnReturningVar (litBool true), exitTo finTarget ] + | .Try body catches finally? => + lowerTry ctx src body catches finally? + | .Assign targets value => + -- A call to a throwing procedure on the RHS needs the propagate/unwrap + -- dispatch; any other assignment is left untouched. + match value.val with + | .StaticCall callee _ | .InstanceCall _ callee _ => + if calleeThrows (← get).model callee then + lowerThrowingCall ctx value targets + else pure [stmt] + | _ => pure [stmt] + | .StaticCall callee _ => + if calleeThrows (← get).model callee then + lowerThrowingCall ctx stmt [] + else pure [stmt] + | .InstanceCall _ callee _ => + if calleeThrows (← get).model callee then + lowerThrowingCall ctx stmt [] + else pure [stmt] + | _ => pure [stmt] + +/-- Lower a `try`/`catch`/`finally` into two nested labeled blocks plus the + `finally` arm and a re-dispatch that keeps a pending throw/return unwinding. -/ +private partial def lowerTry (ctx : Ctx) (src : Option FileRange) + (body : StmtExprMd) (catches : List CatchClause) (finally? : Option StmtExprMd) + : EM (List StmtExprMd) := do + markUsedExc + let saved := ctx.tryStack + let tryId ← freshNat + let tryLbl := s!"$try_{tryId}" + let tryFinLbl := s!"$tryfin_{tryId}" + -- Body phase: a `throw` enters the catch chain ($try); a `return` runs + -- `finally` first ($tryfin). + let bStmts ← lowerStmt { ctx with tryStack := (tryLbl, tryFinLbl) :: saved } body + -- Catch phase: a re-`throw` or `return` in a handler skips the (remaining) + -- catch chain but still runs `finally` ($tryfin). + let catchCtx : Ctx := { ctx with tryStack := (tryFinLbl, tryFinLbl) :: saved } + let clauses ← catches.mapM (fun c => do + let pExpr := match c.predicate with + | some p => substLocal c.binding.text (localRef exnExcVar) p + | none => litBool true + let hStmts ← lowerStmt catchCtx c.body + let hStmts := hStmts.map (substLocal c.binding.text (localRef exnExcVar)) + let guard := andOf (localRef exnThrownVar) pExpr + let handler := setLocal exnThrownVar (litBool false) :: hStmts + pure (guard, handler)) + -- First-match-wins is enforced by clearing `$thrown` on a match: once a clause + -- fires, later `$thrown && guardⱼ` guards are false. So the chain is a *sequence* + -- of else-less `if`s rather than a nested `if`/`else` — an else-less `if` types + -- as void, avoiding a branch-type mismatch when a handler ends in an assignment + -- (which Laurel types as the assigned value, not void). + let catchChainStmts : List StmtExprMd := clauses.map (fun (g, h) => iteOf g (blockOf h) none) + -- Finally phase: a `throw`/`return` in F targets the enclosing `try`. + let fStmts ← match finally? with + | some f => lowerStmt ctx f + | none => pure [] + -- Re-dispatch: keep any pending exception/return unwinding outward. + let thrownExit := (saved.head?.map Prod.fst).getD exnExitLabel + let returnExit := (saved.head?.map Prod.snd).getD exnExitLabel + let reDispatch : List StmtExprMd := + [ iteOf (localRef exnThrownVar) (blockOf [exitTo thrownExit]) none, + iteOf (localRef exnReturningVar) (blockOf [exitTo returnExit]) none ] + let tryFinBlock := blockOf (blockOf bStmts (some tryLbl) :: catchChainStmts) (some tryFinLbl) + pure (⟨tryFinBlock.val, src⟩ :: (fStmts ++ reDispatch)) + +/-- Lower a call to a throwing procedure. The callee now returns its inout + outputs (notably the heap `$heap`) *and* a `Result` value; bind the `Result` + to a fresh temp — keeping the inout targets — then propagate on `Bad` or + unwrap the value on `Good`. + + The original call is a (possibly multi-target) assignment whose targets align + positionally with the callee's original outputs. The inout targets are kept + in place; the single value target is replaced by the fresh `$callres` and + unwrapped on the Good path. This matches the callee's new output order + (inout outputs, then the `Result`). -/ +private partial def lowerThrowingCall (ctx : Ctx) (callNode : StmtExprMd) + (targets : List VariableMd) : EM (List StmtExprMd) := do + markUsedExc + let model := (← get).model + let callee := match callNode.val with + | .StaticCall c _ => c + | .InstanceCall _ c _ => c + | _ => mkId "?" + let p? := calleeProc model callee + let valTy := p?.map valTyOf |>.getD boolTy + let calleeInputNames := (p?.map (·.inputs.map (·.name.text))).getD [] + let calleeOutputs := (p?.map (·.outputs)).getD [] + let tid ← freshNat + let callres := s!"$callres_{tid}" + -- Split targets (positional with callee outputs) into kept inout targets and + -- the single value target (replaced by `$callres`, unwrapped on the Good path). + let paired := targets.zip calleeOutputs + let inoutTargets := paired.filterMap (fun (t, o) => + if calleeInputNames.contains o.name.text then some t else none) + let valueTarget? := (paired.find? (fun (_, o) => !calleeInputNames.contains o.name.text)).map Prod.fst + let callresTarget : VariableMd := ⟨.Declare ⟨mkId callres, resultTyOf valTy⟩, none⟩ + let multiCall := nn (.Assign (inoutTargets ++ [callresTarget]) callNode) + -- Propagate on `Bad` (exits the block), so the Good-path unwrap that follows is + -- reached only when the call did not throw. An else-less `if` keeps this void. + let propagate := iteOf (resultApp "Result..isBad" (localRef callres)) + (blockOf + [ setLocal exnExcVar (resultApp "Result..err" (localRef callres)), + setLocal exnThrownVar (litBool true), + exitTo (throwTargetOf ctx) ]) + none + -- A `Declare` value target is declared up front so it stays in scope for later + -- statements; it is assigned the unwrapped value only on the Good path. + let (preDecls, goodStmts) : List StmtExprMd × List StmtExprMd := + match valueTarget? with + | some ⟨.Declare ⟨x, xTy⟩, _⟩ => + ([declNoInit x.text xTy], [setLocal x.text (resultApp "Result..value" (localRef callres))]) + | some ⟨.Local x, _⟩ => + ([], [setLocal x.text (resultApp "Result..value" (localRef callres))]) + | _ => ([], []) + pure (preDecls ++ [multiCall, propagate] ++ goodStmts) + +end + +/-! ### Detecting whether a procedure needs the transform -/ + +private partial def stmtUsesExn (model : SemanticModel) (stmt : StmtExprMd) : Bool := + match stmt.val with + | .Throw _ => true + | .Try _ _ _ => true + | .StaticCall callee _ => calleeThrows model callee + | .InstanceCall _ callee _ => calleeThrows model callee + | .Assign _ v => stmtUsesExn model v + | .Block stmts _ => stmts.attach.any (fun ⟨s, _⟩ => stmtUsesExn model s) + | .IfThenElse c t e => + stmtUsesExn model c || stmtUsesExn model t || (e.attach.any (fun ⟨x, _⟩ => stmtUsesExn model x)) + | .While c _ _ b => stmtUsesExn model c || stmtUsesExn model b + | _ => false + +private def bodyImpl (body : Body) : Option StmtExprMd := + match body with + | .Transparent b => some b + | .Opaque _ impl _ => impl + | _ => none + +private def bodyHasExn (model : SemanticModel) (proc : Procedure) : Bool := + match bodyImpl proc.body with + | some b => stmtUsesExn model b + | none => false + +/-! ### Procedure lowering -/ + +/-- Existing (normal) postconditions declared on a body, if any. -/ +private def bodyPostconditions (body : Body) : List Condition := + match body with + | .Opaque posts _ _ => posts + | .Abstract posts => posts + | _ => [] + +/-- Lower a single procedure. Non-exceptional procedures are returned unchanged. -/ +private def lowerProc (proc : Procedure) : EM Procedure := do + let procThrows := proc.throwsType.isSome + let model := (← get).model + if !(procThrows || bodyHasExn model proc) then + return proc + modify (fun s => { s with usedExc := false }) + let ctx : Ctx := { procThrows, tryStack := [] } + let valueOutputs := valueOutputsOf proc + -- E7 limitation: a `throws` procedure lowers to a single `Result` value, so it + -- can carry at most one value output. + if procThrows && valueOutputs.length >= 2 then + emitDiag (diagnosticFromSource proc.name.source + s!"throwing procedure '{proc.name.text}' has {valueOutputs.length} value outputs; a procedure declaring `throws` may have at most one value output (its result is a single `Result` value). Combine the outputs (e.g. into a composite) or drop the `throws` clause." + DiagnosticType.NotYetImplemented) + -- Lower the implementation statements (if any). + let loweredBody? ← match bodyImpl proc.body with + | some b => do pure (some (← lowerStmt ctx b)) + | none => pure none + let usedExc := (← get).usedExc + let isBodiless := loweredBody?.isNone + + if !procThrows then + -- Non-throwing procedure that uses the exceptional channel locally (a `try` + -- that catches everything, or a call it handles). Keep its body kind (and + -- thus its caller-visible transparency), just rewrite the implementation. + let excDecls := excStateDecls (needed := usedExc) + let assembled := blockOf (excDecls ++ wrapExit (loweredBody?.getD [])) + let newBody := match proc.body with + | .Transparent _ => .Transparent assembled + | .Opaque posts _ modif => .Opaque posts (some assembled) modif + | b => b + return { proc with body := newBody } + + -- Throwing procedure: return a single `Result`, build it after the body, and + -- turn the exceptional contract into ordinary postconditions over `$result`. + let valTy := valTyOf proc + let valName? := match valueOutputs with | [o] => some o.name.text | _ => none + let inputNames := proc.inputs.map (·.name.text) + let inoutOutputs := proc.outputs.filter (fun o => inputNames.contains o.name.text) + let newOutputs := inoutOutputs ++ [⟨mkId exnResultVar, resultTyOf valTy⟩] + -- Postconditions. + let goodWrap (p : StmtExprMd) : StmtExprMd := + let p' := match valName? with + | some n => substLocal n (resultApp "Result..value" (localRef exnResultVar)) p + | none => p + impliesOf (resultApp "Result..isGood" (localRef exnResultVar)) p' + let wrappedPosts := (bodyPostconditions proc.body).map (fun c => + { c with condition := withSrc c.condition.source (goodWrap c.condition), free := c.free || isBodiless }) + let onThrowPosts := proc.onThrow.map (fun c => + let p' := substLocal c.binding.text (resultApp "Result..err" (localRef exnResultVar)) c.predicate + ({ condition := withSrc c.predicate.source (impliesOf (resultApp "Result..isBad" (localRef exnResultVar)) p') + free := isBodiless } : Condition)) + let onThrowsPosts := proc.onThrows.map (fun c => + let p' := substLocal c.binding.text (resultApp "Result..err" (localRef exnResultVar)) c.postcondition + let conj := andOf (resultApp "Result..isBad" (localRef exnResultVar)) p' + ({ condition := withSrc c.condition.source (impliesOf c.condition conj), free := isBodiless } : Condition)) + let allPosts := wrappedPosts ++ onThrowPosts ++ onThrowsPosts + -- Body assembly (only when there is an implementation). + let goodArg := match valName? with | some n => localRef n | none => litBool true + let construct := iteOf (localRef exnThrownVar) + (blockOf [setLocal exnResultVar (resultApp "Bad" (localRef exnExcVar))]) + (some (blockOf [setLocal exnResultVar (resultApp "Good" goodArg)])) + let assembledBody? : Option StmtExprMd := loweredBody?.map (fun bstmts => + let excDecls := excStateDecls (needed := true) + let valDecl := match valName? with | some n => [declNoInit n valTy] | none => [] + blockOf (excDecls ++ valDecl ++ [blockOf bstmts (some exnExitLabel), construct])) + let origModif := match proc.body with | .Opaque _ _ m => m | _ => [] + let newBody := match proc.body with + | .Abstract _ => .Abstract allPosts + | _ => .Opaque allPosts assembledBody? origModif + return { proc with + outputs := newOutputs + body := newBody + throwsType := none + onThrow := [] + onThrows := [] } +where + /-- The `$thrown`/`$exc`/`$returning` declarations, emitted when the body uses + the exceptional channel. -/ + excStateDecls (needed : Bool) : List StmtExprMd := + if needed then + [ declInit exnThrownVar boolTy (litBool false), + declNoInit exnExcVar compositeTy, + declInit exnReturningVar boolTy (litBool false) ] + else [] + /-- Wrap the lowered body statements in the `$exnexit` block (for non-throwing + procedures there is no trailing result construction). -/ + wrapExit (stmts : List StmtExprMd) : List StmtExprMd := [blockOf stmts (some exnExitLabel)] + +public section + +/-- Transform a program by eliminating the exceptional channel from all static + procedures. -/ +def eliminateExceptionsTransform (model : SemanticModel) (program : Program) + : Program × List DiagnosticModel := + let init : EState := { model } + let (procs, st) := (program.staticProcedures.mapM lowerProc).run init + ({ program with staticProcedures := procs }, st.diags) + +end -- public section + +/-- Pipeline pass: eliminate exceptions (E7). -/ +public def eliminateExceptionsPass : LaurelPass where + name := "EliminateExceptions" + needsResolves := true + documentation := "Lowers the exceptional channel (throw, try/catch/finally, throws/onThrow/when-throws) into ordinary Laurel: labeled blocks, exits, and Result datatype construction. A throwing procedure returns a single Result; the in-flight exception rides in synthesized $thrown/$exc locals and the result is assembled after the body. Exception contracts become ordinary postconditions over $result. After this pass no Throw/Try or throws/onThrow clauses remain." + run := fun p m => + let (p', diags) := eliminateExceptionsTransform m p + (p', diags, {}) + +end Laurel diff --git a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean index 414cfcdee9..af234f0ffc 100644 --- a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean +++ b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean @@ -22,6 +22,7 @@ import Strata.Languages.Laurel.ConstrainedTypeElim import Strata.Languages.Laurel.PushOldInward import Strata.Languages.Laurel.LiftInstanceProcedures import Strata.Languages.Laurel.TypeAliasElim +import Strata.Languages.Laurel.EliminateExceptions public import Strata.Languages.Laurel.LaurelPass public import Strata.Languages.Core import Strata.Languages.Core.DDMTransform.ASTtoCST @@ -125,7 +126,15 @@ def laurelPipeline : Array LaurelPass := #[ desugarShortCircuitPass, liftExpressionAssignmentsPass, mergeAndLiftReturnsPass, - constrainedTypeElimPass + constrainedTypeElimPass, + -- E7: lower the exceptional channel (throw/try/catch/finally, throws/onThrow) + -- into ordinary Laurel (labeled blocks, exits, Result construction, and + -- postconditions over `$result`). Runs last: after heap parameterization (so + -- exceptions are heap `Composite` references and `is`-tests are lowered) and + -- after return/expression lifting (so it sees the same fully-lowered body the + -- Core translator used to). Needs a re-resolve so the synthesized `$thrown`/ + -- `$exc`/`$result` locals get uniqueIds. + eliminateExceptionsPass ] /-- Every `comesBefore` constraint is respected by the pipeline order. @@ -192,7 +201,13 @@ private def runLaurelPasses -- Run resolve after the pass if needed if pass.needsResolves then let result := resolve program (some model) - let newErrors := result.errors.filter fun e => !resolutionErrors.contains e + -- Only treat *new* post-pass resolution errors as an internal bug when the + -- program was well-formed to begin with. If initial resolution already + -- failed (or an earlier pass reported an error), the program is invalid + -- and translation is skipped regardless, so a lowering pass rewriting the + -- ill-typed fragment must not cascade a confusing `StrataBug` on top. + let hadErrors := !resolutionErrors.isEmpty || allDiags.any (fun d => d.type != .Warning) + let newErrors := if hadErrors then #[] else result.errors.filter fun e => !resolutionErrors.contains e if !newErrors.isEmpty then let newDiags := newErrors.toList.map fun d => { d with diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean index 1929ba2aa0..15a69ce74b 100644 --- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean +++ b/Strata/Languages/Laurel/LaurelToCoreTranslator.lean @@ -38,26 +38,6 @@ def isFieldName (fieldNames : List Identifier) (name : Identifier) : Bool := /-- Set of names that are translated to Core functions (not procedures) -/ @[expose] abbrev FunctionNames := List Identifier -/-- Per-`try` exit targets used while lowering a `try`/`catch`/`finally` (E3/E5, - F18). A `try` is lowered as two nested blocks: - ``` - block $tryfin { - block $try { } -- `throwTarget`: a `throw` in the body enters the catch chain - - } - -- reached by falling out of, or `exit`-ing, $tryfin - - ``` - - `throwTarget` is where an in-flight `throw` jumps: `$try` while lowering the - body (so the catch chain runs), `$tryfin` while lowering a catch handler (so - a re-throw skips the chain but still runs `finally`). - - `finallyTarget` (`$tryfin`) is where a `return` unwinds to so that `finally` - runs before control leaves the `try`. -/ -structure TryTarget where - throwTarget : String - finallyTarget : String - deriving Inhabited - /-- State threaded through expression and statement translation -/ structure TranslateState where /-- Diagnostics accumulated during translation -/ @@ -74,21 +54,6 @@ structure TranslateState where Used by the `.Old (Var (Local n))` arm to defensively check `n` against the procedure's inout list. Empty when not translating a procedure body. -/ currentProcInouts : List String := [] - /-- E7: whether the procedure currently being translated declares `throws`. - When `true`, the procedure returns a `Result` and has the - synthesized `$thrown`/`$exc` locals, so a `throw` lowers to setting those - and exiting (rather than reporting not-yet-implemented). -/ - currentProcThrows : Bool := false - /-- E7: set to `true` while translating a procedure body when a `throw` or - `try` is lowered. Signals that the `$thrown`/`$exc` locals must be declared - even in a procedure that does not itself declare `throws` (e.g. one whose - only exceptional construct is a `try` that catches locally). -/ - currentProcUsedExc : Bool := false - /-- E7/F18: stack of enclosing `try` exit targets, innermost first. A `throw` - (or a propagating call) exits to the head's `throwTarget`; a `return` exits - to the head's `finallyTarget` so pending `finally` arms run. When empty, - both fall back to `bodyLabel`, escaping the procedure. -/ - tryLabelStack : List TryTarget := [] /-- 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 @@ -110,42 +75,6 @@ private def invalidCoreType (source : Option FileRange) (reason : String) : Tran emitCoreDiagnostic (diagnosticFromSource source reason DiagnosticType.StrataBug) return .tcons s!"LaurelResolutionErrorPlaceholder" [] -/-! ### E7: exception-lowering names and helpers - -A throwing procedure lowers to one that returns a `Result` -(the generic datatype defined in the exception prelude). In-flight exception -state is carried by two synthesized locals, `$thrown` and `$exc`; after the -body block runs, the result is constructed (`Bad($exc)` when thrown, else -`Good(val)`). All names are `$`-prefixed, so they are outside the user -namespace (no source identifier can contain `$`). -/ - -/-- The generic result datatype's name (from `exceptionDefinitionsForLaurel`). -/ -private def resultDatatypeName : String := "Result" -/-- Synthesized Core output of a throwing procedure: its `Result`. -/ -private def resultVarName : String := "$result" -/-- Synthesized local: `true` once an exception is in flight. -/ -private def thrownVarName : String := "$thrown" -/-- Synthesized local: the in-flight exception value. -/ -private def excVarName : String := "$exc" -/-- Synthesized local (F18): `true` once a `return` is unwinding out of one or - more enclosing `try` blocks, so their `finally` arms run on the way out. A - `return` inside a `try` sets it and exits to the nearest `try` label (rather - than jumping straight to `bodyLabel`); each `try`'s tail re-checks it and - keeps unwinding to the next enclosing `try` (or `bodyLabel`). -/ -private def returningVarName : String := "$returning" - -/-- Core type of an in-flight exception value. After heap parameterization every - exception (a composite) is represented as a heap `Composite` reference, so - the `Err` component of the result is always `Composite` — the declared - `throws` type is not needed at this point. (Keyed on the same `"Composite"` - name the heap prelude uses; see `HeapParameterizationConstants`.) -/ -private def exceptionCoreTy : LMonoTy := .tcons "Composite" [] - -/-- Build a datatype constructor application `Ctor(arg)`, the same shape - `translateExpr` produces when lowering a `StaticCall` to a constructor. -/ -private def mkExceptionCtorApp (ctor : String) (arg : Core.Expression.Expr) : Core.Expression.Expr := - .app () (.op () ⟨ctor, ()⟩ none) arg - /- Translate Laurel HighType to Core Type -/ @@ -588,49 +517,10 @@ partial def translateStmt (stmt : StmtExprMd) -- Value (non-inout) targets receive the callee's genuine outputs. let valueLhs := lhs.filter (fun id => !calleeInoutNames.contains id.name) let outArgs : List (Core.CallArg Core.Expression) := valueLhs.map .outArg - let calleeProc? : Option Procedure := match model.get calleeId with - | .staticProcedure p => some p - | .instanceProcedure _ p => some p - | _ => none - match calleeProc? with - | some p => - if p.throwsType.isSome then - -- E7: a call to a procedure declaring `throws` returns a - -- `Result`. Bind it to a temp; if `Bad`, put the - -- error in flight and exit to the nearest `try` (or the body, to - -- escape); if `Good`, unwrap the value into the target. - let st ← get - if st.tryLabelStack.isEmpty && !st.currentProcThrows then - throwStmtDiagnostic $ md.toDiagnostic - s!"a call to throwing procedure '{calleeId.text}' whose exception could escape a procedure that does not declare `throws` is not yet supported (E4 no-escape enforcement)" - DiagnosticType.NotYetImplemented - else - modify fun s => { s with currentProcUsedExc := true } - let inNames := p.inputs.map (·.name) - let calleeValTy ← match p.outputs.filter (fun o => !inNames.contains o.name) with - | [o] => translateType o.type - | _ => pure LMonoTy.bool - let resTy : LMonoTy := .tcons resultDatatypeName [calleeValTy, exceptionCoreTy] - let tid ← freshId - let tmpId : Core.CoreIdent := ⟨s!"$callres_{tid}", ()⟩ - let tmpExpr : Core.Expression.Expr := .fvar () tmpId (some resTy) - let tmpInit := Core.Statement.init tmpId (LTy.forAll [] resTy) .nondet md - let callStmt := Core.Statement.call calleeId.text (callArgs ++ [.outArg tmpId]) md - let target := (st.tryLabelStack.head?.map (·.throwTarget)).getD bodyLabel - let badBranch : List Core.Statement := - [ Core.Statement.set ⟨excVarName, ()⟩ (mkExceptionCtorApp "Result..err" tmpExpr) md, - Core.Statement.set ⟨thrownVarName, ()⟩ (.const () (.boolConst true)) md, - Imperative.Stmt.exit target md ] - let goodBranch : List Core.Statement := match valueLhs with - | [vid] => [ Core.Statement.set vid (mkExceptionCtorApp "Result..value" tmpExpr) md ] - | _ => [] - let dispatch := Imperative.Stmt.ite (.det (mkExceptionCtorApp "Result..isBad" tmpExpr)) - badBranch goodBranch md - return inits ++ [tmpInit, callStmt, dispatch] - else - return inits ++ [Core.Statement.call calleeId.text (callArgs ++ outArgs) md] - | none => - return inits ++ [Core.Statement.call calleeId.text (callArgs ++ outArgs) md] + -- Calls to throwing procedures are rewritten to bind and unwrap a + -- `Result` by the `EliminateExceptions` pass, so by translation every + -- call is an ordinary (non-throwing) procedure call. + return inits ++ [Core.Statement.call calleeId.text (callArgs ++ outArgs) md] -- Match on the value to decide how to translate match _hv : value.val with | .StaticCall callee args => @@ -699,17 +589,10 @@ partial def translateStmt (stmt : StmtExprMd) | none => pure () | some _ => emitCoreDiagnostic $ md.toDiagnostic "Return statement with value should have been eliminated by EliminateValueReturns pass" DiagnosticType.StrataBug - -- F18: if this `return` is inside a `try`, exit to the nearest `try` label - -- (setting `$returning`) so that `try`'s `finally` runs on the way out; the - -- `try` tail re-checks `$returning` and keeps unwinding. With no enclosing - -- `try`, jump straight to `bodyLabel` as before. - let st ← get - match st.tryLabelStack.head? with - | none => return [.exit bodyLabel md] - | some entry => - modify fun s => { s with currentProcUsedExc := true } - return [ Core.Statement.set ⟨returningVarName, ()⟩ (.const () (.boolConst true)) md, - Imperative.Stmt.exit entry.finallyTarget md ] + -- A valueless `return` exits the procedure body block. (Routing a `return` + -- out of a `try` through pending `finally` arms is handled earlier by the + -- `EliminateExceptions` pass.) + return [.exit bodyLabel md] | .While cond invariants decreasesExpr body => let condExpr ← translateExpr cond let invExprs ← invariants.mapM (fun i => do return ("", ← translateExpr i)) @@ -730,95 +613,14 @@ partial def translateStmt (stmt : StmtExprMd) -- Hole in statement position: treat as havoc (no-op). -- This can occur when an unmodeled call's Block is flattened. return [] - | .Throw value => - -- E7: put the thrown value in flight (`$exc`), mark `$thrown`, and exit to - -- the nearest enclosing `try` label — or `bodyLabel` to escape the - -- procedure, where `translateProcedure` constructs `Bad($exc)`. - let st ← get - if st.tryLabelStack.isEmpty && !st.currentProcThrows then - -- A `throw` with no enclosing `try` that would escape a procedure not - -- declaring `throws` is the E4 no-escape violation; enforcement (and - -- lowering of the escape) lands with E7's contract check. - throwStmtDiagnostic $ md.toDiagnostic - "`throw` in a procedure that does not declare `throws` is not yet supported (E4 no-escape enforcement)" - DiagnosticType.NotYetImplemented - else - modify fun s => { s with currentProcUsedExc := true } - let ve ← translateExpr value - let target := (st.tryLabelStack.head?.map (·.throwTarget)).getD bodyLabel - return [ Core.Statement.set ⟨excVarName, ()⟩ ve md, - Core.Statement.set ⟨thrownVarName, ()⟩ (.const () (.boolConst true)) md, - Imperative.Stmt.exit target md ] - | .Try body catches finally? => - -- E7 (E3/E5/F18): lower `try B catch eᵢ when Pᵢ { Hᵢ } … finally { F }` with - -- two nested labeled blocks so `finally` runs on *every* exit edge: - -- - -- block $tryfin { - -- block $try { B } -- a `throw` in B exits $try → runs the catch chain - -- -- first-match-wins; a match clears `$thrown` - -- } - -- F -- reached by falling out of, or exiting, $tryfin - -- if $thrown then exit -- (re-)propagate - -- if $returning then exit -- keep unwinding - -- - -- A `throw` in B targets $try (so the catch chain runs); a `throw` in a - -- handler (re-throw) targets $tryfin (so it skips the chain but still runs - -- F). A `return` anywhere in B or a handler targets $tryfin, landing ahead - -- of F (the catch chain is guarded on `$thrown`, so a return skips it). - -- After F, the re-dispatch keeps a pending throw/return unwinding through - -- the enclosing `try` (so its F runs too), or to `$body` to leave the proc. - -- - -- The catch binding is bound to the in-flight value by substituting `$exc` - -- for it in each predicate/handler (rather than declaring a local). - modify fun s => { s with currentProcUsedExc := true } - let savedStack := (← get).tryLabelStack - let tryId ← freshId - let tryLbl := s!"$try_{tryId}" - let tryFinLbl := s!"$tryfin_{tryId}" - -- Body phase: a `throw` enters the catch chain ($try); a `return` runs - -- `finally` first ($tryfin). - modify fun s => { s with tryLabelStack := - { throwTarget := tryLbl, finallyTarget := tryFinLbl } :: savedStack } - let bStmts ← translateStmt body - -- Catch phase: a re-`throw` or `return` in a handler exits $tryfin, so it - -- skips the (remaining) catch chain but still runs `finally`. - modify fun s => { s with tryLabelStack := - { throwTarget := tryFinLbl, finallyTarget := tryFinLbl } :: savedStack } - let excFvar : Core.Expression.Expr := .fvar () ⟨excVarName, ()⟩ (some exceptionCoreTy) - let thrownFvar : Core.Expression.Expr := .fvar () ⟨thrownVarName, ()⟩ (some LMonoTy.bool) - let clauses ← catches.mapM (fun c => do - let pExpr ← match c.predicate with - | some p => - let pe ← translateExpr p - pure (LExpr.substFvar pe ⟨c.binding.text, ()⟩ excFvar) - | none => pure (.const () (.boolConst true)) - let hStmts ← translateStmt c.body - let hStmts := hStmts.map (fun s => Core.Statement.substFvar s ⟨c.binding.text, ()⟩ excFvar) - let guard := LExpr.mkApp () boolAndOp [thrownFvar, pExpr] - let handler := Core.Statement.set ⟨thrownVarName, ()⟩ (.const () (.boolConst false)) md :: hStmts - pure (guard, handler)) - let catchChain : List Core.Statement := - clauses.foldr - (fun gh elseB => [Imperative.Stmt.ite (.det gh.1) gh.2 elseB md]) - [] - -- Finally phase: a `throw`/`return` in F itself targets the enclosing `try`. - modify fun s => { s with tryLabelStack := savedStack } - let fStmts ← match finally? with - | some f => translateStmt f - | none => pure [] - -- Re-dispatch: after `finally`, keep any pending exception or return - -- unwinding to the enclosing `try` (running its `finally` too) or to - -- `$body`. `$thrown`/`$returning` are mutually exclusive on any one path. - let enclosing := savedStack.head? - let thrownExit := (enclosing.map (·.throwTarget)).getD bodyLabel - let returnExit := (enclosing.map (·.finallyTarget)).getD bodyLabel - let returningFvar : Core.Expression.Expr := .fvar () ⟨returningVarName, ()⟩ (some LMonoTy.bool) - let reDispatch : List Core.Statement := - [ Imperative.Stmt.ite (.det thrownFvar) [Imperative.Stmt.exit thrownExit md] [] md, - Imperative.Stmt.ite (.det returningFvar) [Imperative.Stmt.exit returnExit md] [] md ] - let tryFinBlock := Imperative.Stmt.block tryFinLbl - (Imperative.Stmt.block tryLbl bStmts md :: catchChain) md - return tryFinBlock :: (fStmts ++ reDispatch) + | .Throw _ => + -- The exceptional channel (throw/try/catch/finally) is lowered to ordinary + -- Laurel control flow by the `EliminateExceptions` pass before translation. + throwStmtDiagnostic $ md.toDiagnostic + "throw should have been eliminated by the EliminateExceptions pass" DiagnosticType.StrataBug + | .Try _ _ _ => + throwStmtDiagnostic $ md.toDiagnostic + "try/catch should have been eliminated by the EliminateExceptions pass" DiagnosticType.StrataBug | _ => -- Expression in statement position: preserve as an unused variable init exprAsUnusedInit stmt md @@ -849,69 +651,17 @@ def translateParameterToCore (param : Parameter) : TranslateM (Core.CoreIdent × let ty ← translateType param.type return (ident, ty) -/-- -E7: assemble a procedure's Core outputs and body statements. - -For a non-throwing procedure this is the usual single labeled body block. For a -throwing procedure (one declaring `throws`) the procedure instead returns a -single `Result` output: the normal output becomes an internal -local (assigned by return-elimination), `$thrown`/`$exc` track the in-flight -exception, and after the body block the result is constructed — `Bad($exc)` if -an exception is in flight, otherwise `Good(val)`. --/ +/-- Assemble a procedure's Core outputs and body: a single labeled body block so + early returns (`exit bodyLabel`) work. The exceptional channel — including a + throwing procedure's `Result` output and result construction — is lowered to + ordinary Laurel by the `EliminateExceptions` pass before translation, so + nothing exception-specific happens here. -/ private def buildProcedureOutputsAndBody - (proc : Procedure) (procThrows : Bool) (bodyStmts : List Core.Statement) + (proc : Procedure) (bodyStmts : List Core.Statement) : TranslateM (List (Core.CoreIdent × LMonoTy) × List Core.Statement) := do let bodyBlock : Core.Statement := .block bodyLabel bodyStmts mdWithUnknownLoc - -- The `$thrown`/`$exc` locals are needed whenever the body uses the exceptional - -- channel: a throwing procedure always does, and a non-throwing one does if it - -- lowered a `throw`/`try` (recorded in `currentProcUsedExc`). - let usedExc := (← get).currentProcUsedExc - let excStateInit : List Core.Statement := - if procThrows || usedExc then - [ Core.Statement.init ⟨thrownVarName, ()⟩ (LTy.forAll [] LMonoTy.bool) - (.det (.const () (.boolConst false))) mdWithUnknownLoc, - Core.Statement.init ⟨excVarName, ()⟩ (LTy.forAll [] exceptionCoreTy) - .nondet mdWithUnknownLoc, - -- F18: `$returning` tracks a `return` unwinding through enclosing `try` - -- blocks so their `finally` arms run. Declared whenever the exceptional - -- channel is used (every `try` sets `currentProcUsedExc`). - Core.Statement.init ⟨returningVarName, ()⟩ (LTy.forAll [] LMonoTy.bool) - (.det (.const () (.boolConst false))) mdWithUnknownLoc ] - else [] - if !procThrows then - let outputs ← proc.outputs.mapM translateParameterToCore - return (outputs, excStateInit ++ [bodyBlock]) - -- Throwing procedure: return a single `Result`, but keep any - -- inout outputs (a parameter appearing in both inputs and outputs — notably - -- the heap `$heap` added by heap parameterization, needed by the two-state - -- `old($heap)` postcondition). Only the genuine *value* return is folded into - -- the `Result`. - let inputNames := proc.inputs.map (·.name) - let inoutOutputs := proc.outputs.filter (fun o => inputNames.contains o.name) - let valueOutputs := proc.outputs.filter (fun o => !inputNames.contains o.name) - let coreInoutOutputs ← inoutOutputs.mapM translateParameterToCore - let valTy ← match valueOutputs with - | [outParam] => translateType outParam.type - | _ => pure LMonoTy.bool -- no value output (void): unit placeholder, matching TVoid - let resultTy : LMonoTy := .tcons resultDatatypeName [valTy, exceptionCoreTy] - let resultIdent : Core.CoreIdent := ⟨resultVarName, ()⟩ - let excIdent : Core.CoreIdent := ⟨excVarName, ()⟩ - -- The value output becomes a local the body assigns via return-elimination; - -- capture it to wrap in `Good` on the normal path (unit placeholder if none). - let (origOutInit, goodArg) ← - match valueOutputs with - | [outParam] => - let outIdent : Core.CoreIdent := ⟨outParam.name.text, ()⟩ - pure (([Core.Statement.init outIdent (LTy.forAll [] valTy) .nondet mdWithUnknownLoc] : List Core.Statement), - ((.fvar () outIdent (some valTy)) : Core.Expression.Expr)) - | _ => pure (([] : List Core.Statement), ((.const () (.boolConst true)) : Core.Expression.Expr)) - let construct : Core.Statement := - Imperative.Stmt.ite (.det (.fvar () ⟨thrownVarName, ()⟩ (some LMonoTy.bool))) - [ Core.Statement.set resultIdent (mkExceptionCtorApp "Bad" (.fvar () excIdent (some exceptionCoreTy))) mdWithUnknownLoc ] - [ Core.Statement.set resultIdent (mkExceptionCtorApp "Good" goodArg) mdWithUnknownLoc ] - mdWithUnknownLoc - return (coreInoutOutputs ++ [(resultIdent, resultTy)], excStateInit ++ origOutInit ++ [bodyBlock, construct]) + let outputs ← proc.outputs.mapM translateParameterToCore + return (outputs, [bodyBlock]) /-- Translate Laurel Procedure to Core Procedure using `TranslateM`. @@ -920,16 +670,10 @@ are emitted into the monad state. -/ def translateProcedure (proc : Procedure) : TranslateM Core.Procedure := do -- Track inout parameter names for the `.Old (Var (Local n))` defensive check. - -- `currentProcThrows` (E7) records whether this procedure declares `throws`, - -- so `throw` in its body lowers to `$thrown`/`$exc` + exit; the try-label - -- stack is reset per procedure. All are set fresh here (implicitly resetting - -- any leftover state from a sibling procedure). - let procThrows := proc.throwsType.isSome - modify fun s => { s with - currentProcInouts := procInoutNames proc - currentProcThrows := procThrows - currentProcUsedExc := false - tryLabelStack := [] } + -- (The exceptional channel — `throws`/`onThrow`/`when-throws` and the `Result` + -- lowering — is handled by the `EliminateExceptions` pass, so by translation a + -- procedure has ordinary outputs and ordinary postconditions.) + modify fun s => { s with currentProcInouts := procInoutNames proc } let inputs ← proc.inputs.mapM translateParameterToCore -- Translate preconditions let preconditions ← translateChecks proc.preconditions "requires" false @@ -945,85 +689,17 @@ def translateProcedure (proc : Procedure) : TranslateM Core.Procedure := do | _ => pure none - -- E4/E7: a throwing procedure's Core output is a single `Result` - -- (`$result`). Normal (`ensures`) postconditions describe the *Good* path only, - -- and the `onThrow` clauses describe the *Bad* path. Build the `Result` - -- projections used to phrase both as ordinary Core postconditions so the - -- exceptional contract is checked on exit and assumed at call sites. - let inputNames := proc.inputs.map (·.name) - let valueOutputs := proc.outputs.filter (fun o => !inputNames.contains o.name) - -- E7 limitation: a throwing procedure lowers to a single `Result` - -- output, so it can carry at most one value output on the Good path. Reject a - -- multi-value-output thrower loudly rather than silently degrading `Val` to a - -- `bool` placeholder (which would misrepresent the result). - if procThrows && valueOutputs.length >= 2 then - emitCoreDiagnostic (diagnosticFromSource proc.name.source - s!"throwing procedure '{proc.name.text}' has {valueOutputs.length} value outputs; a procedure declaring `throws` may have at most one value output (its result is a single `Result` value). Combine the outputs (e.g. into a composite) or drop the `throws` clause." - DiagnosticType.NotYetImplemented) - let valTy ← match valueOutputs with - | [outParam] => translateType outParam.type - | _ => pure LMonoTy.bool - let resultTy : LMonoTy := .tcons resultDatatypeName [valTy, exceptionCoreTy] - let resultFvar : Core.Expression.Expr := .fvar () ⟨resultVarName, ()⟩ (some resultTy) - let mkResultApp (fn : String) : Core.Expression.Expr := mkExceptionCtorApp fn resultFvar - -- Good-path wrapper: guard a normal postcondition with `Result..isGood($result)` - -- and rewrite the (single) value output to `Result..value($result)`. Identity - -- for a non-throwing procedure. - let goodWrap (e : Core.Expression.Expr) : Core.Expression.Expr := - if procThrows then - let e' := match valueOutputs with - | [o] => LExpr.substFvar e ⟨o.name.text, ()⟩ (mkResultApp "Result..value") - | _ => e - .ite () (mkResultApp "Result..isGood") e' (.boolConst () true) - else e -- Translate postconditions for Opaque and Abstract bodies. A bodiless -- procedure (bodyStmts = none) gets its postconditions marked `free` -- (overrideFree) so they are assumed, not checked — and an empty body. let postconditions : ListMap Core.CoreLabel Core.Procedure.Check ← match proc.body with | .Opaque postconds _ _ | .Abstract postconds => - translateChecks postconds s!"postcondition" bodyStmts.isNone (wrap := goodWrap) + translateChecks postconds s!"postcondition" bodyStmts.isNone | _ => pure [] - -- E4: `onThrow` exceptional postconditions constrain the Bad path. Each is - -- `Result..isBad($result) ==> P[binding := Result..err($result)]`, mirroring the - -- `catch`-binding substitution in the `try` lowering. Checked on exit when the - -- procedure has a body; assumed (free) for a bodiless procedure. - let onThrowChecks : ListMap Core.CoreLabel Core.Procedure.Check ← - if procThrows then - proc.onThrow.mapIdxM (fun i c => do - let pe ← translateExpr c.predicate - let pe' := LExpr.substFvar pe ⟨c.binding.text, ()⟩ (mkResultApp "Result..err") - let guarded : Core.Expression.Expr := - .ite () (mkResultApp "Result..isBad") pe' (.boolConst () true) - let label := if proc.onThrow.length == 1 then "onThrow" else s!"onThrow_{i}" - let attr := if bodyStmts.isNone then Core.Procedure.CheckAttr.Free else .Default - let md := astNodeToCoreMd c.predicate - pure (label, ({ expr := guarded, attr, md } : Core.Procedure.Check))) - else pure [] - let postconditions := postconditions.union onThrowChecks - -- E4: `when C throws (e) P` behavior cases constrain *when* the Bad path is taken - -- and what then holds. Each lowers to `C ==> (Result..isBad($result) ∧ - -- P[e := Result..err($result)])`: so a caller can conclude the procedure throws - -- when `C` holds and that `P` holds of the thrown value. Checked on exit when - -- the procedure has a body; assumed (free) for a bodiless procedure. - let onThrowsChecks : ListMap Core.CoreLabel Core.Procedure.Check ← - if procThrows then - proc.onThrows.mapIdxM (fun i c => do - let ce ← translateExpr c.condition [] (isPureContext := true) - let pe ← translateExpr c.postcondition [] (isPureContext := true) - let pe' := LExpr.substFvar pe ⟨c.binding.text, ()⟩ (mkResultApp "Result..err") - let conj := LExpr.mkApp () boolAndOp [mkResultApp "Result..isBad", pe'] - let guarded : Core.Expression.Expr := .ite () ce conj (.boolConst () true) - let label := if proc.onThrows.length == 1 then "onThrows" else s!"onThrows_{i}" - let attr := if bodyStmts.isNone then Core.Procedure.CheckAttr.Free else .Default - let md := astNodeToCoreMd c.condition - pure (label, ({ expr := guarded, attr, md } : Core.Procedure.Check))) - else pure [] - let postconditions := postconditions.union onThrowsChecks - -- Assemble outputs + body: a labeled block so early returns (exit) work, plus - -- the `Result` wrapping for throwing procedures (E7). `bodyLabel` is the - -- shared "$body" constant the resolver pre-registers. - let (outputs, body) ← buildProcedureOutputsAndBody proc procThrows (bodyStmts.getD []) + -- Assemble outputs + body: a labeled block so early returns (exit) work. + -- `bodyLabel` is the shared "$body" constant the resolver pre-registers. + let (outputs, body) ← buildProcedureOutputsAndBody proc (bodyStmts.getD []) let header : Core.Procedure.Header := { name := proc.name.text typeArgs := [] diff --git a/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean b/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean new file mode 100644 index 0000000000..f73ce0ca79 --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean @@ -0,0 +1,354 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata +open Strata.Laurel + +/- +Reviewability test for the `EliminateExceptions` pass (E7). + +The exceptional channel — `throw`, `try`/`catch`/`finally`, and the +`throws`/`onThrow`/`when-throws` procedure contract — is lowered to ordinary +Laurel by a single Laurel-to-Laurel pass (`EliminateExceptions`) rather than +inside the final Core translator. Each `#eval` below runs the pipeline on a +small program and prints the Laurel *before* and *after* that pass, so the +transformation is reviewable as Laurel-to-Laurel. + +The cases build up from minimal to complex, each isolating one feature: + + 1. a bare `throw` in a `throws` procedure — signature → `Result`, `$thrown`/`$exc`, `Bad`/`Good` + 2. `onThrow` contract — exceptional postcondition over `$result` + 3. a local `try`/`catch` — labeled blocks + guarded catch chain + 4. a call to a throwing procedure — bind/unwrap `Result`, propagate on `Bad` + 5. `finally` + `return` (F18) — `$returning` + re-dispatch runs `finally` + 6. multi-clause `catch` + `finally` — first-match-wins chain (each match clears `$thrown`) + +Notes: + - The pass runs after heap parameterization, so the snapshots are the + heap-parameterized form (exceptions are heap `Composite` references, `is` + tests are already lowered). + - The shared prelude and datatype declarations (`Heap`/`Composite`/`Result`/…) + are identical before and after, so the printout is trimmed to the + procedures — the only declarations the pass rewrites. + - Each case also asserts that the surface exceptional keywords + (`throw`/`catch`/`onThrow`/`throws`) are gone afterward, replaced by the + `$thrown`/`$exc`/`Result` encoding. +-/ + +/-- Substring containment. -/ +private def containsSub (haystack needle : String) : Bool := + (haystack.splitOn needle).length > 1 + +/-- Drop the (unchanged) prelude/datatype preamble, keeping only the procedures + — the declarations the pass actually rewrites. -/ +private def procsOnly (s : String) : String := + "\n".intercalate ((s.splitOn "\n").dropWhile (fun l => !l.startsWith "procedure ")) + +/-- Run the pipeline on `prog`, printing the procedures before and after the + `EliminateExceptions` pass, then assert the surface exceptional keywords are + gone afterward. -/ +private def showCase (title : String) (prog : StrataDDM.Program) : IO Unit := do + let laurel ← translateLaurel prog + IO.FS.withTempDir fun dir => do + let pfx := (dir / "step").toString + let _ ← translateWithLaurel { keepAllFilesPrefix := some pfx } laurel + let entries ← dir.readDir + let readSuffix (suffix : String) : IO String := do + match entries.find? (fun e => e.fileName.endsWith suffix) with + | some e => IO.FS.readFile e.path + | none => throw (IO.userError s!"expected an emitted file ending in '{suffix}'") + -- `EliminateExceptions` is the last Laurel pass; the pass just before it is + -- `ConstrainedTypeElim`, whose emitted program is its input ("before"). + let before ← readSuffix ".ConstrainedTypeElim.laurel.st" + let after ← readSuffix ".EliminateExceptions.laurel.st" + IO.println s!"══════════════════════════════════════════════════════════" + IO.println s!"CASE {title}" + IO.println s!"══════════════════════════════════════════════════════════" + IO.println "----- BEFORE (procedures) -----" + IO.println (procsOnly before) + IO.println "----- AFTER (procedures) -----" + IO.println (procsOnly after) + for kw in ["throw ", "catch", "onThrow", "throws"] do + if containsSub after kw then + throw (IO.userError s!"CASE {title}: 'after' program should not contain '{kw}'") + +-- 1. Minimal: a bare `throw` in a `throws` procedure (void return). Shows the +-- signature rewrite to `Result` (bool placeholder for void), +-- the `$thrown`/`$exc` locals, and the `Bad`/`Good` construction. +-- +-- Java equivalent: +-- void validate() throws ValidationException { +-- ValidationException error = new ValidationException(); +-- throw error; +-- } +#eval showCase "1 — minimal throw (void return)" <| StrataDDM.SourcedProgram.program <| +#strata +program Laurel; +composite ValidationException extends BaseException {} +procedure validate() + throws ValidationException + opaque +{ + var error: ValidationException := new ValidationException; + throw error +}; +#end + +-- 2. `onThrow` contract: the exceptional postcondition becomes an ordinary +-- `ensures Result..isBad($result) ==> …` over the result. +-- +-- Java equivalent: +-- int parsePositive(int input) throws NegativeInputException { +-- if (input < 0) throw new NegativeInputException(); +-- return input; +-- } +-- // contract: if it throws, then input < 0 held. +#eval showCase "2 — onThrow contract + value output" <| StrataDDM.SourcedProgram.program <| +#strata +program Laurel; +composite NegativeInputException extends BaseException {} +procedure parsePositive(input: int) + returns (result: int) + throws NegativeInputException + onThrow (e) input < 0 + opaque +{ + if input < 0 then { + var error: NegativeInputException := new NegativeInputException; + throw error + }; + result := input +}; +#end + +-- 3. A local `try`/`catch`: the procedure catches its own throw, so it stays +-- non-throwing. Shows the two-label `$try`/`$tryfin` blocks and the guarded +-- catch chain (a match clears `$thrown`). +-- +-- Java equivalent: +-- int loadSetting() { +-- ConfigError error = new ConfigError(); +-- int value = 0; +-- try { throw error; } +-- catch (ConfigError caught) { value = 2; } +-- return value; +-- } +#eval showCase "3 — local try/catch" <| StrataDDM.SourcedProgram.program <| +#strata +program Laurel; +composite ConfigError extends BaseException {} +procedure loadSetting() + returns (value: int) + opaque +{ + var error: ConfigError := new ConfigError; + value := 0; + try { + throw error; + value := 1 + } catch caught when caught is ConfigError { + value := 2 + } +}; +#end + +-- 4. A call to a throwing procedure that is propagated (the caller also declares +-- `throws`). Shows the multi-target `[$heap, $callres] := fetchRecord(…)` bind, +-- the `Result..isBad` propagation, and the `Result..value` unwrap. +-- +-- Java equivalent: +-- int fetchRecord(int id) throws NotFoundException { +-- if (id < 0) throw new NotFoundException(); +-- return id; +-- } +-- int loadUser(int id) throws NotFoundException { // doesn't catch → propagates +-- return fetchRecord(id); +-- } +#eval showCase "4 — call a thrower + propagate" <| StrataDDM.SourcedProgram.program <| +#strata +program Laurel; +composite NotFoundException extends BaseException {} +procedure fetchRecord(id: int) returns (result: int) throws NotFoundException opaque { + if id < 0 then { + var error: NotFoundException := new NotFoundException; + throw error + }; + result := id +}; +procedure loadUser(id: int) returns (result: int) throws NotFoundException opaque { + result := fetchRecord(id) +}; +#end + +-- 5. `finally` + `return` (F18): the `return` unwinds through the `try`, so the +-- `$returning` flag and the post-`finally` re-dispatch make `finally` run +-- before the procedure exits. +-- +-- Java equivalent: +-- int closeAndReturn() { +-- int status = 0; +-- try { return status; } +-- finally { status = 5; } // runs on the way out +-- } +#eval showCase "5 — finally runs on return (F18)" <| StrataDDM.SourcedProgram.program <| +#strata +program Laurel; +procedure closeAndReturn() + returns (status: int) + opaque +{ + status := 0; + try { + return + } finally { + status := 5 + } +}; +#end + +-- 6. More complex: two throws dispatched by a multi-clause `catch` (first-match +-- wins) with a `finally`. Shows the sequential guarded catch chain plus the +-- re-dispatch after `finally`. +-- +-- Java equivalent: +-- int parseDocument(int input) { +-- SyntaxError syntaxError = new SyntaxError(); +-- IoError ioError = new IoError(); +-- int result = 0; +-- try { +-- if (input < 0) throw syntaxError; +-- if (input == 0) throw ioError; +-- result = input; +-- } catch (SyntaxError caught) { result = -1; } +-- catch (IoError caught) { result = -2; } +-- finally { result = result + 100; } +-- return result; +-- } +#eval showCase "6 — multi-clause catch + finally" <| StrataDDM.SourcedProgram.program <| +#strata +program Laurel; +composite SyntaxError extends BaseException {} +composite IoError extends BaseException {} +procedure parseDocument(input: int) + returns (result: int) + opaque +{ + var syntaxError: SyntaxError := new SyntaxError; + var ioError: IoError := new IoError; + result := 0; + try { + if input < 0 then { + throw syntaxError + }; + if input == 0 then { + throw ioError + }; + result := input + } catch caught when caught is SyntaxError { + result := -1 + } catch caught when caught is IoError { + result := -2 + } finally { + result := result + 100 + } +}; +#end + +-- 7. `when C throws (e) P` behavior case: the trigger + exceptional +-- postcondition becomes `C ==> (Result..isBad($result) ∧ P[e := err])` — so a +-- caller can conclude a throw *will* happen when `C` holds. +-- +-- Java equivalent: +-- int divide(int a, int b) throws ArithmeticException { +-- if (b == 0) throw new ArithmeticException(); +-- return a / b; +-- } +-- // behavior case: when b == 0, divide throws an ArithmeticException. +#eval showCase "7 — when C throws (e) P behavior case" <| StrataDDM.SourcedProgram.program <| +#strata +program Laurel; +composite ArithmeticException extends BaseException {} +procedure divide(a: int, b: int) + returns (result: int) + throws ArithmeticException + when b == 0 throws (e) e is ArithmeticException + opaque +{ + if b == 0 then { + var error: ArithmeticException := new ArithmeticException; + throw error + }; + result := a / b +}; +#end + +-- 8. Re-throw from inside a `catch`, with a `finally` (the two-label case): the +-- handler's `throw` targets `$tryfin` (skipping the rest of the catch chain +-- but still running `finally`), then the re-dispatch propagates it out. +-- +-- Java equivalent: +-- int retry() throws NetworkError { +-- NetworkError error = new NetworkError(); +-- int r = 0; +-- try { throw error; } +-- catch (NetworkError caught) { throw caught; } // re-throw +-- finally { r = 7; } +-- } +#eval showCase "8 — re-throw from catch + finally" <| StrataDDM.SourcedProgram.program <| +#strata +program Laurel; +composite NetworkError extends BaseException {} +procedure retry() + returns (r: int) + throws NetworkError + opaque +{ + var error: NetworkError := new NetworkError; + r := 0; + try { + throw error + } catch caught when caught is NetworkError { + throw caught + } finally { + r := 7 + } +}; +#end + +-- 9. Nested `try`/`finally`: a `return` in the innermost body unwinds through +-- both `finally` arms (inner then outer). Shows the nested `$try`/`$tryfin` +-- blocks and the re-dispatch chaining `$returning` outward. +-- +-- Java equivalent: +-- int nested() { +-- int log = 0; +-- try { +-- try { return log; } +-- finally { log = log + 1; } +-- } finally { log = log + 2; } +-- } +#eval showCase "9 — nested try/finally (return unwinds both)" <| StrataDDM.SourcedProgram.program <| +#strata +program Laurel; +procedure nested() + returns (log: int) + opaque +{ + log := 0; + try { + try { + return + } finally { + log := log + 1 + } + } finally { + log := log + 2 + } +}; +#end From 74e46b9b5031813f8bffce42638134a3f55f378b Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Thu, 9 Jul 2026 11:54:34 +0000 Subject: [PATCH 23/28] test(laurel): golden before/after test for EliminateExceptions pass Following the StrataTest/Transform/PrecondElim convention: each case's input is an authored #strata program (the before), and the pass output is pinned with #guard_msgs (the after), so the effect of the pass is explicitly captured and a regression fails the test. The pass is run in isolation on the resolved surface program, keeping the snapshots free of heap-parameterization plumbing (the heap-interaction path is covered by the pipeline verifying tests). Covers onThrow, when-throws, call+catch, finally-on-return (F18), re-throw from catch, nested try/finally, and multi-clause catch. --- .../Objects/EliminateExceptionsPass.lean | 652 +++++++++++------- 1 file changed, 388 insertions(+), 264 deletions(-) diff --git a/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean b/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean index f73ce0ca79..3557edf010 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean @@ -11,192 +11,183 @@ open Strata open Strata.Laurel /- -Reviewability test for the `EliminateExceptions` pass (E7). - -The exceptional channel — `throw`, `try`/`catch`/`finally`, and the -`throws`/`onThrow`/`when-throws` procedure contract — is lowered to ordinary -Laurel by a single Laurel-to-Laurel pass (`EliminateExceptions`) rather than -inside the final Core translator. Each `#eval` below runs the pipeline on a -small program and prints the Laurel *before* and *after* that pass, so the -transformation is reviewable as Laurel-to-Laurel. - -The cases build up from minimal to complex, each isolating one feature: - - 1. a bare `throw` in a `throws` procedure — signature → `Result`, `$thrown`/`$exc`, `Bad`/`Good` - 2. `onThrow` contract — exceptional postcondition over `$result` - 3. a local `try`/`catch` — labeled blocks + guarded catch chain - 4. a call to a throwing procedure — bind/unwrap `Result`, propagate on `Bad` - 5. `finally` + `return` (F18) — `$returning` + re-dispatch runs `finally` - 6. multi-clause `catch` + `finally` — first-match-wins chain (each match clears `$thrown`) - -Notes: - - The pass runs after heap parameterization, so the snapshots are the - heap-parameterized form (exceptions are heap `Composite` references, `is` - tests are already lowered). - - The shared prelude and datatype declarations (`Heap`/`Composite`/`Result`/…) - are identical before and after, so the printout is trimmed to the - procedures — the only declarations the pass rewrites. - - Each case also asserts that the surface exceptional keywords - (`throw`/`catch`/`onThrow`/`throws`) are gone afterward, replaced by the - `$thrown`/`$exc`/`Result` encoding. +Golden test for the `EliminateExceptions` pass (E7), in the style of +`StrataTest/Transform/PrecondElim`: each case's *before* is an authored +`#strata` program (a `def`), and the *after* is the pass's output, pinned by +`#guard_msgs`. The pass is re-run on every build and its formatted output is +compared against the pinned expectation, so a regression fails the test. + +## How this runs the pass + +`runPass` resolves the surface program and runs *only* the +`EliminateExceptions` pass on it (`resolve` + `eliminateExceptionsTransform`), +not the full pipeline. Running it directly on the surface program keeps the +output clean: heap parameterization has not run, so exception values are not yet +heap `Composite` references, there is no `$heap` threading or `modifies`-clause +noise, and a `catch … is T` guard shows as the surface `$exc is T` rather than +the lowered type-tag test. This isolates the pass's own rewrite — the same +reason the `Transform/*` tests run a single transform on a hand-written program. + +The pass's interaction with heap parameterization (notably threading the inout +`$heap` through a throwing call) is therefore *not* exercised here; that path is +covered by the full-pipeline verifying tests (`TryHeapCalls`, +`ThrowsPostconditions`, `TryCatchBehavior`, …). Output is trimmed to the +procedures (the shared prelude/datatype declarations are unchanged by the pass). -/ -/-- Substring containment. -/ -private def containsSub (haystack needle : String) : Bool := - (haystack.splitOn needle).length > 1 - -/-- Drop the (unchanged) prelude/datatype preamble, keeping only the procedures - — the declarations the pass actually rewrites. -/ -private def procsOnly (s : String) : String := - "\n".intercalate ((s.splitOn "\n").dropWhile (fun l => !l.startsWith "procedure ")) - -/-- Run the pipeline on `prog`, printing the procedures before and after the - `EliminateExceptions` pass, then assert the surface exceptional keywords are - gone afterward. -/ -private def showCase (title : String) (prog : StrataDDM.Program) : IO Unit := do - let laurel ← translateLaurel prog - IO.FS.withTempDir fun dir => do - let pfx := (dir / "step").toString - let _ ← translateWithLaurel { keepAllFilesPrefix := some pfx } laurel - let entries ← dir.readDir - let readSuffix (suffix : String) : IO String := do - match entries.find? (fun e => e.fileName.endsWith suffix) with - | some e => IO.FS.readFile e.path - | none => throw (IO.userError s!"expected an emitted file ending in '{suffix}'") - -- `EliminateExceptions` is the last Laurel pass; the pass just before it is - -- `ConstrainedTypeElim`, whose emitted program is its input ("before"). - let before ← readSuffix ".ConstrainedTypeElim.laurel.st" - let after ← readSuffix ".EliminateExceptions.laurel.st" - IO.println s!"══════════════════════════════════════════════════════════" - IO.println s!"CASE {title}" - IO.println s!"══════════════════════════════════════════════════════════" - IO.println "----- BEFORE (procedures) -----" - IO.println (procsOnly before) - IO.println "----- AFTER (procedures) -----" - IO.println (procsOnly after) - for kw in ["throw ", "catch", "onThrow", "throws"] do - if containsSub after kw then - throw (IO.userError s!"CASE {title}: 'after' program should not contain '{kw}'") - --- 1. Minimal: a bare `throw` in a `throws` procedure (void return). Shows the --- signature rewrite to `Result` (bool placeholder for void), --- the `$thrown`/`$exc` locals, and the `Bad`/`Good` construction. --- --- Java equivalent: --- void validate() throws ValidationException { --- ValidationException error = new ValidationException(); --- throw error; --- } -#eval showCase "1 — minimal throw (void return)" <| StrataDDM.SourcedProgram.program <| -#strata -program Laurel; -composite ValidationException extends BaseException {} -procedure validate() - throws ValidationException - opaque -{ - var error: ValidationException := new ValidationException; - throw error -}; -#end +/-- Strip trailing spaces from a line (the pretty-printer emits e.g. `return ` + with a trailing space; keeping it would break the golden and trip the repo's + trailing-whitespace lint). -/ +private def rstrip (l : String) : String := + String.ofList (l.toList.reverse.dropWhile (· == ' ')).reverse + +/-- Format a program, keeping only the procedures (dropping the unchanged + prelude/datatype preamble), right-trimming lines and trailing blanks. -/ +private def fmtProcs (p : Program) : Std.Format := + let s := (Std.format p).pretty + let kept := ((s.splitOn "\n").dropWhile (fun l => !l.startsWith "procedure ")).map rstrip + Std.format ("\n".intercalate (kept.reverse.dropWhile (·.isEmpty)).reverse) + +/-- Parse a `#strata` program into a Laurel program (pure; panics on a parse + error, which cannot happen for the well-formed literals below). -/ +private def parseLaurel (t : StrataDDM.Program) : Program := + match Laurel.TransM.run (Strata.Uri.file "<#strata>") (Laurel.parseProgram t) with + | .ok p => p + | .error e => panic! s!"parse failed: {e}" -- nopanic:ok + +/-- Resolve the surface program (with the preludes prepended, as the pipeline + does) and run *only* the `EliminateExceptions` pass on it. -/ +private def runPass (b : StrataDDM.SourcedProgram) : Program := + let program := parseLaurel b.program + let program := { program with + staticProcedures := coreDefinitionsForLaurel.staticProcedures ++ program.staticProcedures, + types := coreDefinitionsForLaurel.types ++ program.types } + let program := + if (referencedNames program).contains baseExceptionTypeName then + { program with types := exceptionDefinitionsForLaurel.types ++ program.types } + else program + let result := resolve program + (eliminateExceptionsTransform result.model result.program).1 --- 2. `onThrow` contract: the exceptional postcondition becomes an ordinary --- `ensures Result..isBad($result) ==> …` over the result. --- --- Java equivalent: --- int parsePositive(int input) throws NegativeInputException { --- if (input < 0) throw new NegativeInputException(); --- return input; --- } --- // contract: if it throws, then input < 0 held. -#eval showCase "2 — onThrow contract + value output" <| StrataDDM.SourcedProgram.program <| +/-! ### 1. `onThrow` contract on a bodiless (contract-only) thrower + +The `throws` clause makes the result a `Result`, and `onThrow` becomes an +ordinary postcondition `Result..isBad($result) ==> …`. -/ + +def onThrowContract : StrataDDM.SourcedProgram := #strata program Laurel; composite NegativeInputException extends BaseException {} procedure parsePositive(input: int) returns (result: int) throws NegativeInputException - onThrow (e) input < 0 + onThrow (e) input < 0; +#end + +/-- +info: procedure parsePositive(input: int) + returns ($result: (Result)) opaque -{ - if input < 0 then { - var error: NegativeInputException := new NegativeInputException; - throw error - }; - result := input -}; + ensures Result..isBad($result) ==> input < 0; +-/ +#guard_msgs in +#eval (fmtProcs (runPass onThrowContract)) + +/-! ### 2. `when C throws (e) P` behavior case (bodiless) + +Becomes `C ==> (Result..isBad($result) ∧ P[e := err])`. -/ + +def whenThrows : StrataDDM.SourcedProgram := +#strata +program Laurel; +composite ArithmeticException extends BaseException {} +procedure divide(a: int, b: int) + returns (result: int) + throws ArithmeticException + when b == 0 throws (e) e is ArithmeticException; #end --- 3. A local `try`/`catch`: the procedure catches its own throw, so it stays --- non-throwing. Shows the two-label `$try`/`$tryfin` blocks and the guarded --- catch chain (a match clears `$thrown`). --- --- Java equivalent: --- int loadSetting() { --- ConfigError error = new ConfigError(); --- int value = 0; --- try { throw error; } --- catch (ConfigError caught) { value = 2; } --- return value; --- } -#eval showCase "3 — local try/catch" <| StrataDDM.SourcedProgram.program <| +/-- +info: procedure divide(a: int, b: int) + returns ($result: (Result)) + opaque + ensures b == 0 ==> Result..isBad($result) & Result..err($result) is ArithmeticException; +-/ +#guard_msgs in +#eval (fmtProcs (runPass whenThrows)) + +/-! ### 3. A call to a throwing procedure inside `try`/`catch` + +Bind and unwrap its `Result`, propagate on `Bad`, and a guarded catch clause. -/ + +def callAndCatch : StrataDDM.SourcedProgram := #strata program Laurel; -composite ConfigError extends BaseException {} -procedure loadSetting() - returns (value: int) +composite NotFoundException extends BaseException {} +procedure fetchRecord(id: int) returns (result: int) throws NotFoundException; +procedure loadUser(id: int) + returns (result: int) opaque { - var error: ConfigError := new ConfigError; - value := 0; try { - throw error; - value := 1 - } catch caught when caught is ConfigError { - value := 2 + result := fetchRecord(id) + } catch caught when caught is NotFoundException { + result := 0 } }; #end --- 4. A call to a throwing procedure that is propagated (the caller also declares --- `throws`). Shows the multi-target `[$heap, $callres] := fetchRecord(…)` bind, --- the `Result..isBad` propagation, and the `Result..value` unwrap. --- --- Java equivalent: --- int fetchRecord(int id) throws NotFoundException { --- if (id < 0) throw new NotFoundException(); --- return id; --- } --- int loadUser(int id) throws NotFoundException { // doesn't catch → propagates --- return fetchRecord(id); --- } -#eval showCase "4 — call a thrower + propagate" <| StrataDDM.SourcedProgram.program <| -#strata -program Laurel; -composite NotFoundException extends BaseException {} -procedure fetchRecord(id: int) returns (result: int) throws NotFoundException opaque { - if id < 0 then { - var error: NotFoundException := new NotFoundException; - throw error - }; - result := id -}; -procedure loadUser(id: int) returns (result: int) throws NotFoundException opaque { - result := fetchRecord(id) +/-- +info: procedure fetchRecord(id: int) + returns ($result: (Result)) + opaque; + +procedure loadUser(id: int): int + opaque +{ + var $thrown: bool := false; + var $exc: Composite; + var $returning: bool := false; + { + { + { + { + { + var $callres_1: (Result) := fetchRecord(id); + if Result..isBad($callres_1) then { + $exc := Result..err($callres_1); + $thrown := true; + exit $try_0 + }; + result := Result..value($callres_1) + } + }$try_0; + if $thrown & $exc is NotFoundException then { + $thrown := false; + { + result := 0 + } + } + }$tryfin_0; + if $thrown then { + exit $exnexit + }; + if $returning then { + exit $exnexit + } + } + }$exnexit }; -#end +-/ +#guard_msgs in +#eval (fmtProcs (runPass callAndCatch)) + +/-! ### 4. `finally` runs on `return` (F18) --- 5. `finally` + `return` (F18): the `return` unwinds through the `try`, so the --- `$returning` flag and the post-`finally` re-dispatch make `finally` run --- before the procedure exits. --- --- Java equivalent: --- int closeAndReturn() { --- int status = 0; --- try { return status; } --- finally { status = 5; } // runs on the way out --- } -#eval showCase "5 — finally runs on return (F18)" <| StrataDDM.SourcedProgram.program <| +`return` sets `$returning`, jumps to `$tryfin`, `finally` runs, then the +re-dispatch continues the exit. -/ + +def finallyOnReturn : StrataDDM.SourcedProgram := #strata program Laurel; procedure closeAndReturn() @@ -212,107 +203,59 @@ procedure closeAndReturn() }; #end --- 6. More complex: two throws dispatched by a multi-clause `catch` (first-match --- wins) with a `finally`. Shows the sequential guarded catch chain plus the --- re-dispatch after `finally`. --- --- Java equivalent: --- int parseDocument(int input) { --- SyntaxError syntaxError = new SyntaxError(); --- IoError ioError = new IoError(); --- int result = 0; --- try { --- if (input < 0) throw syntaxError; --- if (input == 0) throw ioError; --- result = input; --- } catch (SyntaxError caught) { result = -1; } --- catch (IoError caught) { result = -2; } --- finally { result = result + 100; } --- return result; --- } -#eval showCase "6 — multi-clause catch + finally" <| StrataDDM.SourcedProgram.program <| -#strata -program Laurel; -composite SyntaxError extends BaseException {} -composite IoError extends BaseException {} -procedure parseDocument(input: int) - returns (result: int) +/-- +info: procedure closeAndReturn() + returns (status: int) opaque { - var syntaxError: SyntaxError := new SyntaxError; - var ioError: IoError := new IoError; - result := 0; - try { - if input < 0 then { - throw syntaxError - }; - if input == 0 then { - throw ioError - }; - result := input - } catch caught when caught is SyntaxError { - result := -1 - } catch caught when caught is IoError { - result := -2 - } finally { - result := result + 100 - } + var $thrown: bool := false; + var $exc: Composite; + var $returning: bool := false; + { + { + status := 0; + { + { + { + $returning := true; + exit $tryfin_0 + } + }$try_0 + }$tryfin_0; + { + status := 5 + }; + if $thrown then { + exit $exnexit + }; + if $returning then { + exit $exnexit + } + } + }$exnexit }; -#end +-/ +#guard_msgs in +#eval (fmtProcs (runPass finallyOnReturn)) --- 7. `when C throws (e) P` behavior case: the trigger + exceptional --- postcondition becomes `C ==> (Result..isBad($result) ∧ P[e := err])` — so a --- caller can conclude a throw *will* happen when `C` holds. --- --- Java equivalent: --- int divide(int a, int b) throws ArithmeticException { --- if (b == 0) throw new ArithmeticException(); --- return a / b; --- } --- // behavior case: when b == 0, divide throws an ArithmeticException. -#eval showCase "7 — when C throws (e) P behavior case" <| StrataDDM.SourcedProgram.program <| -#strata -program Laurel; -composite ArithmeticException extends BaseException {} -procedure divide(a: int, b: int) - returns (result: int) - throws ArithmeticException - when b == 0 throws (e) e is ArithmeticException - opaque -{ - if b == 0 then { - var error: ArithmeticException := new ArithmeticException; - throw error - }; - result := a / b -}; -#end +/-! ### 5. Re-throw from inside a `catch`, with `finally` (the two-label case) + +The handler's `throw` targets `$tryfin` (skipping the rest of the catch chain +but still running `finally`); the caught exception is re-thrown (`$exc := $exc`), +no allocation. -/ --- 8. Re-throw from inside a `catch`, with a `finally` (the two-label case): the --- handler's `throw` targets `$tryfin` (skipping the rest of the catch chain --- but still running `finally`), then the re-dispatch propagates it out. --- --- Java equivalent: --- int retry() throws NetworkError { --- NetworkError error = new NetworkError(); --- int r = 0; --- try { throw error; } --- catch (NetworkError caught) { throw caught; } // re-throw --- finally { r = 7; } --- } -#eval showCase "8 — re-throw from catch + finally" <| StrataDDM.SourcedProgram.program <| +def rethrowFromCatch : StrataDDM.SourcedProgram := #strata program Laurel; composite NetworkError extends BaseException {} -procedure retry() +procedure attempt(x: int) returns (r: int) throws NetworkError; +procedure retry(x: int) returns (r: int) throws NetworkError opaque { - var error: NetworkError := new NetworkError; - r := 0; try { - throw error + r := attempt(x) } catch caught when caught is NetworkError { throw caught } finally { @@ -321,19 +264,69 @@ procedure retry() }; #end --- 9. Nested `try`/`finally`: a `return` in the innermost body unwinds through --- both `finally` arms (inner then outer). Shows the nested `$try`/`$tryfin` --- blocks and the re-dispatch chaining `$returning` outward. --- --- Java equivalent: --- int nested() { --- int log = 0; --- try { --- try { return log; } --- finally { log = log + 1; } --- } finally { log = log + 2; } --- } -#eval showCase "9 — nested try/finally (return unwinds both)" <| StrataDDM.SourcedProgram.program <| +/-- +info: procedure attempt(x: int) + returns ($result: (Result)) + opaque; + +procedure retry(x: int) + returns ($result: (Result)) + opaque +{ + var $thrown: bool := false; + var $exc: Composite; + var $returning: bool := false; + var r: int; + { + { + { + { + { + var $callres_1: (Result) := attempt(x); + if Result..isBad($callres_1) then { + $exc := Result..err($callres_1); + $thrown := true; + exit $try_0 + }; + r := Result..value($callres_1) + } + }$try_0; + if $thrown & $exc is NetworkError then { + $thrown := false; + { + $exc := $exc; + $thrown := true; + exit $tryfin_0 + } + } + }$tryfin_0; + { + r := 7 + }; + if $thrown then { + exit $exnexit + }; + if $returning then { + exit $exnexit + } + } + }$exnexit; + if $thrown then { + $result := Bad($exc) + } else { + $result := Good(r) + } +}; +-/ +#guard_msgs in +#eval (fmtProcs (runPass rethrowFromCatch)) + +/-! ### 6. Nested `try`/`finally` + +A `return` in the inner body unwinds through both `finally` arms (inner then +outer) via the chained re-dispatch (`if $returning then exit $tryfin_0`). -/ + +def nestedFinally : StrataDDM.SourcedProgram := #strata program Laurel; procedure nested() @@ -352,3 +345,134 @@ procedure nested() } }; #end + +/-- +info: procedure nested() + returns (log: int) + opaque +{ + var $thrown: bool := false; + var $exc: Composite; + var $returning: bool := false; + { + { + log := 0; + { + { + { + { + { + { + $returning := true; + exit $tryfin_1 + } + }$try_1 + }$tryfin_1; + { + log := log + 1 + }; + if $thrown then { + exit $try_0 + }; + if $returning then { + exit $tryfin_0 + } + } + }$try_0 + }$tryfin_0; + { + log := log + 2 + }; + if $thrown then { + exit $exnexit + }; + if $returning then { + exit $exnexit + } + } + }$exnexit +}; +-/ +#guard_msgs in +#eval (fmtProcs (runPass nestedFinally)) + +/-! ### 7. Multi-clause `catch` + `finally` + +First-match-wins is a sequence of else-less guarded `if`s (each match clears +`$thrown`), then `finally`. -/ + +def multiCatch : StrataDDM.SourcedProgram := +#strata +program Laurel; +composite SyntaxError extends BaseException {} +composite IoError extends BaseException {} +procedure parseStrict(input: int) returns (result: int) throws SyntaxError; +procedure parseDocument(input: int) + returns (result: int) + opaque +{ + try { + result := parseStrict(input) + } catch caught when caught is SyntaxError { + result := -1 + } catch caught when caught is IoError { + result := -2 + } finally { + result := result + 100 + } +}; +#end + +/-- +info: procedure parseStrict(input: int) + returns ($result: (Result)) + opaque; + +procedure parseDocument(input: int): int + opaque +{ + var $thrown: bool := false; + var $exc: Composite; + var $returning: bool := false; + { + { + { + { + { + var $callres_1: (Result) := parseStrict(input); + if Result..isBad($callres_1) then { + $exc := Result..err($callres_1); + $thrown := true; + exit $try_0 + }; + result := Result..value($callres_1) + } + }$try_0; + if $thrown & $exc is SyntaxError then { + $thrown := false; + { + result := -1 + } + }; + if $thrown & $exc is IoError then { + $thrown := false; + { + result := -2 + } + } + }$tryfin_0; + { + result := result + 100 + }; + if $thrown then { + exit $exnexit + }; + if $returning then { + exit $exnexit + } + } + }$exnexit +}; +-/ +#guard_msgs in +#eval (fmtProcs (runPass multiCatch)) From 5ae5f064a9faf92946bd181e5639504e598cb9b3 Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Fri, 10 Jul 2026 09:43:21 +0000 Subject: [PATCH 24/28] docs(laurel): add end-to-end exception lowering examples (Java -> Laurel -> Core IR) --- .../laurel_exceptions_lowering_examples.txt | 666 ++++++++++++++++++ 1 file changed, 666 insertions(+) create mode 100644 docs/design/laurel_exceptions_lowering_examples.txt diff --git a/docs/design/laurel_exceptions_lowering_examples.txt b/docs/design/laurel_exceptions_lowering_examples.txt new file mode 100644 index 0000000000..4a7b4c7daa --- /dev/null +++ b/docs/design/laurel_exceptions_lowering_examples.txt @@ -0,0 +1,666 @@ +Laurel Exception Handling — end-to-end lowering examples +======================================================== + +For each of the seven EliminateExceptions cases, this shows four layers: + + (1) JAVA — illustrative source (hand-written; there is no Java->Laurel path + in this repo, so it only conveys intent). + (2) LAUREL, with exception keywords — the resolved surface program + (throws / onThrow / when-throws / try / catch / finally / is); + i.e. what a front-end would generate. + (3) LAUREL, after the EliminateExceptions pass — the pass run in isolation. + (4) CORE IR — generated by the full pipeline (`translate`), trimmed to the + procedures (the shared prelude/datatype declarations are omitted). + +Companion docs: `summary.md` (feature/decision overview), +`laurel_exceptions_handover.md` (implementation status). The test that pins the +pass output is `StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean`. + +Note: case 5 (`retry`, re-throw) declares `throws BaseException` here rather than +`throws NetworkError`, because the caught binding is typed at `BaseException`, so +re-throwing it escapes as `BaseException` — which the full pipeline's escape +check requires the `throws` clause to cover. + +This file is generated output kept for reference; it is not built or executed. + +╔══════════════════════════════════════════════════════════════╗ +║ CASE +╚══════════════════════════════════════════════════════════════╝ +──── (1) JAVA (illustrative source) ──── +int parsePositive(int input) throws NegativeInputException; // if it throws, input < 0 + +──── (2) LAUREL — generated, with exception keywords ──── +procedure parsePositive(input: int): int + throws NegativeInputException + onThrow (e) input < 0 + opaque; + +──── (3) LAUREL — after EliminateExceptions pass ──── +procedure parsePositive(input: int) + returns ($result: (Result)) + opaque + ensures Result..isBad($result) ==> input < 0; + +──── (4) CORE IR — generated by full pipeline (procedures) ──── +procedure parsePositive (input : int, out $result : Result int Composite) +spec { + free ensures [postcondition_0]: if Result..isBad($result) then input < 0 else true; + free ensures [postcondition_1]: $result == parsePositive$asFunction(input); + } { + $body: { + + } +}; + +╔══════════════════════════════════════════════════════════════╗ +║ CASE +╚══════════════════════════════════════════════════════════════╝ +──── (1) JAVA (illustrative source) ──── +int divide(int a, int b) throws ArithmeticException; // when b == 0, it throws + +──── (2) LAUREL — generated, with exception keywords ──── +procedure divide(a: int, b: int): int + throws ArithmeticException + when b == 0 throws (e) e is ArithmeticException + opaque; + +──── (3) LAUREL — after EliminateExceptions pass ──── +procedure divide(a: int, b: int) + returns ($result: (Result)) + opaque + ensures b == 0 ==> Result..isBad($result) & Result..err($result) is ArithmeticException; + +──── (4) CORE IR — generated by full pipeline (procedures) ──── +procedure divide (a : int, b : int, out $result : Result int Composite) +spec { + free ensures [postcondition_0]: if b == 0 then Result..isBad($result) && (ancestorsPerType[Composite..typeTag!(Result..err($result))])[ArithmeticException_TypeTag] else true; + free ensures [postcondition_1]: $result == divide$asFunction(a, b); + } { + $body: { + + } +}; + +╔══════════════════════════════════════════════════════════════╗ +║ CASE +╚══════════════════════════════════════════════════════════════╝ +──── (1) JAVA (illustrative source) ──── +int fetchRecord(int id) throws NotFoundException; +int loadUser(int id) { + try { return fetchRecord(id); } + catch (NotFoundException caught) { return 0; } +} + +──── (2) LAUREL — generated, with exception keywords ──── +procedure fetchRecord(id: int): int + throws NotFoundException + opaque; + +procedure loadUser(id: int): int + opaque +{ + try { + result := fetchRecord(id) + } + catch caught when caught is NotFoundException { + result := 0 + } +}; + +──── (3) LAUREL — after EliminateExceptions pass ──── +procedure fetchRecord(id: int) + returns ($result: (Result)) + opaque; + +procedure loadUser(id: int): int + opaque +{ + var $thrown: bool := false; + var $exc: Composite; + var $returning: bool := false; + { + { + { + { + { + var $callres_1: (Result) := fetchRecord(id); + if Result..isBad($callres_1) then { + $exc := Result..err($callres_1); + $thrown := true; + exit $try_0 + }; + result := Result..value($callres_1) + } + }$try_0; + if $thrown & $exc is NotFoundException then { + $thrown := false; + { + result := 0 + } + } + }$tryfin_0; + if $thrown then { + exit $exnexit + }; + if $returning then { + exit $exnexit + } + } + }$exnexit +}; + +──── (4) CORE IR — generated by full pipeline (procedures) ──── +procedure fetchRecord (id : int, out $result : Result int Composite) +spec { + free ensures [postcondition]: $result == fetchRecord$asFunction(id); + } { + $body: { + + } +}; +procedure loadUser (id : int, out result : int) +spec { + free ensures [postcondition]: result == loadUser$asFunction(id); + } { + $body: { + var $thrown : bool := false; + var $exc : Composite; + var $returning : bool := false; + $exnexit: { + $tryfin_0: { + $try_0: { + var $callres_1 : (Result int Composite); + call fetchRecord(id, out $callres_1); + if (Result..isBad($callres_1)) { + $exc := Result..err($callres_1); + $thrown := true; + exit $try_0; + } + result := Result..value($callres_1); + } + if ($thrown && (ancestorsPerType[Composite..typeTag!($exc)])[NotFoundException_TypeTag]) { + $thrown := false; + result := 0; + } + } + if ($thrown) { + exit $exnexit; + } + if ($returning) { + exit $exnexit; + } + } + } +}; + +╔══════════════════════════════════════════════════════════════╗ +║ CASE +╚══════════════════════════════════════════════════════════════╝ +──── (1) JAVA (illustrative source) ──── +int closeAndReturn() { + int status = 0; + try { return status; } finally { status = 5; } +} + +──── (2) LAUREL — generated, with exception keywords ──── +procedure closeAndReturn() + returns (status: int) + opaque +{ + status := 0; + try { + return + } + finally { + status := 5 + } +}; + +──── (3) LAUREL — after EliminateExceptions pass ──── +procedure closeAndReturn() + returns (status: int) + opaque +{ + var $thrown: bool := false; + var $exc: Composite; + var $returning: bool := false; + { + { + status := 0; + { + { + { + $returning := true; + exit $tryfin_0 + } + }$try_0 + }$tryfin_0; + { + status := 5 + }; + if $thrown then { + exit $exnexit + }; + if $returning then { + exit $exnexit + } + } + }$exnexit +}; + +──── (4) CORE IR — generated by full pipeline (procedures) ──── +procedure closeAndReturn (out status : int) +spec { + free ensures [postcondition]: status == closeAndReturn$asFunction; + } { + $body: { + var $thrown : bool := false; + var $exc : Composite; + var $returning : bool := false; + $exnexit: { + status := 0; + $tryfin_0: { + $try_0: { + $returning := true; + exit $tryfin_0; + } + } + status := 5; + if ($thrown) { + exit $exnexit; + } + if ($returning) { + exit $exnexit; + } + } + } +}; + +╔══════════════════════════════════════════════════════════════╗ +║ CASE +╚══════════════════════════════════════════════════════════════╝ +──── (1) JAVA (illustrative source) ──── +int attempt(int x) throws NetworkError; +int retry(int x) throws NetworkError { + try { return attempt(x); } + catch (NetworkError caught) { throw caught; } + finally { r = 7; } +} + +──── (2) LAUREL — generated, with exception keywords ──── +procedure attempt(x: int) + returns (r: int) + throws NetworkError + opaque; + +procedure retry(x: int) + returns (r: int) + throws BaseException + opaque +{ + try { + r := attempt(x) + } + catch caught when caught is NetworkError { + throw caught + } + finally { + r := 7 + } +}; + +──── (3) LAUREL — after EliminateExceptions pass ──── +procedure attempt(x: int) + returns ($result: (Result)) + opaque; + +procedure retry(x: int) + returns ($result: (Result)) + opaque +{ + var $thrown: bool := false; + var $exc: Composite; + var $returning: bool := false; + var r: int; + { + { + { + { + { + var $callres_1: (Result) := attempt(x); + if Result..isBad($callres_1) then { + $exc := Result..err($callres_1); + $thrown := true; + exit $try_0 + }; + r := Result..value($callres_1) + } + }$try_0; + if $thrown & $exc is NetworkError then { + $thrown := false; + { + $exc := $exc; + $thrown := true; + exit $tryfin_0 + } + } + }$tryfin_0; + { + r := 7 + }; + if $thrown then { + exit $exnexit + }; + if $returning then { + exit $exnexit + } + } + }$exnexit; + if $thrown then { + $result := Bad($exc) + } else { + $result := Good(r) + } +}; + +──── (4) CORE IR — generated by full pipeline (procedures) ──── +procedure attempt (x : int, out $result : Result int Composite) +spec { + free ensures [postcondition]: $result == attempt$asFunction(x); + } { + $body: { + + } +}; +procedure retry (x : int, out $result : Result int Composite) +spec { + free ensures [postcondition]: $result == retry$asFunction(x); + } { + $body: { + var $thrown : bool := false; + var $exc : Composite; + var $returning : bool := false; + var r : int; + $exnexit: { + $tryfin_0: { + $try_0: { + var $callres_1 : (Result int Composite); + call attempt(x, out $callres_1); + if (Result..isBad($callres_1)) { + $exc := Result..err($callres_1); + $thrown := true; + exit $try_0; + } + r := Result..value($callres_1); + } + if ($thrown && (ancestorsPerType[Composite..typeTag!($exc)])[NetworkError_TypeTag]) { + $thrown := false; + $exc := $exc; + $thrown := true; + exit $tryfin_0; + } + } + r := 7; + if ($thrown) { + exit $exnexit; + } + if ($returning) { + exit $exnexit; + } + } + if ($thrown) { + $result := Bad($exc); + } else { + $result := Good(r); + } + } +}; + +╔══════════════════════════════════════════════════════════════╗ +║ CASE +╚══════════════════════════════════════════════════════════════╝ +──── (1) JAVA (illustrative source) ──── +int nested() { + int log = 0; + try { try { return log; } finally { log += 1; } } + finally { log += 2; } +} + +──── (2) LAUREL — generated, with exception keywords ──── +procedure nested() + returns (log: int) + opaque +{ + log := 0; + try { + try { + return + } + finally { + log := log + 1 + } + } + finally { + log := log + 2 + } +}; + +──── (3) LAUREL — after EliminateExceptions pass ──── +procedure nested() + returns (log: int) + opaque +{ + var $thrown: bool := false; + var $exc: Composite; + var $returning: bool := false; + { + { + log := 0; + { + { + { + { + { + { + $returning := true; + exit $tryfin_1 + } + }$try_1 + }$tryfin_1; + { + log := log + 1 + }; + if $thrown then { + exit $try_0 + }; + if $returning then { + exit $tryfin_0 + } + } + }$try_0 + }$tryfin_0; + { + log := log + 2 + }; + if $thrown then { + exit $exnexit + }; + if $returning then { + exit $exnexit + } + } + }$exnexit +}; + +──── (4) CORE IR — generated by full pipeline (procedures) ──── +procedure nested (out log : int) +spec { + free ensures [postcondition]: log == nested$asFunction; + } { + $body: { + var $thrown : bool := false; + var $exc : Composite; + var $returning : bool := false; + $exnexit: { + log := 0; + $tryfin_0: { + $try_0: { + $tryfin_1: { + $try_1: { + $returning := true; + exit $tryfin_1; + } + } + log := log + 1; + if ($thrown) { + exit $try_0; + } + if ($returning) { + exit $tryfin_0; + } + } + } + log := log + 2; + if ($thrown) { + exit $exnexit; + } + if ($returning) { + exit $exnexit; + } + } + } +}; + +╔══════════════════════════════════════════════════════════════╗ +║ CASE +╚══════════════════════════════════════════════════════════════╝ +──── (1) JAVA (illustrative source) ──── +int parseStrict(int input) throws SyntaxError; +int parseDocument(int input) { + try { return parseStrict(input); } + catch (SyntaxError caught) { return -1; } + catch (IoError caught) { return -2; } + finally { result += 100; } +} + +──── (2) LAUREL — generated, with exception keywords ──── +procedure parseStrict(input: int): int + throws SyntaxError + opaque; + +procedure parseDocument(input: int): int + opaque +{ + try { + result := parseStrict(input) + } + catch caught when caught is SyntaxError { + result := -1 + } + catch caught when caught is IoError { + result := -2 + } + finally { + result := result + 100 + } +}; + +──── (3) LAUREL — after EliminateExceptions pass ──── +procedure parseStrict(input: int) + returns ($result: (Result)) + opaque; + +procedure parseDocument(input: int): int + opaque +{ + var $thrown: bool := false; + var $exc: Composite; + var $returning: bool := false; + { + { + { + { + { + var $callres_1: (Result) := parseStrict(input); + if Result..isBad($callres_1) then { + $exc := Result..err($callres_1); + $thrown := true; + exit $try_0 + }; + result := Result..value($callres_1) + } + }$try_0; + if $thrown & $exc is SyntaxError then { + $thrown := false; + { + result := -1 + } + }; + if $thrown & $exc is IoError then { + $thrown := false; + { + result := -2 + } + } + }$tryfin_0; + { + result := result + 100 + }; + if $thrown then { + exit $exnexit + }; + if $returning then { + exit $exnexit + } + } + }$exnexit +}; + +──── (4) CORE IR — generated by full pipeline (procedures) ──── +procedure parseStrict (input : int, out $result : Result int Composite) +spec { + free ensures [postcondition]: $result == parseStrict$asFunction(input); + } { + $body: { + + } +}; +procedure parseDocument (input : int, out result : int) +spec { + free ensures [postcondition]: result == parseDocument$asFunction(input); + } { + $body: { + var $thrown : bool := false; + var $exc : Composite; + var $returning : bool := false; + $exnexit: { + $tryfin_0: { + $try_0: { + var $callres_1 : (Result int Composite); + call parseStrict(input, out $callres_1); + if (Result..isBad($callres_1)) { + $exc := Result..err($callres_1); + $thrown := true; + exit $try_0; + } + result := Result..value($callres_1); + } + if ($thrown && (ancestorsPerType[Composite..typeTag!($exc)])[SyntaxError_TypeTag]) { + $thrown := false; + result := -1; + } + if ($thrown && (ancestorsPerType[Composite..typeTag!($exc)])[IoError_TypeTag]) { + $thrown := false; + result := -2; + } + } + result := result + 100; + if ($thrown) { + exit $exnexit; + } + if ($returning) { + exit $exnexit; + } + } + } +}; From 33b46cf9dec7cf17a1752fec326cce3f07a016fa Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Tue, 14 Jul 2026 11:24:36 +0000 Subject: [PATCH 25/28] feat(laurel): synthesize onThrow from a bare throws clause (E4) When a procedure declares a valid `throws T` but states no explicit `onThrow`, resolution now synthesizes `onThrow (e) e is T`. Without this a bare `throws` is consumed only by the (early, static) ExceptionEscapeCheck and the declared exception type is dropped at lowering; the synthesized clause flows through heap parameterization and the type-hierarchy transform, and EliminateExceptions turns it into `Result..isBad($result) ==> Result..err($result) is T`, so the type survives into Core. Gated on the throws type being a well-formed BaseException subtype (so an invalid `throws int` does not cascade a spurious "cannot test unrelated type" diagnostic) and on there being no author-written onThrow. Idempotent under re-resolution. Updates the EliminateExceptionsPass golden and regenerates the lowering-examples doc. --- Strata/Languages/Laurel/Resolution.lean | 40 +++++++++++++++++-- .../Objects/EliminateExceptionsPass.lean | 17 ++++++-- .../laurel_exceptions_lowering_examples.txt | 33 ++++++++++----- 3 files changed, 73 insertions(+), 17 deletions(-) diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean index 547076a2e1..ee1fee389b 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -2772,16 +2772,48 @@ def resolveBody (body : Body) : ResolveM Body := do declare-or-catch is front-end policy. See `laurel_extensions.md` (E4). -/ def resolveExceptionalContract (proc : Procedure) : ResolveM (Option HighTypeMd × List OnThrowClause × List OnThrowsClause) := do - let throwsType' ← proc.throwsType.mapM fun t => do + -- Resolve the `throws` type and record whether it is a well-formed + -- `BaseException` subtype (used to gate the synthesized `onThrow` below — we + -- must not synthesize `e is T` for an invalid `T`, which would cascade a + -- spurious "cannot test unrelated type" diagnostic on top of the real error). + let throwsInfo ← proc.throwsType.mapM fun t => do let t' ← resolveHighType t let baseTy ← resolveHighType { val := .UserDefined (mkId baseExceptionTypeName), source := t.source } let ctx := (← get).typeLattice - unless isConsistentSubtype ctx t' baseTy do + let ok := isConsistentSubtype ctx t' baseTy + unless ok do modify fun s => { s with errors := s.errors.push (diagnosticFromSource t.source s!"throws type must be a subtype of '{baseExceptionTypeName}'") } - pure t' - let onThrow' ← proc.onThrow.mapM fun c => withScope do + pure (t', ok) + let throwsType' := throwsInfo.map Prod.fst + let throwsValid := (throwsInfo.map Prod.snd).getD false + -- Preserve the declared exception type as a Bad-path postcondition: when a + -- procedure declares `throws T` but states no explicit `onThrow`, synthesize + -- `onThrow (e) e is T`. Without this a bare `throws` is consumed only by the + -- (early, static) `ExceptionEscapeCheck` and the type is otherwise dropped at + -- lowering (`EliminateExceptions` turns `onThrow`s into `isBad ==> …` + -- postconditions over `$result`, but a `throws` clause on its own contributes + -- nothing there). Emitting the clause here lets it flow through the normal + -- passes: heap parameterization + the type-hierarchy transform lower its + -- `e is T` test, and `EliminateExceptions` turns it into + -- `Result..isBad($result) ==> Result..err($result) is T`. + -- + -- Idempotent under re-resolution: after the first resolve `proc.onThrow` is + -- non-empty, so the guard below no longer fires. Skipped when the author + -- already wrote an `onThrow` (they are responsible for describing the + -- exceptional postcondition, and may state the type there). + let onThrowInput : List OnThrowClause := + match proc.throwsType with + | some tyNode => + if throwsValid && proc.onThrow.isEmpty then + let e : Identifier := mkId "e" + let eRef : AstNode StmtExpr := { val := .Var (.Local e), source := tyNode.source } + [{ binding := e, + predicate := { val := .IsType eRef tyNode, source := tyNode.source } }] + else proc.onThrow + | none => proc.onThrow + let onThrow' ← onThrowInput.mapM fun c => withScope do let bindTy ← resolveHighType { val := .UserDefined (mkId baseExceptionTypeName), source := c.binding.source } let binding' ← defineNameCheckDup c.binding (.var c.binding bindTy) diff --git a/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean b/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean index 3557edf010..93021c17d9 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean @@ -95,7 +95,11 @@ info: procedure parsePositive(input: int) /-! ### 2. `when C throws (e) P` behavior case (bodiless) -Becomes `C ==> (Result..isBad($result) ∧ P[e := err])`. -/ +Becomes `C ==> (Result..isBad($result) ∧ P[e := err])`. The first `ensures` is +the *synthesized* `onThrow (e) e is T`: because `divide` declares `throws +ArithmeticException` but states no explicit `onThrow`, resolution adds +`onThrow (e) e is ArithmeticException` so the declared exception type is +preserved as `Result..isBad($result) ==> Result..err($result) is …`. -/ def whenThrows : StrataDDM.SourcedProgram := #strata @@ -111,6 +115,7 @@ procedure divide(a: int, b: int) info: procedure divide(a: int, b: int) returns ($result: (Result)) opaque + ensures Result..isBad($result) ==> Result..err($result) is ArithmeticException ensures b == 0 ==> Result..isBad($result) & Result..err($result) is ArithmeticException; -/ #guard_msgs in @@ -140,7 +145,8 @@ procedure loadUser(id: int) /-- info: procedure fetchRecord(id: int) returns ($result: (Result)) - opaque; + opaque + ensures Result..isBad($result) ==> Result..err($result) is NotFoundException; procedure loadUser(id: int): int opaque @@ -267,11 +273,13 @@ procedure retry(x: int) /-- info: procedure attempt(x: int) returns ($result: (Result)) - opaque; + opaque + ensures Result..isBad($result) ==> Result..err($result) is NetworkError; procedure retry(x: int) returns ($result: (Result)) opaque + ensures Result..isBad($result) ==> Result..err($result) is NetworkError { var $thrown: bool := false; var $exc: Composite; @@ -426,7 +434,8 @@ procedure parseDocument(input: int) /-- info: procedure parseStrict(input: int) returns ($result: (Result)) - opaque; + opaque + ensures Result..isBad($result) ==> Result..err($result) is SyntaxError; procedure parseDocument(input: int): int opaque diff --git a/docs/design/laurel_exceptions_lowering_examples.txt b/docs/design/laurel_exceptions_lowering_examples.txt index 4a7b4c7daa..66b2145ccf 100644 --- a/docs/design/laurel_exceptions_lowering_examples.txt +++ b/docs/design/laurel_exceptions_lowering_examples.txt @@ -61,6 +61,7 @@ int divide(int a, int b) throws ArithmeticException; // when b == 0, it throws ──── (2) LAUREL — generated, with exception keywords ──── procedure divide(a: int, b: int): int throws ArithmeticException + onThrow (e) e is ArithmeticException when b == 0 throws (e) e is ArithmeticException opaque; @@ -68,13 +69,15 @@ procedure divide(a: int, b: int): int procedure divide(a: int, b: int) returns ($result: (Result)) opaque + ensures Result..isBad($result) ==> Result..err($result) is ArithmeticException ensures b == 0 ==> Result..isBad($result) & Result..err($result) is ArithmeticException; ──── (4) CORE IR — generated by full pipeline (procedures) ──── procedure divide (a : int, b : int, out $result : Result int Composite) spec { - free ensures [postcondition_0]: if b == 0 then Result..isBad($result) && (ancestorsPerType[Composite..typeTag!(Result..err($result))])[ArithmeticException_TypeTag] else true; - free ensures [postcondition_1]: $result == divide$asFunction(a, b); + free ensures [postcondition_0]: if Result..isBad($result) then (ancestorsPerType[Composite..typeTag!(Result..err($result))])[ArithmeticException_TypeTag] else true; + free ensures [postcondition_1]: if b == 0 then Result..isBad($result) && (ancestorsPerType[Composite..typeTag!(Result..err($result))])[ArithmeticException_TypeTag] else true; + free ensures [postcondition_2]: $result == divide$asFunction(a, b); } { $body: { @@ -94,6 +97,7 @@ int loadUser(int id) { ──── (2) LAUREL — generated, with exception keywords ──── procedure fetchRecord(id: int): int throws NotFoundException + onThrow (e) e is NotFoundException opaque; procedure loadUser(id: int): int @@ -110,7 +114,8 @@ procedure loadUser(id: int): int ──── (3) LAUREL — after EliminateExceptions pass ──── procedure fetchRecord(id: int) returns ($result: (Result)) - opaque; + opaque + ensures Result..isBad($result) ==> Result..err($result) is NotFoundException; procedure loadUser(id: int): int opaque @@ -152,7 +157,8 @@ procedure loadUser(id: int): int ──── (4) CORE IR — generated by full pipeline (procedures) ──── procedure fetchRecord (id : int, out $result : Result int Composite) spec { - free ensures [postcondition]: $result == fetchRecord$asFunction(id); + free ensures [postcondition_0]: if Result..isBad($result) then (ancestorsPerType[Composite..typeTag!(Result..err($result))])[NotFoundException_TypeTag] else true; + free ensures [postcondition_1]: $result == fetchRecord$asFunction(id); } { $body: { @@ -291,11 +297,13 @@ int retry(int x) throws NetworkError { procedure attempt(x: int) returns (r: int) throws NetworkError + onThrow (e) e is NetworkError opaque; procedure retry(x: int) returns (r: int) throws BaseException + onThrow (e) e is BaseException opaque { try { @@ -312,11 +320,13 @@ procedure retry(x: int) ──── (3) LAUREL — after EliminateExceptions pass ──── procedure attempt(x: int) returns ($result: (Result)) - opaque; + opaque + ensures Result..isBad($result) ==> Result..err($result) is NetworkError; procedure retry(x: int) returns ($result: (Result)) opaque + ensures Result..isBad($result) ==> Result..err($result) is BaseException { var $thrown: bool := false; var $exc: Composite; @@ -366,7 +376,8 @@ procedure retry(x: int) ──── (4) CORE IR — generated by full pipeline (procedures) ──── procedure attempt (x : int, out $result : Result int Composite) spec { - free ensures [postcondition]: $result == attempt$asFunction(x); + free ensures [postcondition_0]: if Result..isBad($result) then (ancestorsPerType[Composite..typeTag!(Result..err($result))])[NetworkError_TypeTag] else true; + free ensures [postcondition_1]: $result == attempt$asFunction(x); } { $body: { @@ -374,7 +385,8 @@ spec { }; procedure retry (x : int, out $result : Result int Composite) spec { - free ensures [postcondition]: $result == retry$asFunction(x); + ensures [postcondition_0]: if Result..isBad($result) then (ancestorsPerType[Composite..typeTag!(Result..err($result))])[BaseException_TypeTag] else true; + free ensures [postcondition_1]: $result == retry$asFunction(x); } { $body: { var $thrown : bool := false; @@ -546,6 +558,7 @@ int parseDocument(int input) { ──── (2) LAUREL — generated, with exception keywords ──── procedure parseStrict(input: int): int throws SyntaxError + onThrow (e) e is SyntaxError opaque; procedure parseDocument(input: int): int @@ -568,7 +581,8 @@ procedure parseDocument(input: int): int ──── (3) LAUREL — after EliminateExceptions pass ──── procedure parseStrict(input: int) returns ($result: (Result)) - opaque; + opaque + ensures Result..isBad($result) ==> Result..err($result) is SyntaxError; procedure parseDocument(input: int): int opaque @@ -619,7 +633,8 @@ procedure parseDocument(input: int): int ──── (4) CORE IR — generated by full pipeline (procedures) ──── procedure parseStrict (input : int, out $result : Result int Composite) spec { - free ensures [postcondition]: $result == parseStrict$asFunction(input); + free ensures [postcondition_0]: if Result..isBad($result) then (ancestorsPerType[Composite..typeTag!(Result..err($result))])[SyntaxError_TypeTag] else true; + free ensures [postcondition_1]: $result == parseStrict$asFunction(input); } { $body: { From 8d807b683f460de6837e9eb166f0b9cdab87881a Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Tue, 14 Jul 2026 12:13:03 +0000 Subject: [PATCH 26/28] docs(laurel): show faithful Java try/finally/return mapping in lowering examples MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Case 4 (closeAndReturn) now maps the Java local to a distinct Laurel local and uses a value-carrying return, so the return value is snapshotted into the output at the return site (before finally) — matching Java's return semantics; both yield 0. The showcase's layer-3 view now runs EliminateValueInReturns before EliminateExceptions so value-returns are shown faithfully rather than dropped. --- .../laurel_exceptions_lowering_examples.txt | 37 ++++++++++++------- 1 file changed, 24 insertions(+), 13 deletions(-) diff --git a/docs/design/laurel_exceptions_lowering_examples.txt b/docs/design/laurel_exceptions_lowering_examples.txt index 66b2145ccf..b38da39de2 100644 --- a/docs/design/laurel_exceptions_lowering_examples.txt +++ b/docs/design/laurel_exceptions_lowering_examples.txt @@ -21,6 +21,15 @@ Note: case 5 (`retry`, re-throw) declares `throws BaseException` here rather tha re-throwing it escapes as `BaseException` — which the full pipeline's escape check requires the `throws` clause to cover. +Note: case 4 (`closeAndReturn`) illustrates the faithful mapping of Java's +snapshot-at-`return` semantics: the Java local `status` becomes a Laurel *local* +distinct from the output `result`, and `return status` is value-carrying, so it +snapshots `status` into `result` at the return site (before `finally`). The +`finally`'s `status := 5` mutates only the local, so both Java and Laurel +return 0. (A bare valueless `return` of a `finally`-mutated output variable +would instead yield 5 — Laurel's result is its output variable's value at real +exit — so a front-end must use the value-carrying form shown here.) + This file is generated output kept for reference; it is not built or executed. ╔══════════════════════════════════════════════════════════════╗ @@ -205,17 +214,16 @@ spec { ──── (1) JAVA (illustrative source) ──── int closeAndReturn() { int status = 0; - try { return status; } finally { status = 5; } + try { return status; } finally { status = 5; } // returns 0 } ──── (2) LAUREL — generated, with exception keywords ──── -procedure closeAndReturn() - returns (status: int) +procedure closeAndReturn(): int opaque { - status := 0; + var status: int := 0; try { - return + return status } finally { status := 5 @@ -223,8 +231,7 @@ procedure closeAndReturn() }; ──── (3) LAUREL — after EliminateExceptions pass ──── -procedure closeAndReturn() - returns (status: int) +procedure closeAndReturn(): int opaque { var $thrown: bool := false; @@ -232,12 +239,15 @@ procedure closeAndReturn() var $returning: bool := false; { { - status := 0; + var status: int := 0; { { { - $returning := true; - exit $tryfin_0 + { + result := status; + $returning := true; + exit $tryfin_0 + } } }$try_0 }$tryfin_0; @@ -255,18 +265,19 @@ procedure closeAndReturn() }; ──── (4) CORE IR — generated by full pipeline (procedures) ──── -procedure closeAndReturn (out status : int) +procedure closeAndReturn (out result : int) spec { - free ensures [postcondition]: status == closeAndReturn$asFunction; + free ensures [postcondition]: result == closeAndReturn$asFunction; } { $body: { var $thrown : bool := false; var $exc : Composite; var $returning : bool := false; $exnexit: { - status := 0; + var status : int := 0; $tryfin_0: { $try_0: { + result := status; $returning := true; exit $tryfin_0; } From 342af5dafad9309624218d8bc536f24611f1970d Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Tue, 14 Jul 2026 12:50:57 +0000 Subject: [PATCH 27/28] fix(laurel): snapshot catch binding so nested throws can't clobber it (E3) A catch handler's binding was substituted with the shared $exc, so a throw or throwing-call inside the handler that is caught by a nested try/catch overwrote $exc; a later use of the outer handler's binding then read the inner exception. lowerTry now snapshots the caught value into a fresh per-handler local (only when the handler references its binding) and substitutes the binding with it. The dispatch guard still reads $exc (evaluated before any nested throw). Adds regression nestedCatchKeepsBinding and showcase case 8 (nestedCatch); updates the EliminateExceptions golden (case 5, whose handler re-throws its binding) and regenerates the lowering-examples doc. --- .../Languages/Laurel/EliminateExceptions.lean | 28 ++- .../Objects/EliminateExceptionsPass.lean | 9 +- .../Examples/Objects/TryCatchBehavior.lean | 37 ++++ .../laurel_exceptions_lowering_examples.txt | 172 +++++++++++++++++- 4 files changed, 239 insertions(+), 7 deletions(-) diff --git a/Strata/Languages/Laurel/EliminateExceptions.lean b/Strata/Languages/Laurel/EliminateExceptions.lean index d6960f81b9..57be9adcdb 100644 --- a/Strata/Languages/Laurel/EliminateExceptions.lean +++ b/Strata/Languages/Laurel/EliminateExceptions.lean @@ -117,6 +117,15 @@ private def substLocal (name : String) (repl : StmtExprMd) (e : StmtExprMd) : St | .Var (.Local id) => if id.text == name then repl else n | _ => n) e +/-- Whether a reference `Var (.Local name)` occurs anywhere in `e`. -/ +private def localOccurs (name : String) (e : StmtExprMd) : Bool := + ((mapStmtExprM (m := StateM Bool) + (fun n => do + match n.val with + | .Var (.Local id) => if id.text == name then set true else pure () + | _ => pure () + pure n) e).run false).2 + /-! ### Callee lookup -/ /-- The resolved callee procedure, if `callee` names one. -/ @@ -256,13 +265,28 @@ private partial def lowerTry (ctx : Ctx) (src : Option FileRange) -- catch chain but still runs `finally` ($tryfin). let catchCtx : Ctx := { ctx with tryStack := (tryFinLbl, tryFinLbl) :: saved } let clauses ← catches.mapM (fun c => do + -- The guard reads the shared `$exc` directly: it is evaluated at dispatch + -- time, before the handler runs, so no nested throw has clobbered it yet. let pExpr := match c.predicate with | some p => substLocal c.binding.text (localRef exnExcVar) p | none => litBool true let hStmts ← lowerStmt catchCtx c.body - let hStmts := hStmts.map (substLocal c.binding.text (localRef exnExcVar)) + -- Snapshot the caught exception into a fresh per-handler local when the + -- handler references its binding. A `throw`/throwing-call *inside* this + -- handler that is itself caught (e.g. a nested `try`/`catch`) overwrites the + -- shared `$exc`; without the snapshot a later use of this handler's binding + -- would read that inner exception instead. Skipped when the binding is + -- unused, to avoid an inert local in the common case. + let (bindDecls, hStmts) ← + if hStmts.any (localOccurs c.binding.text) then do + let bid ← freshNat + let bindLocal := s!"$exc_{c.binding.text}_{bid}" + pure ([declInit bindLocal compositeTy (localRef exnExcVar)], + hStmts.map (substLocal c.binding.text (localRef bindLocal))) + else + pure ([], hStmts) let guard := andOf (localRef exnThrownVar) pExpr - let handler := setLocal exnThrownVar (litBool false) :: hStmts + let handler := setLocal exnThrownVar (litBool false) :: (bindDecls ++ hStmts) pure (guard, handler)) -- First-match-wins is enforced by clearing `$thrown` on a match: once a clause -- fires, later `$thrown && guardⱼ` guards are false. So the chain is a *sequence* diff --git a/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean b/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean index 93021c17d9..5d80ab7d73 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/EliminateExceptionsPass.lean @@ -247,8 +247,10 @@ info: procedure closeAndReturn() /-! ### 5. Re-throw from inside a `catch`, with `finally` (the two-label case) The handler's `throw` targets `$tryfin` (skipping the rest of the catch chain -but still running `finally`); the caught exception is re-thrown (`$exc := $exc`), -no allocation. -/ +but still running `finally`). Because the handler references its binding +(`throw caught`), the caught value is first snapshotted into a fresh per-handler +local (`$exc_caught_2`) so a nested throw could not clobber it; the re-throw then +restores it (`$exc := $exc_caught_2`), no allocation. -/ def rethrowFromCatch : StrataDDM.SourcedProgram := #strata @@ -301,8 +303,9 @@ procedure retry(x: int) }$try_0; if $thrown & $exc is NetworkError then { $thrown := false; + var $exc_caught_2: Composite := $exc; { - $exc := $exc; + $exc := $exc_caught_2; $thrown := true; exit $tryfin_0 } diff --git a/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean b/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean index 1a8ff15614..05eec383ea 100644 --- a/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean +++ b/StrataTest/Languages/Laurel/Examples/Objects/TryCatchBehavior.lean @@ -264,3 +264,40 @@ procedure catchReadsField(alen: int, i: int) } }; #end + +-- Nested `catch`: a handler's binding must survive a throw that occurs *inside* +-- that handler and is caught by a nested `try`/`catch`. The outer handler binds +-- `a` (an `Outer` carrying tag == 1); inside it a nested `try` throws `Inner`, +-- which is caught. Afterwards the outer handler reads `a` again — it must still +-- refer to the original `Outer` (tag == 1), not the inner exception. This +-- exercises the per-handler snapshot of the caught value (a single shared `$exc` +-- is overwritten by the inner throw). +#eval testLaurel <| +#strata +program Laurel; +composite Outer extends BaseException { + tag: int +} +composite Inner extends BaseException {} +procedure nestedCatchKeepsBinding() + returns (r: int) + opaque + ensures r == 1 +{ + var outerExn: Outer := new Outer; + outerExn#tag := 1; + var innerExn: Inner := new Inner; + r := 0; + try { + throw outerExn + } catch a when a is Outer { + try { + throw innerExn + } catch b when b is Inner { + r := 0 + }; + assert (a as Outer)#tag == 1; + r := (a as Outer)#tag + } +}; +#end diff --git a/docs/design/laurel_exceptions_lowering_examples.txt b/docs/design/laurel_exceptions_lowering_examples.txt index b38da39de2..c241f0e29e 100644 --- a/docs/design/laurel_exceptions_lowering_examples.txt +++ b/docs/design/laurel_exceptions_lowering_examples.txt @@ -30,6 +30,14 @@ return 0. (A bare valueless `return` of a `finally`-mutated output variable would instead yield 5 — Laurel's result is its output variable's value at real exit — so a front-end must use the value-carrying form shown here.) +Note: case 8 (`nestedCatch`) demonstrates that a handler's binding survives a +throw that happens *inside* the handler and is caught by a nested `try`/`catch`. +The in-flight exception rides in a single shared `$exc`, which the inner throw +overwrites; so when a handler references its binding, the lowering snapshots the +caught value into a fresh per-handler local (`$exc_a_N`) at handler entry and +substitutes the binding with it. The outer `a` therefore still reads the outer +exception (`tag == 1`), not the inner one. + This file is generated output kept for reference; it is not built or executed. ╔══════════════════════════════════════════════════════════════╗ @@ -359,8 +367,9 @@ procedure retry(x: int) }$try_0; if $thrown & $exc is NetworkError then { $thrown := false; + var $exc_caught_2: Composite := $exc; { - $exc := $exc; + $exc := $exc_caught_2; $thrown := true; exit $tryfin_0 } @@ -418,7 +427,8 @@ spec { } if ($thrown && (ancestorsPerType[Composite..typeTag!($exc)])[NetworkError_TypeTag]) { $thrown := false; - $exc := $exc; + var $exc_caught_2 : Composite := $exc; + $exc := $exc_caught_2; $thrown := true; exit $tryfin_0; } @@ -690,3 +700,161 @@ spec { } } }; + +╔══════════════════════════════════════════════════════════════╗ +║ CASE +╚══════════════════════════════════════════════════════════════╝ +──── (1) JAVA (illustrative source) ──── +int nestedCatch() { + try { + throw new Outer(1); + } catch (Outer a) { + try { throw new Inner(); } catch (Inner b) { /* swallow */ } + return a.tag; // must be 1 (the Outer), not the inner exception + } +} + +──── (2) LAUREL — generated, with exception keywords ──── +procedure nestedCatch() + returns (r: int) + opaque +{ + var outerExn: Outer := new Outer; + outerExn#tag := 1; + var innerExn: Inner := new Inner; + r := 0; + try { + throw outerExn + } + catch a when a is Outer { + try { + throw innerExn + } + catch b when b is Inner { + r := 0 + }; + r := (a as Outer)#tag + } +}; + +──── (3) LAUREL — after EliminateExceptions pass ──── +procedure nestedCatch() + returns (r: int) + opaque +{ + var $thrown: bool := false; + var $exc: Composite; + var $returning: bool := false; + { + { + var outerExn: Outer := new Outer; + outerExn#tag := 1; + var innerExn: Inner := new Inner; + r := 0; + { + { + { + $exc := outerExn; + $thrown := true; + exit $try_0 + } + }$try_0; + if $thrown & $exc is Outer then { + $thrown := false; + var $exc_a_2: Composite := $exc; + { + { + { + { + $exc := innerExn; + $thrown := true; + exit $try_1 + } + }$try_1; + if $thrown & $exc is Inner then { + $thrown := false; + { + r := 0 + } + } + }$tryfin_1; + if $thrown then { + exit $tryfin_0 + }; + if $returning then { + exit $tryfin_0 + }; + r := ($exc_a_2 as Outer)#tag + } + } + }$tryfin_0; + if $thrown then { + exit $exnexit + }; + if $returning then { + exit $exnexit + } + } + }$exnexit +}; + +──── (4) CORE IR — generated by full pipeline (procedures) ──── +procedure nestedCatch (inout $heap : Heap, out r : int) +spec { + ensures [postcondition]: forall $modifies_obj : Composite :: forall $modifies_fld : Field :: if Composite..ref!($modifies_obj) < Heap..nextReference!(old $heap) then readField(old $heap, $modifies_obj, $modifies_fld) == readField($heap, $modifies_obj, $modifies_fld) else true; + } { + $body: { + var $thrown : bool := false; + var $exc : Composite; + var $returning : bool := false; + $exnexit: { + var $th_tmp0 : int := Heap..nextReference!($heap); + var $$heap_0 : Heap := $heap; + $heap := increment($heap); + var outerExn : Composite := MkComposite($th_tmp0, Outer_TypeTag); + var $tmp0 : int := 1; + $heap := updateField($heap, outerExn, Outer.tag, BoxInt($tmp0)); + var $th_tmp1 : int := Heap..nextReference!($heap); + var $$heap_1 : Heap := $heap; + $heap := increment($heap); + var innerExn : Composite := MkComposite($th_tmp1, Inner_TypeTag); + r := 0; + $tryfin_0: { + $try_0: { + $exc := outerExn; + $thrown := true; + exit $try_0; + } + if ($thrown && (ancestorsPerType[Composite..typeTag!($exc)])[Outer_TypeTag]) { + $thrown := false; + var $exc_a_2 : Composite := $exc; + $tryfin_1: { + $try_1: { + $exc := innerExn; + $thrown := true; + exit $try_1; + } + if ($thrown && (ancestorsPerType[Composite..typeTag!($exc)])[Inner_TypeTag]) { + $thrown := false; + r := 0; + } + } + if ($thrown) { + exit $tryfin_0; + } + if ($returning) { + exit $tryfin_0; + } + assert [|assert(8720)|]: (ancestorsPerType[Composite..typeTag!($exc_a_2)])[Outer_TypeTag]; + r := Box..intVal!(readField($heap, $exc_a_2, Outer.tag)); + } + } + if ($thrown) { + exit $exnexit; + } + if ($returning) { + exit $exnexit; + } + } + } +}; From 9c626e22d52ae8efd4bb54a2178efe21532abacd Mon Sep 17 00:00:00 2001 From: Kadiray Karakaya Date: Wed, 15 Jul 2026 10:46:52 +0000 Subject: [PATCH 28/28] feat(laurel): per-path exceptional frame (onThrow modifies) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add `onThrow modifies …`, a modifies clause for the throwing path distinct from the normal-path `modifies`. It lowers to a frame axiom guarded by Result..isBad($result), built in EliminateExceptions (reusing the ModifiesClauses frame builder); the normal frame stays Good-path-guarded. Emitted only when declared, so existing programs are unaffected. Threads the clause through grammar/parse/print, AST, MapStmtExpr, resolution, and heap parameterization. Adds ExceptionalModifies.lean (positive + negative) and lowering-examples showcase case 9. --- .../Languages/Laurel/EliminateExceptions.lean | 21 +++- .../AbstractToConcreteTreeTranslator.lean | 3 + .../ConcreteToAbstractTreeTranslator.lean | 22 +++- .../Laurel/Grammar/LaurelGrammar.lean | 2 +- .../Languages/Laurel/Grammar/LaurelGrammar.st | 10 +- .../Laurel/HeapParameterization.lean | 16 ++- Strata/Languages/Laurel/LaurelAST.lean | 7 ++ Strata/Languages/Laurel/MapStmtExpr.lean | 3 +- Strata/Languages/Laurel/Resolution.lean | 13 ++- .../Examples/Objects/ExceptionalModifies.lean | 75 ++++++++++++ .../laurel_exceptions_lowering_examples.txt | 109 ++++++++++++++++++ 11 files changed, 267 insertions(+), 14 deletions(-) create mode 100644 StrataTest/Languages/Laurel/Examples/Objects/ExceptionalModifies.lean diff --git a/Strata/Languages/Laurel/EliminateExceptions.lean b/Strata/Languages/Laurel/EliminateExceptions.lean index 57be9adcdb..8116c56a7f 100644 --- a/Strata/Languages/Laurel/EliminateExceptions.lean +++ b/Strata/Languages/Laurel/EliminateExceptions.lean @@ -10,6 +10,7 @@ public import Strata.Languages.Laurel.LaurelPass public import Strata.Languages.Laurel.SemanticModel import Strata.Languages.Laurel.MapStmtExpr import Strata.Languages.Laurel.HeapParameterization +import Strata.Languages.Laurel.ModifiesClauses import Strata.Util.Tactics /-! @@ -452,7 +453,22 @@ private def lowerProc (proc : Procedure) : EM Procedure := do let p' := substLocal c.binding.text (resultApp "Result..err" (localRef exnResultVar)) c.postcondition let conj := andOf (resultApp "Result..isBad" (localRef exnResultVar)) p' ({ condition := withSrc c.condition.source (impliesOf c.condition conj), free := isBodiless } : Condition)) - let allPosts := wrappedPosts ++ onThrowPosts ++ onThrowsPosts + -- Exceptional frame (`onThrow modifies …`): a two-state frame axiom guarded by + -- `Result..isBad($result)`, so on the throwing path only the listed locations + -- may change. Built here (not in `ModifiesClauses`, which runs earlier) because + -- `$result` only exists after this pass. Emitted only when the user declared an + -- exceptional frame; otherwise the throwing path is left unconstrained (the + -- normal `modifies` frame is already `isGood`-guarded via `goodWrap` above, so + -- it says nothing on the Bad path). Reuses the normal frame-axiom builder. + let onThrowModifiesPosts : List Condition := + if proc.onThrowModifies.isEmpty then [] + else match buildModifiesEnsures proc model proc.onThrowModifies (mkId "$heap") with + | some frame => + [{ condition := withSrc proc.name.source + (impliesOf (resultApp "Result..isBad" (localRef exnResultVar)) frame) + free := isBodiless }] + | none => [] + let allPosts := wrappedPosts ++ onThrowPosts ++ onThrowsPosts ++ onThrowModifiesPosts -- Body assembly (only when there is an implementation). let goodArg := match valName? with | some n => localRef n | none => litBool true let construct := iteOf (localRef exnThrownVar) @@ -471,7 +487,8 @@ private def lowerProc (proc : Procedure) : EM Procedure := do body := newBody throwsType := none onThrow := [] - onThrows := [] } + onThrows := [] + onThrowModifies := [] } where /-- The `$thrown`/`$exc`/`$returning` declarations, emitted when the body uses the exceptional channel. -/ diff --git a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean index f00143a4c0..6e7b9f1c91 100644 --- a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean @@ -264,6 +264,8 @@ private def procedureToOp (proc : Procedure) : StrataDDM.Operation := laurelOp "onThrowClause" #[ident c.binding.text, stmtExprToArg c.predicate]) |>.toArray let onThrowsArgs := proc.onThrows.map (fun c => laurelOp "onThrowsClause" #[stmtExprToArg c.condition, ident c.binding.text, stmtExprToArg c.postcondition]) |>.toArray + let onThrowModifiesArgs := if proc.onThrowModifies.isEmpty then #[] + else #[laurelOp "onThrowModifiesClause" #[commaSep (proc.onThrowModifies.map stmtExprToArg |>.toArray)]] let invokeOnArg := optionArg (proc.invokeOn.map fun e => laurelOp "invokeOnClause" #[stmtExprToArg e]) let (opaqueSpecArg, bodyArg) := match proc.body with @@ -292,6 +294,7 @@ private def procedureToOp (proc : Procedure) : StrataDDM.Operation := seqArg onThrowsArgs, invokeOnArg, opaqueSpecArg, + seqArg onThrowModifiesArgs, bodyArg ] } diff --git a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean index bfb6410794..1e85a80433 100644 --- a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean +++ b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean @@ -536,9 +536,9 @@ def parseProcedure (arg : Arg) : TransM Procedure := do match op.name, op.args with | q`Laurel.procedure, #[nameArg, paramArg, returnTypeArg, returnParamsArg, - requiresArg, throwsArg, onThrowArg, onThrowsArg, invokeOnArg, opaqueSpecArg, bodyArg] + requiresArg, throwsArg, onThrowArg, onThrowsArg, invokeOnArg, opaqueSpecArg, onThrowModifiesArg, bodyArg] | q`Laurel.function, #[nameArg, paramArg, returnTypeArg, returnParamsArg, - requiresArg, throwsArg, onThrowArg, onThrowsArg, invokeOnArg, opaqueSpecArg, bodyArg] => + requiresArg, throwsArg, onThrowArg, onThrowsArg, invokeOnArg, opaqueSpecArg, onThrowModifiesArg, bodyArg] => let name ← translateIdent nameArg let parameters ← translateParameters paramArg -- Either returnTypeArg or returnParamsArg may have a value, not both @@ -590,6 +590,21 @@ def parseProcedure (arg : Arg) : TransM Procedure := do | _, _ => TransM.error s!"Expected onThrowsClause, got {repr cOp.name}" | _ => TransM.error "Expected operation in onThrows sequence" | _ => pure [] + -- Parse `onThrow modifies …` exceptional-frame clauses (E4 - zero or more); + -- collect all their comma-separated refs into a single list. + let onThrowModifies ← match onThrowModifiesArg with + | .seq _ _ clauses => do + let mut all : List StmtExprMd := [] + for arg in clauses do + match arg with + | .op cOp => match cOp.name, cOp.args with + | q`Laurel.onThrowModifiesClause, #[refsArg] => + let refs ← translateModifiesExprs refsArg + all := all ++ refs + | _, _ => TransM.error s!"Expected onThrowModifiesClause, got {repr cOp.name}" + | _ => TransM.error "Expected operation in onThrowModifies sequence" + pure all + | _ => pure [] -- Parse optional invokeOn clause let invokeOn ← match invokeOnArg with | .option _ (some (.op invokeOnOp)) => match invokeOnOp.name, invokeOnOp.args with @@ -639,11 +654,12 @@ def parseProcedure (arg : Arg) : TransM Procedure := do throwsType := throwsType onThrow := onThrow onThrows := onThrows + onThrowModifies := onThrowModifies body := procBody } | q`Laurel.procedure, args | q`Laurel.function, args => - TransM.error s!"parseProcedure expects 11 arguments, got {args.size}" + TransM.error s!"parseProcedure expects 12 arguments, got {args.size}" | _, _ => TransM.error s!"parseProcedure expects procedure or function, got {repr op.name}" diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean index 690ba7ccbd..b7aeca925e 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean @@ -12,7 +12,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: added `when C throws (e) P` exceptional behavior-case clause on procedures/functions. +-- Last grammar change: `onThrow modifies …` exceptional-frame clause placed after the `opaque` block (next to the normal `modifies`). public import StrataDDM.AST import StrataDDM.BuiltinDialects.Init import StrataDDM.Integration.Lean.HashCommands diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st index 4d37f8e455..e5ae0f9d15 100644 --- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st +++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st @@ -223,6 +223,10 @@ category OnThrowsClause; op onThrowsClause(condition: StmtExpr, binding: Ident, postcondition: StmtExpr): OnThrowsClause => "\n when " condition:0 " throws (" binding ") " postcondition:0; +// Exceptional frame (E4): the modifies clause that applies on the throwing path. +category OnThrowModifiesClause; +op onThrowModifiesClause(refs: CommaSepBy StmtExpr): OnThrowModifiesClause => "\n onThrow modifies " refs; + category Body; op body(body: StmtExpr): Body => "\n" body:0; op externalBody: Body => "external"; @@ -237,8 +241,9 @@ op procedure (name : Ident, parameters: CommaSepBy Parameter, onThrows: Seq OnThrowsClause, invokeOn: Option InvokeOnClause, opaqueSpec: Option OpaqueSpec, + onThrowModifies: Seq OnThrowModifiesClause, body : Option Body) : Procedure => - "procedure " name "(" parameters ")" returnType returnParameters requires throws onThrow onThrows invokeOn opaqueSpec body ";"; + "procedure " name "(" parameters ")" returnType returnParameters requires throws onThrow onThrows invokeOn opaqueSpec onThrowModifies body ";"; op function (name : Ident, parameters: CommaSepBy Parameter, returnType: Option ReturnType, @@ -249,8 +254,9 @@ op function (name : Ident, parameters: CommaSepBy Parameter, onThrows: Seq OnThrowsClause, invokeOn: Option InvokeOnClause, opaqueSpec: Option OpaqueSpec, + onThrowModifies: Seq OnThrowModifiesClause, body : Option Body) : Procedure => - "function " name "(" parameters ")" returnType returnParameters requires throws onThrow onThrows invokeOn opaqueSpec body ";"; + "function " name "(" parameters ")" returnType returnParameters requires throws onThrow onThrows invokeOn opaqueSpec onThrowModifies body ";"; op composite (name: Ident, extending: Option Extends, fields: Seq Field, procedures: Seq Procedure): Composite => "composite " name extending " {" fields procedures " }"; diff --git a/Strata/Languages/Laurel/HeapParameterization.lean b/Strata/Languages/Laurel/HeapParameterization.lean index c1d4b2d0ff..ed0fb452df 100644 --- a/Strata/Languages/Laurel/HeapParameterization.lean +++ b/Strata/Languages/Laurel/HeapParameterization.lean @@ -131,8 +131,12 @@ def analyzeProc (proc : Procedure) : AnalysisResult := -- ...and `when C throws (e) P` behavior cases (E4), whose trigger/postcondition -- may dereference composite parameters, just like a precondition. let onThrowsResult := (proc.onThrows.forM (fun c => do collectExprMd c.condition; collectExprMd c.postcondition)).run {} |>.2 + -- ...and the exceptional frame (`onThrow modifies …`): naming heap locations + -- that may change on the throwing path means the procedure writes the heap, + -- so `$heap` must be threaded in (mirrors the `!modif.isEmpty` rule for the + -- normal modifies above). { readsHeapDirectly := bodyResult.readsHeapDirectly || precondResult.readsHeapDirectly || onThrowResult.readsHeapDirectly || onThrowsResult.readsHeapDirectly, - writesHeapDirectly := bodyResult.writesHeapDirectly || precondResult.writesHeapDirectly || onThrowResult.writesHeapDirectly || onThrowsResult.writesHeapDirectly, + writesHeapDirectly := bodyResult.writesHeapDirectly || precondResult.writesHeapDirectly || onThrowResult.writesHeapDirectly || onThrowsResult.writesHeapDirectly || !proc.onThrowModifies.isEmpty, callees := bodyResult.callees ++ precondResult.callees ++ onThrowResult.callees ++ onThrowsResult.callees } def computeReadsHeap (procs : List Procedure) : List Identifier := @@ -550,12 +554,17 @@ def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : Transform let post ← heapTransformExpr heapName model c.postcondition pure { c with condition := dropCastAsserts cond, postcondition := dropCastAsserts post } + -- Exceptional frame targets are Composite references; heap-transform them + -- like the normal modifies entries. + let onThrowModifies' ← proc.onThrowModifies.mapM (heapTransformExpr heapName model ·) + return { proc with inputs := inputs', outputs := outputs', preconditions := preconditions', onThrow := onThrow', onThrows := onThrows', + onThrowModifies := onThrowModifies', body := body' } else if readsHeap then @@ -596,11 +605,16 @@ def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : Transform let post ← heapTransformExpr heapName model c.postcondition pure { c with condition := dropCastAsserts cond, postcondition := dropCastAsserts post } + -- Exceptional frame targets are Composite references; heap-transform them + -- like the normal modifies entries. + let onThrowModifies' ← proc.onThrowModifies.mapM (heapTransformExpr heapName model ·) + return { proc with inputs := inputs', preconditions := preconditions', onThrow := onThrow', onThrows := onThrows', + onThrowModifies := onThrowModifies', body := body' } else diff --git a/Strata/Languages/Laurel/LaurelAST.lean b/Strata/Languages/Laurel/LaurelAST.lean index ceb2441233..ed90fb46d1 100644 --- a/Strata/Languages/Laurel/LaurelAST.lean +++ b/Strata/Languages/Laurel/LaurelAST.lean @@ -246,6 +246,13 @@ structure Procedure : Type where holds). Distinct from `onThrow` (`isBad ==> P`), which constrains every exceptional exit without forcing one. -/ onThrows : List OnThrowsClause := [] + /-- Exceptional frame (`onThrow modifies …`): the modifies clause that applies + on the *throwing* path, mirroring the normal `modifies` (in `Body.Opaque`) + that applies on the normal-return path. Lowered by `EliminateExceptions` + to a frame condition guarded by `Result..isBad($result)` — so on the + exceptional exit only these locations may change. Empty means the throwing + path is left unconstrained (backward-compatible default). -/ + onThrowModifies : List (AstNode StmtExpr) := [] /-- A typed parameter for a procedure. diff --git a/Strata/Languages/Laurel/MapStmtExpr.lean b/Strata/Languages/Laurel/MapStmtExpr.lean index ceb7305d31..cac8a89b63 100644 --- a/Strata/Languages/Laurel/MapStmtExpr.lean +++ b/Strata/Languages/Laurel/MapStmtExpr.lean @@ -236,7 +236,8 @@ def mapProcedureM [Monad m] (f : StmtExprMd → m StmtExprMd) (proc : Procedure) invokeOn := ← proc.invokeOn.mapM f onThrow := ← proc.onThrow.mapM (fun c => do pure { c with predicate := ← f c.predicate }) onThrows := ← proc.onThrows.mapM (fun c => do - pure { c with condition := ← f c.condition, postcondition := ← f c.postcondition }) } + pure { c with condition := ← f c.condition, postcondition := ← f c.postcondition }) + onThrowModifies := ← proc.onThrowModifies.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 ee1fee389b..d07a36e981 100644 --- a/Strata/Languages/Laurel/Resolution.lean +++ b/Strata/Languages/Laurel/Resolution.lean @@ -2771,7 +2771,7 @@ def resolveBody (body : Body) : ResolveM Body := do boolean predicate). Recorded for the verifier; not enforced — Java-style declare-or-catch is front-end policy. See `laurel_extensions.md` (E4). -/ def resolveExceptionalContract (proc : Procedure) - : ResolveM (Option HighTypeMd × List OnThrowClause × List OnThrowsClause) := do + : ResolveM (Option HighTypeMd × List OnThrowClause × List OnThrowsClause × List (AstNode StmtExpr)) := do -- Resolve the `throws` type and record whether it is a well-formed -- `BaseException` subtype (used to gate the synthesized `onThrow` below — we -- must not synthesize `e is T` for an invalid `T`, which would cascade a @@ -2831,7 +2831,10 @@ def resolveExceptionalContract (proc : Procedure) let binding' ← defineNameCheckDup c.binding (.var c.binding bindTy) let postcondition' ← Check.resolveStmtExpr c.postcondition { val := .TBool, source := c.postcondition.source } pure ({ condition := condition', binding := binding', postcondition := postcondition' } : OnThrowsClause) - pure (throwsType', onThrow', onThrows') + -- Exceptional frame (`onThrow modifies …`): resolve each modifies target like + -- an ordinary (body) modifies reference — a Composite reference in scope. + let onThrowModifies' ← proc.onThrowModifies.mapM resolveStmtExpr + pure (throwsType', onThrow', onThrows', onThrowModifies') /-- (Procedure) ``` @@ -2868,12 +2871,13 @@ def resolveProcedure (proc : Procedure) : ResolveM Procedure := do -- (e.g. destructive assignments) inside a transparent body. So there is -- no transparent-body rejection here, unlike `resolveInstanceProcedure`. let invokeOn' ← proc.invokeOn.mapM resolveStmtExpr - let (throwsType', onThrow', onThrows') ← resolveExceptionalContract proc + let (throwsType', onThrow', onThrows', onThrowModifies') ← resolveExceptionalContract proc return { name := procName', inputs := inputs', outputs := outputs', isFunctional := proc.isFunctional, preconditions := pres', decreases := dec', invokeOn := invokeOn', throwsType := throwsType', onThrow := onThrow', onThrows := onThrows', + onThrowModifies := onThrowModifies', body := body' } /-- Resolve a field: define its name under the qualified key (OwnerType.fieldName) and resolve its type. -/ @@ -2911,12 +2915,13 @@ def resolveInstanceProcedure (typeName : Identifier) (proc : Procedure) : Resolv modify fun s => { s with errors := s.errors.push diag } let invokeOn' ← proc.invokeOn.mapM resolveStmtExpr modify fun s => { s with instanceTypeName := savedInstType } - let (throwsType', onThrow', onThrows') ← resolveExceptionalContract proc + let (throwsType', onThrow', onThrows', onThrowModifies') ← resolveExceptionalContract proc return { name := procName', inputs := inputs', outputs := outputs', isFunctional := proc.isFunctional, preconditions := pres', decreases := dec', invokeOn := invokeOn', throwsType := throwsType', onThrow := onThrow', onThrows := onThrows', + onThrowModifies := onThrowModifies', body := body' } /-- Resolve a type definition. -/ diff --git a/StrataTest/Languages/Laurel/Examples/Objects/ExceptionalModifies.lean b/StrataTest/Languages/Laurel/Examples/Objects/ExceptionalModifies.lean new file mode 100644 index 0000000000..e93d79002a --- /dev/null +++ b/StrataTest/Languages/Laurel/Examples/Objects/ExceptionalModifies.lean @@ -0,0 +1,75 @@ +/- + Copyright Strata Contributors + + SPDX-License-Identifier: Apache-2.0 OR MIT +-/ + +import StrataTest.Util.TestLaurel + +open StrataTest.Util +open Strata + +/- +The exceptional frame `onThrow modifies …` (E4): the modifies clause that +applies on the *throwing* path, mirroring the normal `modifies` that applies on +the normal-return path. + +A throwing procedure's normal `modifies` frame is lowered (via `ModifiesClauses` ++ the Good-path wrap) to `Result..isGood($result) ==> `, so it says nothing when the procedure throws. `onThrow modifies T` +adds the complementary Bad-path frame, lowered by `EliminateExceptions` to +`Result..isBad($result) ==> `. So the two paths can name +different frames, and the throwing-path frame is *checked* on the body and +*assumed* at call sites. +-/ + +-- Positive: the body honours both frames — on the normal path only `c` changes, +-- on the throwing path only `logCell` changes (the freshly-allocated `Err` is +-- excluded from the frame, since it did not exist in the pre-state heap). +#eval testLaurel <| +#strata +program Laurel; +composite Cell { + value: int +} +composite Err extends BaseException {} +procedure doWork(c: Cell, logCell: Cell, fail: bool) + returns (r: int) + throws Err + opaque + modifies c + onThrow modifies logCell +{ + if fail then { + logCell#value := 1; + var e: Err := new Err; + throw e + }; + c#value := 42; + r := 0 +}; +#end + +-- Negative: on the throwing path this modifies `c`, but `onThrow modifies +-- logCell` claims only `logCell` may change there, so the exceptional frame +-- check fails. +#eval testLaurel <| +#strata +program Laurel; +composite Cell { + value: int +} +composite Err extends BaseException {} +procedure doWorkBad(c: Cell, logCell: Cell) +// ^^^^^^^^^ error: assertion could not be proved + returns (r: int) + throws Err + opaque + modifies c + onThrow modifies logCell +{ + c#value := 99; + var e: Err := new Err; + throw e +}; +#end diff --git a/docs/design/laurel_exceptions_lowering_examples.txt b/docs/design/laurel_exceptions_lowering_examples.txt index c241f0e29e..8335731df5 100644 --- a/docs/design/laurel_exceptions_lowering_examples.txt +++ b/docs/design/laurel_exceptions_lowering_examples.txt @@ -38,6 +38,16 @@ caught value into a fresh per-handler local (`$exc_a_N`) at handler entry and substitutes the binding with it. The outer `a` therefore still reads the outer exception (`tag == 1`), not the inner one. +Note: case 9 (`doWork`) shows the exceptional frame `onThrow modifies …`. A +procedure can declare a different modifies clause per exit path: the normal +`modifies c` lowers to `Result..isGood($result) ==> ` and +`onThrow modifies logCell` to `Result..isBad($result) ==> ` (see layer 4). In layer 3 the pass is run in isolation, so the +exceptional frame references `$heap` before heap parameterization has introduced +it, and the normal `modifies c` is still un-lowered (the `ModifiesClauses` pass, +which turns it into the Good-path frame, runs separately); layer 4 is the +coherent, fully-lowered form. + This file is generated output kept for reference; it is not built or executed. ╔══════════════════════════════════════════════════════════════╗ @@ -858,3 +868,102 @@ spec { } } }; + +╔══════════════════════════════════════════════════════════════╗ +║ CASE +╚══════════════════════════════════════════════════════════════╝ +──── (1) JAVA (illustrative source) ──── +int doWork(Cell c, Cell logCell, boolean fail) throws Err { + if (fail) { logCell.value = 1; throw new Err(); } // throw path: writes logCell + c.value = 42; // normal path: writes c + return 0; +} + +──── (2) LAUREL — generated, with exception keywords ──── +procedure doWork(c: Cell, logCell: Cell, fail: bool) + returns (r: int) + throws Err + onThrow (e) e is Err + opaque + modifies c + onThrow modifies logCell +{ + if fail then { + logCell#value := 1; + var e: Err := new Err; + throw e + }; + c#value := 42; + r := 0 +}; + +──── (3) LAUREL — after EliminateExceptions pass ──── +procedure doWork(c: Cell, logCell: Cell, fail: bool) + returns ($result: (Result)) + opaque + ensures Result..isBad($result) ==> Result..err($result) is Err + ensures Result..isBad($result) ==> forall($modifies_obj: Composite) => forall($modifies_fld: Field) => Composite..ref!($modifies_obj) < Heap..nextReference!(old($heap)) & $modifies_obj != logCell ==> readField(old($heap), $modifies_obj, $modifies_fld) == readField($heap, $modifies_obj, $modifies_fld) + modifies c +{ + var $thrown: bool := false; + var $exc: Composite; + var $returning: bool := false; + var r: int; + { + { + if fail then { + { + logCell#value := 1; + var e: Err := new Err; + $exc := e; + $thrown := true; + exit $exnexit + } + }; + c#value := 42; + r := 0 + } + }$exnexit; + if $thrown then { + $result := Bad($exc) + } else { + $result := Good(r) + } +}; + +──── (4) CORE IR — generated by full pipeline (procedures) ──── +procedure doWork (inout $heap : Heap, c : Composite, logCell : Composite, fail : bool, out $result : Result int Composite) +spec { + ensures [postcondition_0]: if Result..isGood($result) then forall $modifies_obj : Composite :: forall $modifies_fld : Field :: if Composite..ref!($modifies_obj) < Heap..nextReference!(old $heap) && !($modifies_obj == c) then readField(old $heap, $modifies_obj, $modifies_fld) == readField($heap, $modifies_obj, $modifies_fld) else true else true; + ensures [postcondition_1]: if Result..isBad($result) then (ancestorsPerType[Composite..typeTag!(Result..err($result))])[Err_TypeTag] else true; + ensures [postcondition_2]: if Result..isBad($result) then forall $modifies_obj : Composite :: forall $modifies_fld : Field :: if Composite..ref!($modifies_obj) < Heap..nextReference!(old $heap) && !($modifies_obj == logCell) then readField(old $heap, $modifies_obj, $modifies_fld) == readField($heap, $modifies_obj, $modifies_fld) else true else true; + } { + $body: { + var $thrown : bool := false; + var $exc : Composite; + var $returning : bool := false; + var r : int; + $exnexit: { + if (fail) { + var $tmp0 : int := 1; + $heap := updateField($heap, logCell, Cell.value, BoxInt($tmp0)); + var $th_tmp0 : int := Heap..nextReference!($heap); + var $$heap_0 : Heap := $heap; + $heap := increment($heap); + var e : Composite := MkComposite($th_tmp0, Err_TypeTag); + $exc := e; + $thrown := true; + exit $exnexit; + } + var $tmp1 : int := 42; + $heap := updateField($heap, c, Cell.value, BoxInt($tmp1)); + r := 0; + var $unused_1 : int := r; + } + if ($thrown) { + $result := Bad($exc); + } else { + $result := Good(r); + } + } +};