1
//! `CONS` constructor. Eval path constant-folds chains; compile path
2
//! pushes typed car/cdr onto the stack and calls `pair_new`.
3
//! `push_pair_car` boxes i32 values via `ref.i31`; `push_pair_cdr`
4
//! emits `ref.null pair` for terminal `nil` or validates a typed
5
//! `PairRef(elem)` matches the declared element.
6

            
7
use crate::ast::{Expr, PairElement, WasmType};
8
use crate::compiler::context::CompileContext;
9
use crate::compiler::emit::FunctionEmitter;
10
use crate::compiler::expr::{
11
    compile_expr, compile_for_effect, compile_for_stack, compile_for_stack_as, eval_value,
12
    serialize_stack_to_output,
13
};
14
use crate::error::{Error, Result};
15
use crate::runtime::SymbolTable;
16

            
17
use super::datum::{compile_folded_to_stack, is_datum_result};
18
use super::infer::infer_pair_element;
19

            
20
38182
pub(super) fn cons(symbols: &mut SymbolTable, args: &[Expr]) -> Result<Expr> {
21
38182
    if args.len() != 2 {
22
136
        return Err(Error::Arity {
23
136
            name: "CONS".to_string(),
24
136
            expected: 2,
25
136
            actual: args.len(),
26
136
        });
27
38046
    }
28
38046
    let car = eval_value(symbols, &args[0])?;
29
37840
    let cdr = eval_value(symbols, &args[1])?;
30
37840
    if car.is_wasm_runtime()
31
8976
        || cdr.is_wasm_runtime()
32
7752
        || matches!(cdr.wasm_type(), Some(WasmType::PairRef(_)))
33
    {
34
30088
        let elem = infer_pair_element(&car, &cdr)?;
35
30088
        return Ok(Expr::WasmRuntime(WasmType::PairRef(elem)));
36
7752
    }
37
7752
    match cdr {
38
4080
        Expr::Quote(inner) => match *inner {
39
4080
            Expr::List(mut elems) => {
40
4080
                elems.insert(0, car);
41
4080
                Ok(Expr::Quote(Box::new(Expr::List(elems))))
42
            }
43
            Expr::Nil => Ok(Expr::Quote(Box::new(Expr::List(vec![car])))),
44
            other => Ok(Expr::Quote(Box::new(Expr::cons(car, other)))),
45
        },
46
3536
        Expr::Nil => Ok(Expr::Quote(Box::new(Expr::List(vec![car])))),
47
136
        other => Ok(Expr::Quote(Box::new(Expr::cons(car, other)))),
48
    }
49
38182
}
50

            
51
1292
pub(super) fn compile_cons(
52
1292
    ctx: &mut CompileContext,
53
1292
    emit: &mut FunctionEmitter,
54
1292
    symbols: &mut SymbolTable,
55
1292
    args: &[Expr],
56
1292
) -> Result<()> {
57
1292
    let result = cons(symbols, args)?;
58
1156
    if matches!(result.wasm_type(), Some(WasmType::PairRef(_))) {
59
544
        let ty = compile_cons_to_stack(ctx, emit, symbols, args)?;
60
476
        serialize_stack_to_output(ctx, emit, ty)?;
61
476
        return Ok(());
62
612
    }
63
612
    compile_expr(ctx, emit, symbols, &result)
64
1292
}
65

            
66
7564
pub(super) fn compile_cons_to_stack(
67
7564
    ctx: &mut CompileContext,
68
7564
    emit: &mut FunctionEmitter,
69
7564
    symbols: &mut SymbolTable,
70
7564
    args: &[Expr],
71
7564
) -> Result<WasmType> {
72
    // A fully-constant cons folds to a quoted list datum (e.g. (cons 0 '(1 2 3))
73
    // → '(0 1 2 3)); render it as a datum so value position agrees with the
74
    // effect path instead of trapping when push_pair_cdr meets the quoted cdr.
75
    // Only a runtime car/cdr (PairRef result) takes the pair_new path below.
76
7564
    let folded = cons(symbols, args)?;
77
7564
    if !matches!(folded.wasm_type(), Some(WasmType::PairRef(_))) && is_datum_result(&folded) {
78
408
        return compile_folded_to_stack(ctx, emit, symbols, folded);
79
7156
    }
80
    // If an argument transfers control before the pair is built (a
81
    // `(return-from …)` / `(error …)` — args evaluate left-to-right before the
82
    // call), the rest is dead: the pair is never constructed, so a non-list cdr
83
    // must NOT be rejected. Emit the live prefix (which performs the exit) and
84
    // return a placeholder element. Classify divergence on a CLONE (the exit is
85
    // still recorded by the single emit below).
86
7156
    if crate::compiler::special::form_diverges_for_test(&mut symbols.clone(), &args[0])? {
87
68
        let ty = compile_for_stack(ctx, emit, symbols, &args[0])?;
88
68
        return Ok(WasmType::PairRef(
89
68
            PairElement::from_wasm_type(ty).unwrap_or(PairElement::AnyRef),
90
68
        ));
91
7088
    }
92
7088
    if crate::compiler::special::form_diverges_for_test(&mut symbols.clone(), &args[1])? {
93
        // Car is evaluated (for its effects) then the cdr exits before
94
        // `pair_new`; the car value is dead, so compile it for effect.
95
68
        compile_for_effect(ctx, emit, symbols, &args[0])?;
96
68
        let ty = compile_for_stack(ctx, emit, symbols, &args[1])?;
97
68
        return Ok(WasmType::PairRef(
98
68
            PairElement::from_wasm_type(ty).unwrap_or(PairElement::AnyRef),
99
68
        ));
100
7020
    }
101
    // Decide the element type up front via the eval pipeline so we can
102
    // reject heterogeneous mixing before emitting any wasm.
103
7020
    let car_resolved = eval_value(symbols, &args[0])?;
104
7020
    let cdr_resolved = eval_value(symbols, &args[1])?;
105
7020
    let elem = infer_pair_element(&car_resolved, &cdr_resolved)?;
106
7020
    push_pair_car(ctx, emit, symbols, &args[0], elem)?;
107
6952
    push_pair_cdr(ctx, emit, symbols, &args[1], elem, &cdr_resolved)?;
108
6884
    emit.call(ctx.ids.pair_new);
109
6884
    Ok(WasmType::PairRef(elem))
110
7564
}
111

            
112
/// Emit `elem_args` as a nul-terminated `$pair` chain. LIST uses this so it
113
/// never synthesizes a `(CONS …)` form — that would route through symbol
114
/// dispatch and could hit a user `(defun cons …)` shadow. `elem_args` are the
115
/// ORIGINAL element expressions (emitted once via `push_pair_car`); the
116
/// chain's element type is decided up front by folding their resolved values
117
/// through the eval `cons` builder (same pairwise widening CONS does), so
118
/// every cell is emitted homogeneously.
119
1496
pub(super) fn compile_pair_chain(
120
1496
    ctx: &mut CompileContext,
121
1496
    emit: &mut FunctionEmitter,
122
1496
    symbols: &mut SymbolTable,
123
1496
    elem_args: &[Expr],
124
1496
) -> Result<WasmType> {
125
1496
    let resolved: Vec<Expr> = elem_args
126
1496
        .iter()
127
2516
        .map(|a| eval_value(symbols, a))
128
1496
        .collect::<Result<_>>()?;
129
1496
    let elem = match fold_chain_value(symbols, &resolved)?.wasm_type() {
130
680
        Some(WasmType::PairRef(elem)) => elem,
131
816
        _ => PairElement::AnyRef,
132
    };
133
1496
    emit_chain_cells(ctx, emit, symbols, elem_args, elem)?;
134
1428
    Ok(WasmType::PairRef(elem))
135
1496
}
136

            
137
/// Fold resolved `elems` right-to-left through the eval `cons` builder to get
138
/// the chain's unified `PairRef(elem)` placeholder (or `Nil` when empty).
139
1496
fn fold_chain_value(symbols: &mut SymbolTable, elems: &[Expr]) -> Result<Expr> {
140
1496
    let mut chain = Expr::Nil;
141
2516
    for elem in elems.iter().rev() {
142
2516
        chain = cons(symbols, &[elem.clone(), chain])?;
143
    }
144
1496
    Ok(chain)
145
1496
}
146

            
147
/// Emit the nested `pair_new` cells for `elem_args` (original expressions),
148
/// every car at the unified `elem` slot. Innermost (`nil`) cdr first via
149
/// recursion, so the wasm stack order per cell is `[car, cdr_ref]` → `pair_new`.
150
3876
fn emit_chain_cells(
151
3876
    ctx: &mut CompileContext,
152
3876
    emit: &mut FunctionEmitter,
153
3876
    symbols: &mut SymbolTable,
154
3876
    elem_args: &[Expr],
155
3876
    elem: PairElement,
156
3876
) -> Result<()> {
157
3876
    let Some((car, rest)) = elem_args.split_first() else {
158
1428
        emit.ref_null(ctx.ids.ty_pair);
159
1428
        return Ok(());
160
    };
161
2448
    push_pair_car(ctx, emit, symbols, car, elem)?;
162
2380
    emit_chain_cells(ctx, emit, symbols, rest, elem)?;
163
2380
    emit.call(ctx.ids.pair_new);
164
2380
    Ok(())
165
3876
}
166

            
167
9468
fn push_pair_car(
168
9468
    ctx: &mut CompileContext,
169
9468
    emit: &mut FunctionEmitter,
170
9468
    symbols: &mut SymbolTable,
171
9468
    arg: &Expr,
172
9468
    elem: PairElement,
173
9468
) -> Result<()> {
174
9468
    if elem == PairElement::AnyRef {
175
        // Heterogeneous cell: widen any wasm type to the anyref car. The
176
        // i31-boxed value types (I32 / Bool) need `ref.i31`; reference-typed
177
        // values are anyref subtypes already.
178
2584
        let actual = compile_for_stack(ctx, emit, symbols, arg)?;
179
2516
        if matches!(actual, WasmType::I32 | WasmType::Bool) {
180
1360
            emit.ref_i31();
181
1360
        }
182
2516
        return Ok(());
183
6884
    }
184
6884
    match elem {
185
        // Value cells: a pair cell is NOT the Index stratum (CLAUDE.md), so a
186
        // dimension-flexible integer literal in a Ratio cell must coerce to
187
        // Ratio rather than lower as I32 and mismatch the slot. `nil` in these
188
        // cells lands on a real zero (`0` / `#f` / `0/1`), never a trapping
189
        // null — `as_wasm_type` is i31-boxed (I32/Bool) or a non-null ratio.
190
        PairElement::I32 | PairElement::Bool | PairElement::Ratio => {
191
6340
            compile_for_stack_as(ctx, emit, symbols, arg, elem.as_wasm_type())?;
192
6340
            if matches!(elem, PairElement::I32 | PairElement::Bool) {
193
3076
                emit.ref_i31();
194
3280
            }
195
6340
            Ok(())
196
        }
197
        // Reference cells (string / entity / commodity): keep the strict match
198
        // so a `nil` or wrong-typed car stays a COMPILE error rather than a
199
        // typed null that `CAR`'s non-null cast would trap on at runtime.
200
        _ => {
201
544
            let actual = compile_for_stack(ctx, emit, symbols, arg)?;
202
544
            if PairElement::from_wasm_type(actual) != Some(elem) {
203
68
                return Err(Error::Compile(format!(
204
68
                    "CONS car: expected {elem} to match the inferred pair element, got {actual}"
205
68
                )));
206
476
            }
207
476
            Ok(())
208
        }
209
    }
210
9468
}
211

            
212
6952
fn push_pair_cdr(
213
6952
    ctx: &mut CompileContext,
214
6952
    emit: &mut FunctionEmitter,
215
6952
    symbols: &mut SymbolTable,
216
6952
    arg: &Expr,
217
6952
    elem: PairElement,
218
6952
    resolved: &Expr,
219
6952
) -> Result<()> {
220
6952
    if matches!(resolved, Expr::Nil) {
221
2652
        emit.ref_null(ctx.ids.ty_pair);
222
2652
        return Ok(());
223
4300
    }
224
4300
    let actual = compile_for_stack(ctx, emit, symbols, arg)?;
225
680
    match actual {
226
4232
        WasmType::PairRef(actual_elem) if actual_elem == elem => Ok(()),
227
        // The widened-AnyRef case accepts any typed pair as the cdr —
228
        // `$pair` already carries `anyref` cars, so no per-element
229
        // adjustment is needed once we've decided to ride the
230
        // heterogeneous variant.
231
680
        WasmType::PairRef(_) if elem == PairElement::AnyRef => Ok(()),
232
        WasmType::PairRef(actual_elem) => Err(Error::Compile(format!(
233
            "CONS cdr element type mismatch — expected pair<{elem}>, got pair<{actual_elem}>"
234
        ))),
235
68
        other => Err(Error::Compile(format!(
236
68
            "CONS cdr must be a pair or nil, got {other}"
237
68
        ))),
238
    }
239
6952
}