1
//! `(unwind-protect body cleanup...)` — guaranteed cleanup (Tier 3.4,
2
//! ADR-0026).
3
//!
4
//! ```lisp
5
//! (unwind-protect
6
//!     (acquire-and-do-risky-stuff)
7
//!   (release-resource))
8
//! ```
9
//!
10
//! `cleanup` runs on BOTH normal completion of `body` AND on a `$nomi_error`
11
//! raised inside it; the raise is then re-raised (cleanup never swallows it).
12
//! The form's value is `body`'s value on normal completion.
13
//!
14
//! Lowering (single-tag `Catch::One`, same shape family as the Tier 3.2
15
//! boundary wrapper and `(handler-case)`). Cleanup is emitted EXACTLY ONCE:
16
//! both exit paths converge on a `(ref null $nomi_condition)` — the caught
17
//! condition on the exceptional path, a null sentinel on the normal path —
18
//! so a single cleanup splice covers both, after which `ref.is_null` decides
19
//! whether to return the stashed body value or re-raise.
20
//! ```text
21
//! block $done (result T)
22
//!   block $unwind (result (ref null $nomi_condition))
23
//!     try_table (result T) (catch $nomi_error → $unwind)
24
//!       <body → T>
25
//!     end
26
//!     local.set $result               ; normal: stash T, push null sentinel
27
//!     ref.null $nomi_condition
28
//!   end                               ; catch edge delivers the condition
29
//!   local.set $cond                   ; cond = caught condition | null
30
//!   <cleanup for effect>              ; runs once, on BOTH paths
31
//!   local.get $cond
32
//!   ref.is_null
33
//!   (if (result T)
34
//!     (then local.get $result)        ; normal: return the stashed value
35
//!     (else local.get $cond; ref.cast; throw $nomi_error))  ; re-raise
36
//! end
37
//! ```
38
//!
39
//! `Catch::One` on `$nomi_error` (the only exception tag) catches every
40
//! catchable error — engine deadlines (`OutOfFuel` / `EpochInterrupt`) are
41
//! NOT wasm exceptions and bypass `try_table` entirely, so cleanup does not
42
//! run for them (documented in `doc/scripting/error-handling.org`). Re-raise
43
//! re-`throw`s a fresh `$nomi_error` carrying the SAME condition struct;
44
//! nomiscript conditions have no observable identity, so this needs no
45
//! `exnref` / `throw_ref` and stays uniform with handler-case. The null
46
//! sentinel is unambiguous: `(error)` and every boundary throw build the
47
//! condition with `struct.new` (always non-null).
48
//!
49
//! Cleanup compiles on the LIVE symbol table (not a clone): it shares the
50
//! surrounding lexical scope, so a `(setf x …)` in cleanup must promote `x`
51
//! to the same runtime local a later read of `x` resolves to. Emitting it
52
//! once — at a single wasm depth — also keeps any relative `br` inside
53
//! cleanup (a `return-from` / `go` out of it) correct without duplication.
54

            
55
use wasm_encoder::{BlockType, Catch, HeapType, RefType, ValType};
56

            
57
use crate::ast::{Expr, WasmType};
58
use crate::compiler::context::CompileContext;
59
use crate::compiler::emit::FunctionEmitter;
60
use crate::compiler::expr::{
61
    compile_for_effect, compile_for_stack, eval_value, serialize_stack_to_output,
62
};
63
use crate::error::{Error, Result};
64
use crate::runtime::SymbolTable;
65

            
66
use super::block_exits::form_diverges;
67

            
68
const UNWIND_PROTECT: &str = "unwind-protect";
69

            
70
68
pub(super) fn eval_unwind_protect(symbols: &mut SymbolTable, args: &[Expr]) -> Result<Expr> {
71
68
    let (body, cleanup) = parse(args)?;
72
68
    let body_diverges = form_diverges(&mut symbols.clone(), body)?;
73
68
    let body_val = eval_value(symbols, body)?;
74
    // Cleanup shares the surrounding lexical scope, so eval it on the LIVE
75
    // table (like BLOCK's body) — a `(setf x …)` in cleanup must promote `x`
76
    // for a later read to resolve to the same runtime local.
77
68
    for form in cleanup {
78
68
        eval_value(symbols, form)?;
79
    }
80
68
    if !body_val.is_wasm_runtime() && !body_diverges {
81
        // Body folds to a constant and can't raise — that's the value.
82
        return Ok(body_val);
83
68
    }
84
    // Runtime result: the value is the body's; cleanup is effect-only.
85
68
    Ok(Expr::WasmRuntime(runtime_type(&body_val)))
86
68
}
87

            
88
/// The `WasmType` an eval result carries on the stack, mirroring the literal
89
/// lowerings the stack-compile path uses. Bool/nil literals lower to `Bool`
90
/// (matching `compile_for_stack`), so a bound unwind-protect result is sized
91
/// to the value codegen actually pushes — else a runtime-boolean body would
92
/// mis-serialize as Number.
93
68
fn runtime_type(val: &Expr) -> WasmType {
94
68
    crate::compiler::expr::classify_stack_type(val).unwrap_or(WasmType::I32)
95
68
}
96

            
97
748
pub(super) fn compile_unwind_protect(
98
748
    ctx: &mut CompileContext,
99
748
    emit: &mut FunctionEmitter,
100
748
    symbols: &mut SymbolTable,
101
748
    args: &[Expr],
102
748
) -> Result<()> {
103
748
    let ty = compile_unwind_protect_for_stack(ctx, emit, symbols, args)?;
104
680
    serialize_stack_to_output(ctx, emit, ty)
105
748
}
106

            
107
816
pub(super) fn compile_unwind_protect_for_effect(
108
816
    ctx: &mut CompileContext,
109
816
    emit: &mut FunctionEmitter,
110
816
    symbols: &mut SymbolTable,
111
816
    args: &[Expr],
112
816
) -> Result<()> {
113
816
    compile_unwind_protect_for_stack(ctx, emit, symbols, args)?;
114
816
    emit.drop_value();
115
816
    Ok(())
116
816
}
117

            
118
2584
pub(super) fn compile_unwind_protect_for_stack(
119
2584
    ctx: &mut CompileContext,
120
2584
    emit: &mut FunctionEmitter,
121
2584
    symbols: &mut SymbolTable,
122
2584
    args: &[Expr],
123
2584
) -> Result<WasmType> {
124
2584
    let (body, cleanup) = parse(args)?;
125

            
126
    // `result_local` stashes the body's value on the normal path while
127
    // cleanup runs; `cond_local` (anyref) holds the caught condition on the
128
    // exceptional path, or null on the normal path. Both allocated before the
129
    // body so the body's own locals stack above them.
130
2516
    let cond_local = ctx.alloc_local(WasmType::AnyRef)?;
131

            
132
    // --- Phase 1: compile body + cleanup into scratches on LIVE symbols. ---
133
    // Body runs inside $done/$unwind/try_table (parent + 3). Cleanup runs once
134
    // at the $done level after $unwind closes (parent + 1). Both compile
135
    // against the live table (shared lexical scope): the body may promote a
136
    // binding to a runtime local that cleanup then reads/writes. Body first,
137
    // so its promotions are visible to cleanup.
138
2516
    let parent_depth = emit.block_depth();
139
2516
    let body_diverges = form_diverges(&mut symbols.clone(), body)?;
140

            
141
    // While the body compiles, register an unwind frame so a non-local exit
142
    // (`(return-from)` / `(go)` to a target outside this unwind-protect) emits
143
    // this cleanup inline before its `br` — CL unwind semantics. The frame's
144
    // `threshold` is `parent_depth`: an exit landing at depth `<= parent_depth`
145
    // leaves the unwind-protect. Cleanup is recompiled (for effect) at each
146
    // crossing exit; the normal/exceptional paths below emit their own copy.
147
2516
    let mut body_scratch = FunctionEmitter::new_seeded(parent_depth + 3);
148
2516
    ctx.push_unwind_frame(parent_depth, cleanup.to_vec());
149
2516
    let body_result = compile_for_stack(ctx, &mut body_scratch, symbols, body);
150
2516
    ctx.pop_unwind_frame()?;
151
2516
    let body_ty = body_result?;
152
2516
    let result_ty = if body_diverges {
153
1224
        WasmType::I32
154
    } else {
155
1292
        body_ty
156
    };
157
2516
    let result_local = ctx.alloc_local(result_ty)?;
158

            
159
2516
    let mut cleanup_scratch = FunctionEmitter::new_seeded(parent_depth + 1);
160
2584
    for form in cleanup {
161
2584
        compile_for_effect(ctx, &mut cleanup_scratch, symbols, form)?;
162
    }
163

            
164
    // --- Phase 2: emit the real structure, splicing the scratches. ---
165
2516
    let condition_idx = ctx.condition_type_idx();
166
2516
    let cond_ref = ValType::Ref(RefType {
167
2516
        nullable: true,
168
2516
        heap_type: HeapType::Concrete(condition_idx),
169
2516
    });
170
2516
    let result_vt = ctx.wasm_val_type(result_ty);
171
2516
    let tag = ctx.nomi_error_tag();
172

            
173
2516
    emit.block_start_typed(BlockType::Result(result_vt)); // $done
174
2516
    emit.block_start_typed(BlockType::Result(cond_ref)); // $unwind
175
2516
    emit.try_table(
176
2516
        BlockType::Result(result_vt),
177
2516
        &[Catch::One { tag, label: 0 }],
178
    );
179
2516
    emit.splice(&body_scratch.take_bytes());
180
2516
    if body_diverges {
181
1224
        // Dead tail after a body that always raises; reset to polymorphic so
182
1224
        // the try_table's declared result type is satisfied vacuously.
183
1224
        emit.unreachable();
184
1292
    }
185
2516
    emit.block_end(); // close try_table
186
    // Normal completion: body result T on the stack. Stash it and push the
187
    // null sentinel so the $unwind block yields `(ref null $nomi_condition)`
188
    // on both edges (catch delivers the real condition).
189
2516
    emit.local_set(result_local);
190
2516
    emit.ref_null(condition_idx);
191
2516
    emit.block_end(); // close $unwind — both edges converge with cond-or-null
192

            
193
    // cond = caught condition (exceptional) | null (normal). Run cleanup once,
194
    // on both paths, then branch.
195
2516
    emit.local_set(cond_local);
196
2516
    emit.splice(&cleanup_scratch.take_bytes());
197
2516
    emit.local_get(cond_local);
198
2516
    emit.ref_is_null();
199
2516
    emit.if_block(BlockType::Result(result_vt));
200
2516
    emit.local_get(result_local); // normal: the stashed body value
201
2516
    emit.else_block();
202
2516
    emit.local_get(cond_local); // exceptional: re-raise the same condition
203
2516
    emit.ref_cast(condition_idx);
204
2516
    emit.throw(tag);
205
2516
    emit.block_end(); // close if
206

            
207
2516
    emit.block_end(); // close $done
208
2516
    Ok(result_ty)
209
2584
}
210

            
211
/// Emit, for effect, the cleanup of every active `(unwind-protect)` an exit
212
/// to `target_depth` crosses (innermost-first) — the CL guarantee that a
213
/// non-local `(return-from)` / `(go)` runs intervening cleanups before
214
/// transferring control. Called from the exit-site codegen (`block.rs`,
215
/// `tagbody.rs`) just before the `br`, with the exit value (if any) already
216
/// on the stack: cleanup is stack-neutral (effect position), so it doesn't
217
/// disturb that value. A no-op when no unwind-protect is crossed (the common
218
/// case keeps its bare `br`).
219
3740
pub(super) fn emit_crossing_cleanups(
220
3740
    ctx: &mut CompileContext,
221
3740
    emit: &mut FunctionEmitter,
222
3740
    symbols: &mut SymbolTable,
223
3740
    target_depth: u32,
224
3740
) -> Result<()> {
225
    // REMOVE the crossed frames before emitting, so a `(return-from)` / `(go)`
226
    // inside one of these cleanups sees only the OUTER frames — a cleanup
227
    // can't re-schedule itself (which would recurse forever). Restore after,
228
    // so sibling branches of the protected body still see the frames.
229
3740
    let crossed = ctx.take_unwind_frames_crossing(target_depth);
230
3740
    let result = emit_cleanups(ctx, emit, symbols, &crossed);
231
3740
    ctx.restore_unwind_frames(crossed);
232
3740
    result
233
3740
}
234

            
235
3740
fn emit_cleanups(
236
3740
    ctx: &mut CompileContext,
237
3740
    emit: &mut FunctionEmitter,
238
3740
    symbols: &mut SymbolTable,
239
3740
    crossed: &[crate::compiler::context::UnwindFrame],
240
3740
) -> Result<()> {
241
    // Compile each cleanup against a CLONE of the symbol table. This exit
242
    // path diverges (a `br` follows), so code after it in this branch is
243
    // dead — but a SIBLING branch (the other arm of an enclosing runtime
244
    // `if`/`cond`, compiled later against the live table) must NOT observe a
245
    // cleanup's compile-time side effects (e.g. a `(setf x v)` on a not-yet-
246
    // promoted `x` mutating its const value). The canonical convergence-path
247
    // cleanup in `compile_unwind_protect_for_stack` is the one that applies
248
    // effects to the live table; these crossing copies are emit-only.
249
3740
    let mut clone = symbols.clone();
250
3740
    for cleanup in CompileContext::unwind_frame_cleanups(crossed) {
251
884
        for form in &cleanup {
252
884
            compile_for_effect(ctx, emit, &mut clone, form)?;
253
        }
254
    }
255
3740
    Ok(())
256
3740
}
257

            
258
/// Parse `(unwind-protect body cleanup...)`: a required body form followed by
259
/// zero or more cleanup forms.
260
2652
fn parse(args: &[Expr]) -> Result<(&Expr, &[Expr])> {
261
2652
    args.split_first().ok_or_else(|| {
262
68
        Error::Compile(format!(
263
68
            "{UNWIND_PROTECT} requires a protected body form and zero or more cleanup forms"
264
68
        ))
265
68
    })
266
2652
}