From c312d31ed2f3901c0328fe31284af073646c4bd7 Mon Sep 17 00:00:00 2001 From: 284km Date: Sat, 7 Nov 2026 18:51:59 +0900 Subject: [PATCH] Support RISC-V resource scopes and rebalance compiler CI --- .github/workflows/ci.yml | 2 +- README.md | 2 +- RUNBOOK.md | 8 ++++ docs/changelog.md | 24 ++++++++++ docs/language-reference.md | 15 +++++- lib/codegen_llvm.ml | 9 ++-- lib/codegen_riscv.ml | 53 ++++++++++++++++++++- lib/codegen_wasm.ml | 8 +++- scripts/ci_gate_check.rb | 11 +++++ scripts/rv_exec_check.sh | 29 +++++++++++- scripts/tool_preflight_check.sh | 4 +- test/parity/factory_inference.expected | 5 ++ test/parity/with_scope.expected | 14 ++++++ test/parity/with_scope.mere | 65 ++++++++++++++++++++++++++ test/test_basic.ml | 2 +- 15 files changed, 237 insertions(+), 14 deletions(-) create mode 100644 test/parity/factory_inference.expected create mode 100644 test/parity/with_scope.expected create mode 100644 test/parity/with_scope.mere diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 2204ddfc..6502437f 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -961,7 +961,7 @@ jobs: # versions old while every gate here was green: nothing was pointed # outward. This is. - name: first_run_check (the README, executed) - if: ${{ !cancelled() && matrix.group == 'compiler' }} + if: ${{ !cancelled() && matrix.group == 'containers' }} run: opam exec -- sh scripts/first_run_check.sh # Parts of the Wasm runtime are literal WAT text gated behind a flag only diff --git a/README.md b/README.md index fd640717..cd031d46 100644 --- a/README.md +++ b/README.md @@ -109,7 +109,7 @@ source tree is needed to build or run an app. It **self-hosts** — the Mere-in-Mere compiler, compiled by itself and run as Wasm, emits byte-identical output to the reference. The RISC-V backend (RV32IM, and RV64IM since v0.1.394) emits a flat binary with no external assembler or linker, and `--bare` hands the program the machine instead of a host; on that there is a kernel, a scheduler and a shell written in Mere, and the self-hosted compiler runs there as a user process — on a RISC-V CPU also written in Mere — emitting WAT byte-identical to the native one. See [docs/bare-metal.md](docs/bare-metal.md). -- **2946 tests passing** (`dune test` with the full CI toolchain), plus cross-backend parity (250 programs) and integration and differential checks against external oracles in CI. The test total includes optional Wasm checks and depends on the installed tools. The full-suite and parity counts are re-derived by `scripts/first_run_check.sh`. +- **2946 tests passing** (`dune test` with the full CI toolchain), plus cross-backend parity (251 programs) and integration and differential checks against external oracles in CI. The test total includes optional Wasm checks and depends on the installed tools. The full-suite and parity counts are re-derived by `scripts/first_run_check.sh`. - **🏆 Bootstrap fixpoint — truly self-hosting** (v0.1.10, 2026-07-12): the Mere-in-Mere compiler, **compiled by itself and run as wasm, produces byte-identical output to the reference** — and that output runs correctly. Compiling a program with (A) the compiler under the interpreter and (B) the compiler compiled by itself yields the same WAT, byte for byte (CI-verified by a permanent fixpoint regression test). Getting there required guaranteed tail calls in the self-host codegen (`return_call_indirect`, Stage 55f) and fixing three latent self-compilation bugs (an eager pattern-check payload dereference, pointer-equality string compares in the untyped self-host codegen, and a missing `\r` lexer escape — Stage 55g). See [docs/changelog.md](docs/changelog.md). - **🏗️ A fifth backend, and an operating system on top of it** (v0.1.134–198): `mere -rv` emits a flat RV32IM binary with no external assembler or linker, and `--bare` hands the program the machine instead of a host — raw memory arrives as an unforgeable window capability, traps as ordinary Mere closures. On that: a preemptive scheduler, a shell, a syscall boundary, and finally **Mere's own self-hosted compiler running as a user process on a Mere kernel, on a CPU written in Mere**, emitting WAT byte-identical to the native interpreter. `mere -rvg` then emits a debug map beside the binary — from the same item list the assembler consumes, so it describes the bytes that actually ran — which is what lets [riscv-dbg](https://github.com/284km/memu/tree/main/riscv-dbg) break on Mere **source lines**, print a backtrace, and step **backwards**. `mere -rv64` (v0.1.394) is the same backend at twice the width: an RV64IM binary from the same code generator. See [docs/bare-metal.md](docs/bare-metal.md). - **🛰️ gRPC and GraphQL, against real clients** (v0.1.280–283): `contrib/proto` (protobuf wire both ways, `FileDescriptorSet`, and a code generator from `.proto`), `contrib/http2` (framing + HPACK + an h2c server with flow control in both directions and a worker pool), and `contrib/graphql` (lexer / parser / printer / SDL / executor with null propagation, introspection, and 21 of the specification's 32 validation rules). `grpcurl` and `graphql-js` are the oracles, and interfaces and unions resolve from `__typename` the way graphql-js's default `resolveType` does. See [contrib/proto/README.md](contrib/proto/README.md), [contrib/http2/README.md](contrib/http2/README.md), [contrib/graphql/README.md](contrib/graphql/README.md). diff --git a/RUNBOOK.md b/RUNBOOK.md index 36646086..180b33b7 100644 --- a/RUNBOOK.md +++ b/RUNBOOK.md @@ -265,6 +265,14 @@ durations and cache-hit messages when measuring changes: a cache hit does not avoid the action's system-package installation. All 191 gates and all four build configurations remain required. +The README execution gate runs in the containers group. It still forces the +full unit suite to derive the README's test count, executes the transcript, +and builds a newcomer's program outside the checkout. The separate full +unit-suite step remains in compiler. Moving the README gate changes where +these checks run; it does not remove either execution or reuse cached output. +The assignment validator pins its name, command and destination, and the +containers preflight requires dune for it. + The hosted RISC-V execution sweep has three required partitions: `rv_exec_check.sh --corpus32` in coroutines, `--corpus64` in RISC-V ownership, and `--contracts` in RISC-V. The default `--all` still runs both corpora and diff --git a/docs/changelog.md b/docs/changelog.md index 692aa53d..78a90a5f 100644 --- a/docs/changelog.md +++ b/docs/changelog.md @@ -4,6 +4,30 @@ Major implementation milestones recorded per-slice (newest first). See `git log` --- +## Unreleased + +RV32 and RV64 support scope-bound `with` resources. Lowering happens before +reachability, closure capture and frame sizing, so acquisition runs once and +close continuations preserve the body's result, including after a call in the +body's final position. Existing normal-return and failure propagation rules +are preserved. The complete factory fixture now also runs on both widths. +The hosted boundary gate requires the factory and scope fixtures to compile, +exit successfully and match explicit output oracles at both widths; these +cases cannot disappear into the corpus's named compile refusals. + +Wasm `with` now loads a record's close field using the current eight-byte +value layout, wraps pointers for memory access and supplies i64 closure +arguments. The scope fixture exposed the old four-byte access sequence, +which emitted WAT that did not validate for a resource with a close field. +LLVM close extraction now uses the instantiated record aggregate and the +current i64 unit calling convention, including parameterized Drop records. + +The README execution gate moves from compiler to containers. It retains the +full unit-suite rerun used to verify the README count, every transcript +command and the external-directory program. All 191 gates, nine groups and +four build configurations remain required. Routing controls pin the README +gate and the containers preflight checks dune explicitly. + ## v0.1.712 — 2026-11-07 Wasm now specializes a factory value whose uses settle on one concrete return diff --git a/docs/language-reference.md b/docs/language-reference.md index c7defd10..847c9586 100644 --- a/docs/language-reference.md +++ b/docs/language-reference.md @@ -277,6 +277,19 @@ if cond then print "msg" // side-effect-only; body must be unit-typed ### with (scope-bound resources with Drop, Phase 3.1) `with c = v in body` is for **resources with Drop** (DB connections / file handles / mutexes etc.). The bound value's type must be a `drop type ...`-declared Drop type (use `let` for Trivial values). At scope end, the value's `close: unit -> unit` field is invoked (no-op if absent). Multiple bindings close in **LIFO order**. + +On unreleased main, RV32 and RV64 also support `with`. The value is acquired +once, nested bindings close in LIFO order, and cleanup preserves the body's +result. A record without `close` has no close call. On RISC-V and Wasm, +OwnedVec storage retains the target's existing arena lifetime; `with` does +not add early arena reclamation. + +A scope closes after its body returns normally. A failure caught inside the +body still permits cleanup. A failure that leaves the body skips its close; +a failing close propagates and skips outer closes. `with` is not an exception +finalizer. The [scope fixture](../test/parity/with_scope.mere) checks this order, +shadowing, captured closes and preserved results across the backends. + ``` drop type Conn = { id: int, close: unit -> unit }; let mk_conn = fn id -> @@ -329,7 +342,7 @@ region R { } ``` -**`Trivial[R]` constraint (Phase 2.6)**: only types **without Drop semantics** (Trivial) can be placed in a region. Drop types are declared with `drop type Name = ...`; including such a type in a region (`&R v` / `R.alloc(v)` / view fields) is a type error. This is "a constraint that allows bulk region freeing"; caps that need Drop (DB connections / file handles etc.) are separately managed by a future `with` expression. +**`Trivial[R]` constraint (Phase 2.6)**: only types **without Drop semantics** (Trivial) can be placed in a region. Drop types are declared with `drop type Name = ...`; including such a type in a region (`&R v` / `R.alloc(v)` / view fields) is a type error. This is "a constraint that allows bulk region freeing"; caps that need Drop (DB connections / file handles etc.) are separately managed by `with` expressions. ``` drop type Conn = { id: int }; diff --git a/lib/codegen_llvm.ml b/lib/codegen_llvm.ml index 6817ad8e..ae91112c 100644 --- a/lib/codegen_llvm.ml +++ b/lib/codegen_llvm.ml @@ -8812,12 +8812,11 @@ let rec emit_expr (env : env) (e : Ast.expr) : string = in (* Discover record type name + struct + close field index (if any). *) let close_info = - match value_ty with - | Ast.TyCon (n, _) when Hashtbl.mem Typer.records n -> - let fields = record_fields n in + match record_fields_of value_ty with + | Some (struct_name, fields) -> let rec find_close i = function | [] -> None - | (fname, fty) :: _ when fname = "close" -> Some (i, fty, n) + | (fname, fty) :: _ when fname = "close" -> Some (i, fty, struct_name) | _ :: rest -> find_close (i + 1) rest in find_close 0 fields @@ -8842,7 +8841,7 @@ let rec emit_expr (env : env) (e : Ast.expr) : string = emit_instr (Printf.sprintf " %s = extractvalue %s %s, 1" fn_r cname close_cl); let _ = fresh_reg () in - emit_instr (Printf.sprintf " call i32 %s(ptr %s, i32 0)" fn_r env_r)); + emit_instr (Printf.sprintf " call i64 %s(ptr %s, i64 0)" fn_r env_r)); (* Phase 15.13: scope-bound Drop for OwnedVec. Free the data buffer and zero out the struct's data pointer so the registry's free_all sweep at main-end won't double-free (free(NULL) is a diff --git a/lib/codegen_riscv.ml b/lib/codegen_riscv.ml index f6245935..1ac02385 100644 --- a/lib/codegen_riscv.ml +++ b/lib/codegen_riscv.ml @@ -2740,7 +2740,7 @@ and compile_node (env : env) (e : Ast.expr) : unit = li t0 hi; emit_word (enc_s (0 * wsz ()) t0 t1 (stf3 ()) 0x23); (* sw hi, 0(t1) *) li t0 lo; emit_word (enc_s (wsz ()) t0 t1 (stf3 ()) 0x23); (* sw lo, 4(t1) *) emit_word (enc_i 0 t1 0 a0 0x13) (* mv a0, t1 *) - | Ast.With _ -> err e.loc "RV32I: `with` expressions are not supported yet" + | Ast.With _ -> err e.loc "RV32I internal: with-expression was not lowered" | Ast.Ref _ -> err e.loc "RV32I: `&` references are not supported yet" | Ast.Record_update (base, updates) -> let recname = @@ -8668,7 +8668,58 @@ let prepare_main (prog : Ast.program) : Ast.expr = | Monomorph.Unsupported (loc, what) -> err loc ("RV: " ^ what) | Monomorph.Error (loc, msg) -> err loc msg +(* Lower scope-bound resources before reachability, closure capture and frame + sizing. Ordinary lets keep acquisition single-shot, preserve the body's + result, and prevent a tail call from bypassing the close continuation. + Like the other backends, close runs after a normally returning body; this + does not add exception unwinding. OwnedVec storage follows the target's + existing arena lifetime, as on Wasm. *) +let lower_with (prog : Ast.program) : Ast.program = + let serial = ref 0 in + let fresh_result resource = + let rec next () = + let name = "__rv_with_result_" ^ string_of_int !serial in + incr serial; + if name = resource then next () else name + in next () + in + let rec rewrite e = Ast.rv_map_scoped ~shadow:[] replace e + and replace _ (e : Ast.expr) = + match e.Ast.node with + | Ast.With (name, value, body) -> + let value = rewrite value and body = rewrite body in + let close_ty = match Option.map Ast.walk value.Ast.ty with + | Some (Ast.TyCon (record, _)) -> + (match Hashtbl.find_opt Typer.records record with + | Some info -> List.assoc_opt "close" info.Typer.r_fields + | None -> None) + | _ -> None + in + let continuation = match close_ty with + | None -> body + | Some close_ty -> + let result = fresh_result name in + let resource = { value with Ast.node = Ast.Var name } in + let close = { e with Ast.node = Ast.Field_get (resource, "close"); ty = Some close_ty } in + let unit = { e with Ast.node = Ast.Unit_lit; ty = Some Ast.TyUnit } in + let call = { e with Ast.node = Ast.App (close, unit); ty = Some Ast.TyUnit } in + let saved = { e with Ast.node = Ast.Var result } in + let after = { e with Ast.node = Ast.Let ({ Ast.ploc = e.loc; pnode = Ast.P_wild }, call, saved) } in + (* Only synthetic reads occur inside this result binder. The source + body is its RHS; excluding the resource name keeps close hygienic. *) + { e with Ast.node = Ast.Let ({ Ast.ploc = e.loc; pnode = Ast.P_var result }, body, after) } + in + Some { e with Ast.node = Ast.Let ({ Ast.ploc = e.loc; pnode = Ast.P_var name }, value, continuation) } + | _ -> None + in + let decls = List.map (function + | Ast.Top_let (p, e) -> Ast.Top_let (p, rewrite e) + | Ast.Top_let_rec bs -> Ast.Top_let_rec (List.map (fun (n, l, e) -> n, l, rewrite e) bs) + | d -> d) prog.decls in + { Ast.decls; main = rewrite prog.main } + let build_items_sized (prog : Ast.program) : item list = + let prog = lower_with prog in let prog = Ast.lower_snapshots prog in let full = prepare_main prog in code_span := 0x200000; diff --git a/lib/codegen_wasm.ml b/lib/codegen_wasm.ml index 76234608..40a51eba 100644 --- a/lib/codegen_wasm.ml +++ b/lib/codegen_wasm.ml @@ -5416,12 +5416,16 @@ and emit_expr (e : Ast.expr) : unit = emit_instr (Printf.sprintf "local.set %d" result_slot); let cl_slot = fresh_local () in emit_instr (Printf.sprintf "local.get %d" v_slot); - emit_instr (Printf.sprintf "i32.load offset=%d" (4 * idx)); + emit_instr "i32.wrap_i64"; + emit_instr (Printf.sprintf "i64.load offset=%d" (8 * idx)); emit_instr (Printf.sprintf "local.set %d" cl_slot); emit_instr (Printf.sprintf "local.get %d" cl_slot); + emit_instr "i32.wrap_i64"; emit_instr "i32.load offset=0"; (* env *) - emit_instr "i32.const 0"; (* unit arg *) + emit_instr "i64.extend_i32_u"; + emit_instr "i64.const 0"; (* unit arg *) emit_instr (Printf.sprintf "local.get %d" cl_slot); + emit_instr "i32.wrap_i64"; emit_instr "i32.load offset=4"; (* fn_idx *) emit_instr "call_indirect (type $cl)"; emit_instr "drop"; (* discard close's return *) diff --git a/scripts/ci_gate_check.rb b/scripts/ci_gate_check.rb index 9f3a3e66..5577af0c 100644 --- a/scripts/ci_gate_check.rb +++ b/scripts/ci_gate_check.rb @@ -13,6 +13,7 @@ class Invalid < StandardError; end EXPECTED_CHECKS = 191 PREFLIGHT = "tool_preflight (a gate that did not run is not a gate that passed)" FULL_TESTS = "Run tests (full, with the wasm toolchain present)" + FIRST_RUN = "first_run_check (the README, executed)" CHECKOUT = "Check out the dogfood repositories" CACHE = "Restore the downstream compile cache" PACKAGES = "Install package dependencies" @@ -117,6 +118,7 @@ def self.check(workflow) require!(checks.map { |s| s["name"] }.uniq.length == checks.length, "check names must be unique") require!(RV_EXEC.keys.all? { |n| checks.count { |s| s["name"] == n } == 1 }, "all three RISC-V execution partitions must run once") + require!(checks.count { |s| s["name"] == FIRST_RUN } == 1, "the README execution gate must run once") require!(checks.count { |s| s["name"] == FULL_TESTS } == 1, "the full toolchain unit suite must run once") require!(checks.count { |s| s["name"] == CHECKOUT } == 1, "downstream checkouts must be present") require!(checks.count { |s| s["name"] == CACHE } == 1, "the downstream compile cache must be present") @@ -135,6 +137,11 @@ def self.check(workflow) require!(selected == ["riscv"] && !step["continue-on-error"], "global tool preflight controls need the complete RISC-V toolchain") assigned.fetch("riscv") << name + when FIRST_RUN + require!(selected == ["containers"], "the README gate belongs to containers") + require!(step["run"] == "opam exec -- sh scripts/first_run_check.sh", + "the README gate must retain the executed transcript and full test-count check") + assigned.fetch("containers") << name when CHECKOUT require!(selected.sort == CHECKOUT_GROUPS, "downstream and every RISC-V oracle group need checkouts") require!(!step["continue-on-error"], "missing required oracle checkouts must fail the group") @@ -204,6 +211,10 @@ def self.self_test(workflow) "optional oracle checkout" => ->(c) { c[:checkout]["continue-on-error"] = true }, "optional memu" => ->(c) { c[:checkout]["env"]["MERE_REQUIRE_MEMU"] = "false" }, "shared writable cache" => ->(c) { c[:cache]["if"] = "${{ !cancelled() && (matrix.group == 'compiler' || matrix.group == 'downstream') }}" }, + "missing README gate" => ->(c) { c[:steps].reject! { |s| s["name"] == FIRST_RUN } }, + "renamed README gate" => ->(c) { c[:steps].find { |s| s["name"] == FIRST_RUN }["name"] = "README renamed" }, + "README in wrong group" => ->(c) { c[:steps].find { |s| s["name"] == FIRST_RUN }["if"] = "${{ !cancelled() && matrix.group == 'compiler' }}" }, + "empty README gate" => ->(c) { c[:steps].find { |s| s["name"] == FIRST_RUN }["run"] = "true" }, "missing full suite" => ->(c) { c[:steps].delete(c[:full]) }, "empty full suite" => ->(c) { c[:full]["run"] = "true" }, "missing required preflight" => ->(c) { c[:steps].reject! { |s| s["name"] == PREFLIGHT } }, diff --git a/scripts/rv_exec_check.sh b/scripts/rv_exec_check.sh index ad9a011c..71eb0e98 100755 --- a/scripts/rv_exec_check.sh +++ b/scripts/rv_exec_check.sh @@ -652,9 +652,36 @@ else fi echo "rv_exec: $wfpass passed, $wffail failed for write_file/read_stdin (both widths, and --bare still refuses)" +# Scope cleanup is a required contract, not an allowed corpus refusal. These +# oracles are hand-written rather than derived from another backend. +for name in factory_inference with_scope; do + for width in 32 64; do + if [ "$width" = 32 ]; then runner="$RVRUN"; flag=-rv + else runner="$RVRUN64"; flag=-rv64; fi + [ -n "$runner" ] || continue + if ! "$MERE" "$flag" --ram 32 "$ROOT/test/parity/$name.mere" > "$TMP/prog.bin" 2>"$TMP/rverr"; then + printf ' FAIL %s:%s did not build\n' "$name" "$width" + head -3 "$TMP/rverr"; fail=$((fail+1)); rc=1; continue + fi + ( cd "$TMP" && perl -e 'alarm 60; exec @ARGV' "$runner" 32 ) > "$TMP/r.raw" 2>&1 + status=$? + grep -a -v '^rvrun' "$TMP/r.raw" > "$TMP/r.out" + if [ "$status" -eq 0 ] && cmp -s "$ROOT/test/parity/$name.expected" "$TMP/r.out"; then + printf ' ok %s:%s (scope cleanup and body result match the explicit oracle)\n' "$name" "$width" + pass=$((pass+1)) + else + printf ' FAIL %s:%s (exit %s or wrong output)\n' "$name" "$width" "$status" + diff -a "$ROOT/test/parity/$name.expected" "$TMP/r.out" | head -8 + fail=$((fail+1)); rc=1 + fi + done +done + fi -if [ "$MODE" != --corpus64 ]; then +if [ "$MODE" = --contracts ]; then + echo "rv_exec: $pass passed, $fail failed in additional boundary checks (both widths)" +elif [ "$MODE" != --corpus64 ]; then if [ -z "$RVRUN" ]; then echo "rv_exec: $pass built, $fail failed — nothing RAN; set MEMU= for that half" else diff --git a/scripts/tool_preflight_check.sh b/scripts/tool_preflight_check.sh index ac3972df..2163bc5c 100755 --- a/scripts/tool_preflight_check.sh +++ b/scripts/tool_preflight_check.sh @@ -78,6 +78,8 @@ if [ "$MODE" = "--poison" ]; then "ABSENT qemu-system-riscv32" MERE_CI_GROUP=riscv MERE_PREFLIGHT_FAKE_MISSING=qemu-system-riscv32 run "compiler still requires its native compiler" \ "ABSENT clang" MERE_CI_GROUP=compiler MERE_PREFLIGHT_FAKE_MISSING=clang + run "containers still requires dune for README verification" \ + "ABSENT dune" MERE_CI_GROUP=containers MERE_PREFLIGHT_FAKE_MISSING=dune for group in compiler web; do out=$(MERE_CI_GROUP="$group" MERE_PREFLIGHT_FAKE_MISSING=qemu-system-riscv32 sh "$0" 2>&1) if [ $? -ne 0 ] || ! printf '%s' "$out" | grep -qF "gate group: $group" \ @@ -88,7 +90,7 @@ if [ "$MODE" = "--poison" ]; then echo "poison caught: $group does not require an unrelated emulator" fi done - [ "$fails" -eq 0 ] && { echo "tool_preflight --poison: 10 caught"; exit 0; } + [ "$fails" -eq 0 ] && { echo "tool_preflight --poison: 11 caught"; exit 0; } echo "tool_preflight --poison: $fails not caught"; exit 1 fi diff --git a/test/parity/factory_inference.expected b/test/parity/factory_inference.expected new file mode 100644 index 00000000..4ac21c2e --- /dev/null +++ b/test/parity/factory_inference.expected @@ -0,0 +1,5 @@ +42 +43 +forty-four +forty-five +46 diff --git a/test/parity/with_scope.expected b/test/parity/with_scope.expected new file mode 100644 index 00000000..7a90d889 --- /dev/null +++ b/test/parity/with_scope.expected @@ -0,0 +1,14 @@ +11 +5 body +8 +5 +99 +11 +8 +55 +66 +77 +5 +440 +25 +1,0,3,2,4,6,7,8,12,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20 diff --git a/test/parity/with_scope.mere b/test/parity/with_scope.mere new file mode 100644 index 00000000..c57d94fc --- /dev/null +++ b/test/parity/with_scope.mere @@ -0,0 +1,65 @@ +// Scope-bound resources: acquisition, captured closes, LIFO and result values. +drop type Resource = { id: int, close: unit -> unit }; +drop type Plain = { id: int }; +let events = vec_new (); +let acquisitions = vec_new (); +let _ = vec_push acquisitions 0; +let acquire = fn id -> + let _ = vec_set acquisitions 0 (vec_get acquisitions 0 + 1) in + Resource { id = id, close = fn () -> vec_push events id }; +// This name would collide with the first generated result binder. +let collision = fn () -> + with __rv_with_result_0 = acquire 1 in __rv_with_result_0.id + 10; +let _ = print_int (collision ()); +let nested = fn () -> + with outer = acquire 2, inner = acquire 3 in + let _ = vec_push events 0 in + (outer.id + inner.id, "body"); +let (total, label) = nested (); +let _ = print (str_of_int total ++ " " ++ label); +let _ = print_int (with p = Plain { id = 7 } in p.id + 1); +let resource = 99; +let shadow = fn resource -> + with resource = acquire resource in resource.id + 1; +let _ = print_int (shadow 4); +let _ = print_int resource; +let captured = fn n -> + with r = acquire n in + let inner = fn x -> r.id + x in inner 5; +let _ = print_int (captured 6); +let target = fn n -> n + 1; +let tail = fn n -> with r = acquire n in target r.id; +let _ = print_int (tail 7); +// A failure caught inside the body returns normally and closes the resource. +let _ = print_int (with r = acquire 8 in try_or (fn () -> fail "caught") 55); +// Existing with semantics do not unwind closes when failure leaves the body. +let _ = print_int (try_or (fn () -> with r = acquire 9 in fail "escaping") 66); +// Failure in close propagates; outer closes are not exception finalizers. +let _ = print_int (try_or (fn () -> + with outer = acquire 10, + inner = Resource { id = 11, close = fn () -> fail "close" } in 0) 77); +// A parameterized record with close in the first field uses the same layout. +drop type 'a Box = { close: unit -> unit, value: 'a }; +let _ = print_int (with boxed = Box { close = fn () -> vec_push events 12, value = [2, 3] } in list_sum boxed.value); +// Enough nested resources to spill bindings beyond callee-saved registers. +let many = fn () -> + with r0 = acquire 20, + r1 = acquire 21, + r2 = acquire 22, + r3 = acquire 23, + r4 = acquire 24, + r5 = acquire 25, + r6 = acquire 26, + r7 = acquire 27, + r8 = acquire 28, + r9 = acquire 29, + r10 = acquire 30, + r11 = acquire 31, + r12 = acquire 32, + r13 = acquire 33, + r14 = acquire 34, + r15 = acquire 35 in + list_sum [r0.id, r1.id, r2.id, r3.id, r4.id, r5.id, r6.id, r7.id, r8.id, r9.id, r10.id, r11.id, r12.id, r13.id, r14.id, r15.id]; +let _ = print_int (many ()); +let _ = print_int (vec_get acquisitions 0); +print (str_join "," (list_map (vec_to_list events) str_of_int)) diff --git a/test/test_basic.ml b/test/test_basic.ml index 7a691a63..a3d28638 100644 --- a/test/test_basic.ml +++ b/test/test_basic.ml @@ -5769,7 +5769,7 @@ let () = "drop type LCgConn7 = { id: int, close: unit -> unit };\n\ let mk = fn i -> LCgConn7 { id = i, close = fn () -> () } in\n\ with c = mk 7 in c.id") - "call i32 "; + "call i64 "; assert_llvm "llvm: view typedef same as record (insertvalue then store)" (llvm_with_decls "view LCgCell8[R] of int { v: int };\n\