co-lambda 0.5.0__py3-none-any.whl

co_lambda/_pybuild.py

@@ -0,0 +1,313 @@
+"""Lambda-term builders for the generic ``_pyast`` Scott encoding of a Python AST.
+
+The compiler's target is a real Python ``ast`` Scott-encoded by ``_pyast`` (reflection-derived from the
+``ast`` node classes). To let the ``COMPILE`` lambda term EMIT that generic encoding directly, this
+module gives lambda-term "smart constructors", one per ``ast`` node the compiler produces, that fill in
+the boilerplate fields the generic ``_pyast.decode`` reads (``decorator_list=[]``, ``returns=None``,
+``ctx=Load()``, ...). Each is a thin wrapper over ``_pyast``'s own ``_ctor`` (the n-ary Scott
+constructor), ``_kind`` (the field kind-tag pair), and ``_scott_list``, so the values these build are
+exactly what ``_pyast.decode`` expects: ``_pyast.decode(build(<smart ctor>)) == <the ast node>``.
+
+A node is ``_ctor(tag, fields)`` where ``tag`` is the class's index in ``_pyast.SUPPORTED`` and each
+field is ``_kind(kind, payload)``; a list field's payload is a Scott list whose elements are themselves
+kind-tagged fields (so a list of nodes is a Scott list of ``_field_node`` values).
+"""
+
+from __future__ import annotations
+
+import ast
+
+from co_lambda._codec import char_codes, church
+from co_lambda._dsl import Builder, app, lam
+from co_lambda._prelude import SCOTT_NIL
+from co_lambda._sugar import ap, cons, map_list, one, two
+from co_lambda._pyast import (
+    _K_BOOL,
+    _K_GENSYM,
+    _K_IDENT,
+    _K_INT,
+    _K_LIST,
+    _K_NODE,
+    _K_NONE,
+    _K_STR,
+    _TAG,
+    _ctor,
+    _kind,
+    _scott_list,
+    encode,
+)
+
+# --- field constructors (a field is a <kind, payload> pair the decoder dispatches on) -----------
+
+
+def _node(cls: "type[ast.AST]", fields: "list[Builder]") -> Builder:
+    """The Scott value for an ``ast`` node of class ``cls`` with the given (kind-tagged) fields."""
+    return _ctor(_TAG[cls], fields)
+
+
+def field_node(child: Builder) -> Builder:
+    return _kind(_K_NODE, child)
+
+
+def field_list(elements: Builder) -> Builder:
+    """A list field; ``elements`` is a Scott list whose items are themselves kind-tagged fields."""
+    return _kind(_K_LIST, elements)
+
+
+def field_int(nat: Builder) -> Builder:
+    return _kind(_K_INT, nat)
+
+
+def field_str(char_codes: Builder) -> Builder:
+    """A string field; ``char_codes`` is a Scott list of Nat character codes."""
+    return _kind(_K_STR, char_codes)
+
+
+def field_ident(path: Builder) -> Builder:
+    """An identifier field; ``path`` is a Scott list of Nats (an AST path). The single ``_pyast``
+    decoder renders it ``v_<int>_<int>...`` for every runtime, so the lambda compiler emits only the
+    path, never a rendered string."""
+    return _kind(_K_IDENT, path)
+
+
+def field_bool(nat: Builder) -> Builder:
+    return _kind(_K_BOOL, nat)
+
+
+def field_none() -> Builder:
+    return _kind(_K_NONE, church(0))
+
+
+def field_node_list(node_fields: Builder) -> Builder:
+    """Convenience: a list field over a Scott list whose elements are already ``field_node`` values."""
+    return field_list(node_fields)
+
+
+# --- smart constructors, one per ast node the compiler emits -------------------------------------
+# A list-valued argument is a Scott list of ALREADY kind-tagged fields (``field_node`` of each node, or
+# ``field_str`` of each name), matching what the decoder's ``_K_LIST`` case feeds back to ``_decode_field``.
+
+
+def py_load() -> Builder:
+    return _node(ast.Load, [])
+
+
+def py_store() -> Builder:
+    return _node(ast.Store, [])
+
+
+def py_is() -> Builder:
+    return _node(ast.Is, [])
+
+
+def py_name(name_field: Builder, ctx: Builder) -> Builder:
+    """``ast.Name(id=<name>, ctx=<ctx>)``; ``name_field`` an already-kind-tagged name field
+    (``field_str`` for a fixed name, ``field_ident`` for a variable's AST path)."""
+    return _node(ast.Name, [name_field, field_node(ctx)])
+
+
+def py_arg(name_field: Builder) -> Builder:
+    """``ast.arg(arg=<name>, annotation=None, type_comment=None)``; ``name_field`` a name field."""
+    return _node(ast.arg, [name_field, field_none(), field_none()])
+
+
+def py_arguments(arg_fields: Builder) -> Builder:
+    """``ast.arguments`` with only positional ``args`` populated; ``arg_fields`` a Scott list of
+    ``field_node(arg)``. Order: posonlyargs, args, vararg, kwonlyargs, kw_defaults, kwarg, defaults."""
+    return _node(
+        ast.arguments,
+        [
+            field_list(SCOTT_NIL),
+            field_list(arg_fields),
+            field_none(),
+            field_list(SCOTT_NIL),
+            field_list(SCOTT_NIL),
+            field_none(),
+            field_list(SCOTT_NIL),
+        ],
+    )
+
+
+def py_lambda(arg_field: Builder, body: Builder) -> Builder:
+    """``lambda <arg>: <body>`` with a single positional parameter; ``arg_field`` a name field."""
+    args = py_arguments(_scott_list([field_node(py_arg(arg_field))]))
+    return _node(ast.Lambda, [field_node(args), field_node(body)])
+
+
+def py_lambda0(body: Builder) -> Builder:
+    """``lambda: <body>`` with no parameters (for a call-by-name ``Thunk(lambda: e)``)."""
+    return _node(ast.Lambda, [field_node(py_arguments(SCOTT_NIL)), field_node(body)])
+
+
+def py_call(func: Builder, arg_fields: Builder) -> Builder:
+    """``<func>(<args...>)``; ``arg_fields`` a Scott list of ``field_node(arg)``; no keywords."""
+    return _node(ast.Call, [field_node(func), field_list(arg_fields), field_list(SCOTT_NIL)])
+
+
+def py_function_def(name_field: Builder, args_node: Builder, body_fields: Builder) -> Builder:
+    """``def <name>(<args>): <body>`` with no decorators/returns/type comment; ``body_fields`` a Scott
+    list of ``field_node(stmt)``.
+
+    The fields are keyed by name and ordered by the RUNNING ``ast.FunctionDef._fields``, so the emitted
+    node matches the host Python version: Python 3.12+ added ``type_params`` (an empty list here), which
+    the generic decoder reflects, so the call-by-need target round-trips on 3.11 and on 3.12+ alike.
+    """
+    by_name = {
+        "name": name_field,
+        "args": field_node(args_node),
+        "body": field_list(body_fields),
+        "decorator_list": field_list(SCOTT_NIL),
+        "returns": field_none(),
+        "type_comment": field_none(),
+        "type_params": field_list(SCOTT_NIL),
+    }
+    return _node(ast.FunctionDef, [by_name[name] for name in ast.FunctionDef._fields])
+
+
+def py_assign(target: Builder, value: Builder) -> Builder:
+    """``<target> = <value>`` with a single target. Order: targets, value, type_comment."""
+    return _node(ast.Assign, [field_list(_scott_list([field_node(target)])), field_node(value), field_none()])
+
+
+def py_nonlocal(name_fields: Builder) -> Builder:
+    """``nonlocal <names...>``; ``name_fields`` a Scott list of ``field_str(codes)``."""
+    return _node(ast.Nonlocal, [field_list(name_fields)])
+
+
+def py_if(test: Builder, body_fields: Builder) -> Builder:
+    """``if <test>: <body>`` with no else; ``body_fields`` a Scott list of ``field_node(stmt)``."""
+    return _node(ast.If, [field_node(test), field_list(body_fields), field_list(SCOTT_NIL)])
+
+
+def py_return(value: Builder) -> Builder:
+    return _node(ast.Return, [field_node(value)])
+
+
+def py_compare_is(left: Builder, right: Builder) -> Builder:
+    """``<left> is <right>``. Order: left, ops, comparators."""
+    return _node(
+        ast.Compare,
+        [
+            field_node(left),
+            field_list(_scott_list([field_node(py_is())])),
+            field_list(_scott_list([field_node(right)])),
+        ],
+    )
+
+
+def py_module(stmt_fields: Builder) -> Builder:
+    """``ast.Module``; ``stmt_fields`` a Scott list of ``field_node(stmt)``. Order: body, type_ignores."""
+    return _node(ast.Module, [field_list(stmt_fields), field_list(SCOTT_NIL)])
+
+
+def py_constant_int(nat: Builder) -> Builder:
+    """``ast.Constant(value=<int>, kind=None)`` with an integer (Nat) value."""
+    return _node(ast.Constant, [field_int(nat), field_none()])
+
+
+def py_subscript(value: Builder, index: Builder) -> Builder:
+    """``<value>[<index>]`` (Load). Order: value, slice, ctx."""
+    return _node(ast.Subscript, [field_node(value), field_node(index), field_node(py_load())])
+
+
+def py_tuple(element_fields: Builder) -> Builder:
+    """``(<elements...>,)`` (Load); ``element_fields`` a Scott list of ``field_node(elt)``. Order: elts, ctx."""
+    return _node(ast.Tuple, [field_list(element_fields), field_node(py_load())])
+
+
+# --- if-expression AST dispatch (the constructor fast path with an interpret fallback) ------------
+# The compiler emits ``<body> if isinstance(n, Var) else ...`` to dispatch on a runtime lambda-AST
+# node's constructor without Scott reduction (so it interns nothing). An IfExp is an EXPRESSION (it
+# fits CODEGEN's expression target and runs on CPython and PyPy alike), unlike a match statement.
+
+
+def py_attribute(value: Builder, attr_field: Builder) -> Builder:
+    """``<value>.<attr>`` (Load); ``attr_field`` a name field (e.g. ``field_str(char_codes("index"))``).
+    Order: value, attr, ctx."""
+    return _node(ast.Attribute, [field_node(value), attr_field, field_node(py_load())])
+
+
+def py_ifexp(test: Builder, body: Builder, orelse: Builder) -> Builder:
+    """``<body> if <test> else <orelse>`` (``ast.IfExp``). Order: test, body, orelse."""
+    return _node(ast.IfExp, [field_node(test), field_node(body), field_node(orelse)])
+
+
+def py_isinstance(value: Builder, class_name_field: Builder) -> Builder:
+    """``isinstance(<value>, <Class>)``; ``class_name_field`` a name field naming the class (``Var`` /
+    ``Lam`` / ``App``, bound in the generated module header)."""
+    return py_call(ex_name(field_str(char_codes("isinstance"))), two_nodes(value, ex_name(class_name_field)))
+
+
+# --- emission notation: fixed-shape statement/expression/identifier helpers ----------------------
+# Builder-only transcription sugar used by the CODEGEN / CODEGEN_NEED lambda terms; shapes are
+# literal at the call site, parameters are Builders.
+
+
+def name_gensym_field(role: Builder, quoted: Builder) -> Builder:
+    """A PATH-FREE, DEPTH-FREE name field for a call-by-need memo cell/thunk, identified by its ``role``
+    (cell / thunk / function) and the ``quoted`` sub-term it belongs to. The payload is interned, so the
+    TABLED recursion yields the SAME node for the same (role, quoted) -- the decoder's ``_K_GENSYM`` case
+    then assigns one fresh ``vg_<n>`` per distinct node, consistent across the cell's definition and uses,
+    distinct across different cells. Lambda-lifted call-by-need accesses binders positionally through the
+    environment, so a sub-term's compiled code does not depend on its binder depth; keying on ``quoted``
+    alone (not ``(depth, quoted)``) means a sub-term shared across DIFFERENT depths compiles once, not
+    once per depth (the depth-keyed scheme recompiled COMPILE's combinators once per nesting depth)."""
+    return _kind(_K_GENSYM, cons(role, quoted))
+
+
+def ex_name(name_field: Builder) -> Builder:
+    return py_name(name_field, py_load())
+
+
+def stmt(node: Builder) -> Builder:
+    """Wrap a statement node as a field so it can sit in a Scott list of statements."""
+    return field_node(node)
+
+
+def st_func_def(name_field: Builder, parameter_fields: Builder, body_fields: Builder) -> Builder:
+    arguments = py_arguments(
+        map_list(lam(lambda field: field_node(py_arg(field))), parameter_fields),
+    )
+    return py_function_def(name_field, arguments, body_fields)
+
+
+def st_assign(target_field: Builder, value: Builder) -> Builder:
+    return py_assign(py_name(target_field, py_store()), value)
+
+
+def st_return(value: Builder) -> Builder:
+    return py_return(value)
+
+
+def two_nodes(first: Builder, second: Builder) -> Builder:
+    """A two-element Scott argument list of node fields."""
+    return two(field_node(first), field_node(second))
+
+
+# --- ClassDef / AnnAssign smart constructors for defunctionalization --------------------------------
+# Mechanical boilerplate fillers for the class-based defunctionalized output. These encode no
+# compilation decisions; they fill the ``ast`` fields the generic decoder expects.
+
+
+def py_classdef(name_field: Builder, decorator_fields: Builder, body_fields: Builder) -> Builder:
+    """``class <name>: <body>`` with decorators, no bases/keywords/type_params.
+
+    Field order follows ``ast.ClassDef._fields`` on the running Python version.
+    """
+    by_name = {
+        "name": name_field,
+        "bases": field_list(SCOTT_NIL),
+        "keywords": field_list(SCOTT_NIL),
+        "body": field_list(body_fields),
+        "decorator_list": field_list(decorator_fields),
+        "type_params": field_list(SCOTT_NIL),
+    }
+    return _node(ast.ClassDef, [by_name[name] for name in ast.ClassDef._fields])
+
+
+def py_annassign(target: Builder, annotation: Builder) -> Builder:
+    """``<target>: <annotation>`` with no value, ``simple=1``.
+
+    Order: target, annotation, value, simple.
+    """
+    return _node(ast.AnnAssign, [field_node(target), field_node(annotation), field_none(), field_int(church(1))])

co_lambda/_reduce.py

@@ -0,0 +1,145 @@
+"""The fold oracle as a lambda term: does a quoted term have a finite normal form?
+
+``CHOOSE_RUNTIME`` needs to know whether a term normalizes to a finite normal form (so call-by-need,
+which never folds, reaches the same value) or only the interpreter's fold handles it (a cyclic, rational
+behaviour). The Python ``_specialize.needs_folding`` reads this out of the interpreter with bounds; this
+module is the pure-lambda port and the verdict that actually drives specialization.
+
+It is a fuel-bounded normalizer written in the calculus. ``EVAL`` denotes a quoted de Bruijn term as a
+value in a three-constructor semantic domain: ``VLAM`` (a fuel-aware host function), ``VNEU`` (a neutral:
+a variable applied to value arguments), and ``VBOTTOM`` (the fuel ran out). Argument evaluation is lazy
+because the interpreter running ``EVAL`` is itself call-by-name, so a normalizing term whose strict
+reduction would diverge (``factorial`` through ``Y``) still reaches its normal form. A **BinNat fuel**
+threads through every evaluation and walk step and decreases at each one, so a genuinely diverging head
+reduction (``Omega``) hits ``VBOTTOM`` rather than looping. ``WALK`` forces the value to full normal form,
+going under binders (applying a ``VLAM`` to a fresh neutral) and down neutral spines, threading the fuel
+as a SINGLE sequential budget (the argument is walked with whatever fuel the head left), so total work is
+linear in the fuel rather than exponential. ``NORMALIZES`` is whether the walk completes before the fuel
+runs out: completion means a finite normal form was positively observed (call-by-need safe); exhaustion
+is read conservatively as needs-fold (interpret), which is always sound. This mirrors ``needs_folding``.
+
+This module is pure lambda calculus: every top-level binding is a ``Builder``. The verdict reader
+(``normalizes_lambda``) and the fuel policy live at the boundary (``_specialize``); the large-stack
+host machinery lives in ``_runtime``.
+"""
+
+from __future__ import annotations
+
+from co_lambda._binnat import BIN_IS_ZERO, BIN_PRED, BIN_SUCC, BIN_ZERO
+from co_lambda._dsl import Builder, app, lam
+from co_lambda._prelude import FALSE, IS_ZERO, PRED, TRUE, Y
+from co_lambda._sugar import ap
+
+# Option: SOME remaining-fuel | NONE (exhausted); consumed as ``option some_handler none_value``.
+_SOME: Builder = lam(lambda value: lam(lambda some_handler: lam(lambda none_value: app(some_handler, value))))
+_NONE: Builder = lam(lambda some_handler: lam(lambda none_value: none_value))
+
+
+# --- environment as a Scott list ----------------------------------------------------------------
+_NIL: Builder = lam(lambda nil_value: lam(lambda cons_handler: nil_value))
+_CONS: Builder = lam(lambda head: lam(lambda tail: lam(lambda nil_value: lam(lambda cons_handler: ap(cons_handler, head, tail)))))
+
+
+# --- the semantic domain: VLAM function | VNEU neutral | VBOTTOM (consumed with three handlers) ---
+# A neutral is NVAR level | NAPP neutral value.
+_VLAM: Builder = lam(lambda function: lam(lambda on_lam: lam(lambda on_neu: lam(lambda on_bottom: app(on_lam, function)))))
+_VNEU: Builder = lam(lambda neutral: lam(lambda on_lam: lam(lambda on_neu: lam(lambda on_bottom: app(on_neu, neutral)))))
+_VBOTTOM: Builder = lam(lambda on_lam: lam(lambda on_neu: lam(lambda on_bottom: on_bottom)))
+
+_NVAR: Builder = lam(lambda level: lam(lambda on_var: lam(lambda on_app: app(on_var, level))))
+_NAPP: Builder = lam(lambda neutral: lam(lambda argument: lam(lambda on_var: lam(lambda on_app: ap(on_app, neutral, argument)))))
+
+
+# nth env index: the index-th environment value (de Bruijn lookup); a free variable (empty environment)
+# reads as a neutral, so an open term is handled and a closed one never reaches it. The index is a
+# CHURCH numeral (quote emits ``q_var(church(i))``), so it is compared with Church ``IS_ZERO``/``PRED``;
+# only the fuel and the binder level are BinNats.
+_NTH: Builder = app(Y, lam(lambda nth: lam(lambda env: lam(lambda index: ap(
+    env,
+    app(_VNEU, app(_NVAR, index)),
+    lam(lambda head: lam(lambda tail: ap(
+        app(IS_ZERO, index),
+        head,
+        ap(nth, tail, app(PRED, index)),
+    ))),
+)))))
+
+
+# apply fuel value argument: semantic application. A VLAM fires (passing the fuel on to its body
+# evaluation); a VNEU grows its spine; VBOTTOM stays bottom.
+_APPLY: Builder = lam(lambda fuel: lam(lambda value: lam(lambda argument: ap(
+    value,
+    lam(lambda function: ap(function, fuel, argument)),  # VLAM: invoke the fuel-aware closure
+    lam(lambda neutral: app(_VNEU, ap(_NAPP, neutral, argument))),  # VNEU: extend the spine
+    _VBOTTOM,  # VBOTTOM: absorbing
+))))
+
+
+# eval fuel env quoted: denote the quoted de Bruijn term as a value, threading the fuel.
+# Argument evaluation (the second eval in the QApp case) is left lazy by the call-by-name interpreter,
+# so a normalizing term whose strict reduction would diverge still reaches its value.
+_EVAL: Builder = app(Y, lam(lambda eval_recursion: lam(lambda fuel: lam(lambda env: lam(lambda quoted: ap(
+    BIN_IS_ZERO, fuel,
+    _VBOTTOM,
+    ap(
+        quoted,
+        lam(lambda index: ap(_NTH, env, index)),  # QVar: look up the value
+        lam(lambda body: app(_VLAM, lam(lambda inner_fuel: lam(lambda argument: ap(
+            eval_recursion, inner_fuel, ap(_CONS, argument, env), body,
+        ))))),  # QLam: a fuel-aware closure
+        lam(lambda function: lam(lambda argument: ap(
+            _APPLY,
+            app(BIN_PRED, fuel),
+            ap(eval_recursion, app(BIN_PRED, fuel), env, function),
+            ap(eval_recursion, app(BIN_PRED, fuel), env, argument),
+        ))),  # QApp: apply (the argument value stays lazy)
+    ),
+))))))
+
+
+# walk_neutral walk fuel level neutral: force a neutral's spine, threading the fuel as a single budget
+# (the argument is walked with whatever fuel the head left), so total work is linear in the fuel rather
+# than exponential. Returns SOME remaining-fuel on completion or NONE on exhaustion.
+_WALK_NEUTRAL: Builder = app(Y, lam(lambda walk_neutral: lam(lambda walk: lam(lambda fuel: lam(lambda level: lam(lambda neutral: ap(
+    BIN_IS_ZERO, fuel,
+    _NONE,
+    ap(
+        neutral,
+        lam(lambda variable_level: app(_SOME, app(BIN_PRED, fuel))),  # NVAR: a leaf, the spine ends
+        lam(lambda inner_neutral: lam(lambda argument: ap(
+            ap(walk_neutral, walk, app(BIN_PRED, fuel), level, inner_neutral),
+            lam(lambda fuel_left: ap(walk, fuel_left, level, argument)),  # head done: walk the argument
+            _NONE,  # head exhausted: propagate
+        ))),
+    ),
+)))))))
+
+
+# walk fuel level value: force the value to its full normal form, threading the fuel as a single budget;
+# returns SOME remaining-fuel on completion or NONE on exhaustion. Going under a VLAM applies it to a
+# fresh neutral (NVAR level) and recurses at level+1; a VNEU walks its spine; VBOTTOM (the evaluator ran
+# out) is not a normal form.
+_WALK: Builder = app(Y, lam(lambda walk: lam(lambda fuel: lam(lambda level: lam(lambda value: ap(
+    BIN_IS_ZERO, fuel,
+    _NONE,
+    ap(
+        value,
+        lam(lambda function: ap(
+            walk,
+            app(BIN_PRED, fuel),
+            app(BIN_SUCC, level),
+            ap(function, app(BIN_PRED, fuel), app(_VNEU, app(_NVAR, level))),
+        )),
+        lam(lambda neutral: ap(_WALK_NEUTRAL, walk, app(BIN_PRED, fuel), level, neutral)),
+        _NONE,  # VBOTTOM
+    ),
+))))))
+
+
+# normalizes fuel quoted: whether walking the value of the quoted term to normal form completes within
+# the fuel. SOME (completed) -> True (a finite normal form); NONE (exhausted) -> False (needs-fold).
+NORMALIZES: Builder = lam(lambda fuel: lam(lambda quoted: ap(
+    ap(_WALK, fuel, BIN_ZERO, ap(_EVAL, fuel, _NIL, quoted)),
+    lam(lambda fuel_left: TRUE),
+    FALSE,
+)))

co_lambda/_shape.py

@@ -0,0 +1,224 @@
+"""Weak head normalization: the structure map ``out`` of the lambda-calculus coalgebra.
+
+``weak_head_normalize`` exposes a node's outermost constructor after weak head reduction (it stops
+at the outermost constructor and does not reduce under ``lambda``). A deterministic calculus
+exposes exactly one constructor at a node, so the value is a single node
+(``Var``/``Lam``/``App``/``Native``) or ``BOTTOM`` (no constructor), never a set.
+``compute_weak_head_normal_form`` is the per-node clause body; ``Node.weak_head_normal_form`` wraps
+it in a ``fixpoint_cached_property`` resolved as a least fixpoint from ``BOTTOM`` upward. Because
+nodes are interned, a node reached again during its own computation is caught by a pointer test; an
+unproductive cycle (a re-entry with no constructor exposed, as in ``Omega`` or ``Y (lambda x. x)``)
+stabilizes at ``BOTTOM``.
+
+A reduction budget (a context variable) bounds beta-reduction so a genuinely non-rational reduction
+surfaces as ``ReductionBudgetExceeded`` instead of hanging.
+"""
+
+from __future__ import annotations
+
+from contextlib import contextmanager
+from contextvars import ContextVar
+from dataclasses import dataclass, field
+from typing import Iterator, cast, final
+
+from co_lambda._ast import (
+    BOTTOM,
+    App,
+    Lam,
+    Native,
+    Node,
+    ShapeBottom,
+    Var,
+    make_native,
+    substitute,
+)
+
+
+class ReductionBudgetExceeded(RuntimeError):
+    """Raised when a bounded reduction runs out of beta-steps (a divergent term)."""
+
+
+@final
+@dataclass(kw_only=True, slots=True, weakref_slot=True)
+class _Budget:
+    remaining: int = field(default=0)
+
+
+_reduction_budget: ContextVar[_Budget | None] = ContextVar(
+    "co_lambda._reduction_budget", default=None
+)
+
+
+@contextmanager
+def reduction_budget(steps: int) -> Iterator[None]:
+    """Bound beta-reduction to ``steps`` head redexes within this context."""
+    if steps <= 0:
+        raise ValueError("reduction budget must be positive")
+    token = _reduction_budget.set(_Budget(remaining=steps))
+    try:
+        yield
+    finally:
+        _reduction_budget.reset(token)
+
+
+def _consume_redex() -> None:
+    budget = _reduction_budget.get()
+    if budget is None:
+        return
+    if budget.remaining <= 0:
+        raise ReductionBudgetExceeded("reduction budget exhausted")
+    budget.remaining -= 1
+
+
+def weak_head_normalize(node: Node) -> Node | ShapeBottom:
+    """The weak head normal form of ``node``: its outermost constructor, or ``BOTTOM`` (none).
+
+    Typed via ``Node.weak_head_normal_form`` (a ``fixpoint_cached_property`` typed as ``object``).
+    """
+    return cast("Node | ShapeBottom", node.weak_head_normal_form)
+
+
+def compute_weak_head_normal_form(node: Node) -> Node | ShapeBottom:
+    """The per-node clause body of weak head normalization; single-valued, no aggregate."""
+    match node:
+        case Var():
+            return node
+        case Lam():
+            return node
+        case Native(run=run, arity=arity, collected=collected):
+            if len(collected) == arity:
+                return weak_head_normalize(run(*collected))
+            return node
+        case App(function=function, argument=argument):
+            head = weak_head_normalize(function)
+            match head:
+                case Lam(body=lambda_body):
+                    _consume_redex()
+                    return weak_head_normalize(substitute(lambda_body, depth=0, argument=argument))
+                case Native(run=run, arity=arity, collected=collected):
+                    saturated = (*collected, argument)
+                    if len(saturated) == arity:
+                        return weak_head_normalize(run(*saturated))
+                    return make_native(run, arity, saturated)
+                case Var() | App():
+                    return node
+                case ShapeBottom.BOTTOM:
+                    return BOTTOM
+                case _:
+                    raise TypeError(f"Unknown head {head!r}")
+        case _:
+            raise TypeError(f"Unknown node {node!r}")
+
+
+def head_normalize(node: Node) -> Node | ShapeBottom:
+    """The head normal form of ``node`` (the Boehm reading): its outermost constructor after head
+    reduction, which reduces under ``lambda`` to expose the head, or ``BOTTOM`` (no head normal form).
+
+    Typed via ``Node.head_normal_form`` (a ``fixpoint_cached_property`` typed as ``object``).
+    """
+    return cast("Node | ShapeBottom", node.head_normal_form)
+
+
+def compute_head_normal_form(node: Node) -> Node | ShapeBottom:
+    """The per-node clause body of head normalization (the Boehm reading).
+
+    The only difference from weak head normalization is the ``Lam`` clause: a ``lambda`` whose body
+    has no head normal form is itself meaningless (``BOTTOM``), because head reduction continues under
+    the ``lambda``. The ``App`` clause is identical (a head redex fires on the weak head of the
+    function, whether or not its body has a head normal form).
+    """
+    match node:
+        case Var():
+            return node
+        case Lam(body=body):
+            if head_normalize(body) is BOTTOM:
+                return BOTTOM
+            return node
+        case Native(run=run, arity=arity, collected=collected):
+            if len(collected) == arity:
+                return head_normalize(run(*collected))
+            return node
+        case App(function=function, argument=argument):
+            head = weak_head_normalize(function)
+            match head:
+                case Lam(body=lambda_body):
+                    _consume_redex()
+                    return head_normalize(substitute(lambda_body, depth=0, argument=argument))
+                case Native(run=run, arity=arity, collected=collected):
+                    saturated = (*collected, argument)
+                    if len(saturated) == arity:
+                        return head_normalize(run(*saturated))
+                    return make_native(run, arity, saturated)
+                case Var() | App():
+                    return node
+                case ShapeBottom.BOTTOM:
+                    return BOTTOM
+                case _:
+                    raise TypeError(f"Unknown head {head!r}")
+        case _:
+            raise TypeError(f"Unknown node {node!r}")
+
+
+def normalize_to_depth(node: Node, depth: int) -> Node | ShapeBottom:
+    """Depth-bounded call-by-name beta normalization: the compiler's reference semantics.
+
+    This is the fusion of weak head normalization and combinatory (SK) reduction. From weak head
+    normalization it keeps call-by-name beta, where the argument is inserted by reference (not
+    reduced), so the caller's tabling folds both an unproductive cycle (``Omega`` to bottom) and a
+    productive one (``Y (cons 0)`` to a finite cyclic graph); a fully lazy SK reduction cannot fold,
+    because its ``S`` rule grows the argument into suspensions that never re-form the cyclic node, and
+    reducing them first (call by value) diverges on a productive cycle. From combinatory reduction it
+    keeps the motivation to avoid copying the whole tree: it fires at most ``depth`` beta contractions
+    per application position and leaves a still-unfired redex ``App(Lam(body), argument)`` (the
+    let-stub ``(\\a. body) argument``) as a guarded value, rather than substituting an unbounded tree.
+
+    A ``depth`` large enough reproduces the Levy-Longo weak head normal form, ``depth == 1`` is the
+    one-layer reading, and ``depth == 0`` reads the term raw. It never consults the cached
+    ``weak_head_normal_form`` (the unbounded least fixpoint), so the cached semantics is untouched;
+    each contraction goes through ``substitute`` (which returns closed subterms by reference and builds
+    with the interning ``make_*``), so closed cyclic data is shared and structurally identical results
+    fold at every reduced layer, the per-layer tabling guarantee that lets a cycle closing within the
+    depth fold and halt. ``depth`` bounds firings, so every head reduction terminates regardless of
+    rationality; the readout's tree is folded by the caller (``render`` tables re-entrant closed
+    nodes), so a rational behaviour whose cycle closes within the depth reads as a finite cyclic graph.
+    """
+    match node:
+        case Var():
+            return node
+        case Lam():
+            return node
+        case Native(run=run, arity=arity, collected=collected):
+            if len(collected) == arity:
+                return normalize_to_depth(run(*collected), depth)
+            return node
+        case App(function=function, argument=argument):
+            head = normalize_to_depth(function, depth)
+            match head:
+                case Lam(body=lambda_body):
+                    if depth <= 0:
+                        return node
+                    fired = substitute(lambda_body, depth=0, argument=argument)
+                    return normalize_to_depth(fired, depth - 1)
+                case Native(run=run, arity=arity, collected=collected):
+                    saturated = (*collected, argument)
+                    if len(saturated) == arity:
+                        return normalize_to_depth(run(*saturated), depth)
+                    return make_native(run, arity, saturated)
+                case Var() | App():
+                    return node
+                case ShapeBottom.BOTTOM:
+                    return BOTTOM
+                case _:
+                    raise TypeError(f"Unknown head {head!r}")
+        case _:
+            raise TypeError(f"Unknown node {node!r}")
+
+
+def one_layer_normalize(node: Node) -> Node | ShapeBottom:
+    """The one-layer-beta structure map: one contraction per application position (``depth == 1``).
+
+    A distinct denotational variant beside ``weak_head_normalize`` (Levy-Longo) and ``head_normalize``
+    (Boehm): where weak head normalization fires the head spine to a constructor, this fires a single
+    redex per position and leaves any remaining redex as a guarded let-stub.
+    """
+    return normalize_to_depth(node, 1)