Lines
78.98 %
Functions
16.67 %
Branches
100 %
//! `BLOCK` / `RETURN-FROM` — Common-Lisp lexical labelled-exit
//! primitive. `(block name body...)` opens a wasm `block` whose label
//! is bound to `name` for the body's lexical extent;
//! `(return-from name value)` walks the BLOCK label stack and emits
//! `<value>` followed by `br <relative-depth>` to that block's exit.
//!
//! The block's wasm result type is discovered at **emit time**: the body
//! is compiled into a scratch buffer first; each reachable
//! `(return-from name v)` records `v`'s type into the block frame, and
//! the fall-through tail (if control can reach it) contributes its type
//! too. Unifying those gives the result type `T`; then `block (result T)`
//! is opened in the parent and the scratch bytes spliced in. Because only
//! *compiled* (reachable) exits record, code stored as a value
//! (quote / lambda / labels bodies, discarded macro args) contributes
//! nothing — no syntactic pre-scan and no per-form blocklist. The scratch
//! emitter is seeded at the depth the block frame will occupy, so every
//! relative `br` (incl. RETURN-FROM to an outer block) stays correct
//! after splicing.
//! Lexical-only: a RETURN-FROM whose name doesn't resolve to a BLOCK
//! frame in scope is a structured compile error. Dynamic non-local
//! exits are Tier 3 territory (try_table + throw).
use wasm_encoder::BlockType;
use crate::ast::{Expr, WasmType};
use crate::compiler::context::CompileContext;
use crate::compiler::emit::FunctionEmitter;
use crate::compiler::expr::{compile_for_effect, compile_for_stack, serialize_stack_to_output};
use crate::error::{Error, Result};
use crate::runtime::SymbolTable;
use super::block_exits::form_diverges;
const BLOCK: &str = "block";
const RETURN_FROM: &str = "return-from";
pub(super) fn eval_block(symbols: &mut SymbolTable, args: &[Expr]) -> Result<Expr> {
let (_, body) = parse_block(args)?;
if body.is_empty() {
return Ok(Expr::Nil);
}
super::super::binding::eval_body(symbols, body)
pub(super) fn eval_return_from(symbols: &mut SymbolTable, args: &[Expr]) -> Result<Expr> {
let (_name, value) = parse_return_from(args)?;
let value_ty = super::block_exits::peek_value_type(symbols, value)?;
Ok(Expr::WasmRuntime(value_ty))
pub(super) fn compile_block(
ctx: &mut CompileContext,
emit: &mut FunctionEmitter,
symbols: &mut SymbolTable,
args: &[Expr],
) -> Result<()> {
let ty = compile_block_for_stack(ctx, emit, symbols, args)?;
serialize_stack_to_output(ctx, emit, ty)
pub(super) fn compile_block_for_effect(
let _ = ty;
emit.drop_value();
Ok(())
pub(super) fn compile_block_for_stack(
) -> Result<WasmType> {
let (name, body) = parse_block(args)?;
// Empty `(block n)` ≡ nil — falsy i31, typed `Bool` to serialize as
// Nil and match the eval mirror (`eval_block` → `Expr::Nil`).
emit.i32_const(0);
return Ok(WasmType::Bool);
// The block frame sits one structured-control level below the parent's
// current depth. Compile the body into a scratch emitter seeded there,
// so relative `br` targets resolve as if the frame were already open;
// splicing preserves them.
let frame_depth = emit.block_depth() + 1;
let mut scratch = FunctionEmitter::new_seeded(frame_depth);
ctx.push_block_label(name, frame_depth);
let body_result = compile_block_body(ctx, &mut scratch, symbols, body);
let recorded_exits = ctx.pop_block_label(name)?;
let outcome = body_result?;
let tail_ty = outcome.falls_through.then_some(outcome.tail_ty);
let result_ty = unify_block_type(name, &recorded_exits, tail_ty)?;
if !outcome.falls_through {
// The body's tail is dead (an earlier form diverged); its concrete
// value would clash with the block result type, so a trailing
// `unreachable` resets the validator to a polymorphic stack. Live
// values leave only via the recorded `return-from` `br` edges.
scratch.unreachable();
emit.block_start_typed(BlockType::Result(ctx.wasm_val_type(result_ty)));
emit.splice(&scratch.take_bytes());
emit.block_end();
Ok(result_ty)
/// Body-compile result: the tail value's type and whether control can
/// reach it.
struct BodyOutcome {
tail_ty: WasmType,
falls_through: bool,
/// Compile a BLOCK body into `emit`, stopping at the first form that
/// unconditionally diverges — sequential forms after it are dead and must
/// not be emitted (their `(return-from)`s would record bogus exits, and
/// their bytes are unreachable). Returns the last *compiled* form's type
/// and whether control falls through to it.
fn compile_block_body(
body: &[Expr],
) -> Result<BodyOutcome> {
let last = body.len() - 1;
for (idx, form) in body.iter().enumerate() {
// Classify divergence on a CLONE: `form_diverges` runs `eval_value`
// (const-folding, macro expansion) which can mutate the symbol
// table via `setf`/`defparameter`. The form is compiled for real
// right after, so letting the classification mutate `symbols` would
// double-apply those effects. The clone keeps the query pure.
let diverges = form_diverges(&mut symbols.clone(), form)?;
if idx == last {
let tail_ty = compile_for_stack(ctx, emit, symbols, form)?;
return Ok(BodyOutcome {
tail_ty,
falls_through: !diverges,
});
if diverges {
// This non-tail form exits the block; the rest is dead. Compile
// it for effect so its `return-from` records and its `br` is
// emitted, then stop — the tail value comes from the recorded
// exits, sealed by the caller's `unreachable`.
compile_for_effect(ctx, emit, symbols, form)?;
tail_ty: WasmType::I32,
falls_through: false,
// Unreachable: an empty body is handled by the caller.
Ok(BodyOutcome {
falls_through: true,
})
/// Unify the reachable exit types into the block's wasm result type. Every
/// recorded `(return-from)` exit and the fall-through tail (when reachable)
/// must agree; a disagreement among reachable exits is a real type error.
/// No reachable value-yielding exit at all (every path diverged) degrades
/// to `I32` — wasm stack-polymorphism past the divergence accepts it.
fn unify_block_type(
name: &str,
recorded_exits: &[WasmType],
tail_ty: Option<WasmType>,
let mut chosen = tail_ty;
for &ty in recorded_exits {
match chosen {
Some(existing) if existing != ty => {
return Err(Error::Compile(format!(
"BLOCK '{name}': conflicting exit types {existing} and {ty}"
)));
Some(_) => {}
None => chosen = Some(ty),
Ok(chosen.unwrap_or(WasmType::I32))
pub(super) fn compile_return_from(
compile_return_from_for_stack(ctx, emit, symbols, args)?;
pub(super) fn compile_return_from_for_stack(
let (name, value) = parse_return_from(args)?;
let target_depth = match ctx.lookup_block_label(name) {
Some(frame) => frame.wasm_depth,
None => {
"RETURN-FROM '{name}': no enclosing BLOCK with that name"
};
let value_ty = compile_for_stack(ctx, emit, symbols, value)?;
// Emit-time discovery: record this reachable exit's type so the
// enclosing block can unify its result type from exactly the exits
// that compile. Consistency is enforced by `unify_block_type`.
ctx.record_block_exit(name, value_ty);
// CL unwind semantics: before branching out, run the cleanup of every
// `(unwind-protect)` this exit crosses (innermost-first). The value is
// already on the stack; cleanups compile for effect (stack-neutral) so
// they don't disturb it. `br` then carries the value to the target block.
super::unwind_protect::emit_crossing_cleanups(ctx, emit, symbols, target_depth)?;
let current = emit.block_depth();
let relative = current.checked_sub(target_depth).ok_or_else(|| {
Error::Compile(format!(
"RETURN-FROM '{name}': inconsistent block-depth tracking ({current} < {target_depth})"
))
})?;
emit.br(relative);
// After a `br`, control never reaches here. wasm's stack polymorphism
// past `unreachable` lets the validator infer any surrounding-block
// result type, so we don't materialize a typed value.
emit.unreachable();
Ok(value_ty)
fn parse_block(args: &[Expr]) -> Result<(&str, &[Expr])> {
if args.is_empty() {
return Err(Error::Arity {
name: BLOCK.to_string(),
expected: 1,
actual: 0,
let name = match &args[0] {
Expr::Symbol(s) => s.as_str(),
other => {
return Err(Error::Type {
expected: format!("symbol for BLOCK label, got {other:?}"),
actual: format!("{other:?}"),
Ok((name, &args[1..]))
fn parse_return_from(args: &[Expr]) -> Result<(&str, &Expr)> {
if args.len() != 2 {
name: RETURN_FROM.to_string(),
expected: 2,
actual: args.len(),
expected: format!("symbol for RETURN-FROM target, got {other:?}"),
Ok((name, &args[1]))