Skip to main content

vla_lang/
expand.rs

1//! The macro system: VLA.bas's `DefineMacro`, `ExpandMacros`, `ExpandOne`,
2//! `Substitute` with the QUASIQUOTE bundle, the twenty-seven LISTOPS
3//! primitives, `ExpandOnePass`, and `VlaExpandText` (PORT.5, slice 5d; the
4//! expand-time object model's ten, VLA.3).
5//!
6//! Template-substitution macros: `(defmacro (name p1 p2 & rest) template
7//! ...)`. A parameter is replaced by the form passed at the call site; the
8//! rest parameter splices its forms into whatever list it stands in; several
9//! template forms become one `(begin ...)`. No gensym, no compile-time
10//! computation beyond the expand-time primitives, by design.
11//!
12//! The shape is the VBA's, function for function. `ExpandMacros` is the
13//! hand-made trampoline: a form whose head is a macro is substituted and
14//! looked at again, in a loop, and a `(begin ...)` a macro made (its line
15//! is 0) is unwrapped around its last element, so a self-recursive walker's
16//! chain length never becomes stack depth; the forms it set aside are
17//! combined back into one `begin` at the end. Everything the macro system
18//! makes carries line 0 (S3.1's explicit zero); a user's argument forms
19//! keep their lines as they are carried in.
20//!
21//! The forms are the VBA's too (VLA.2). A [`Form`] is an owned tree, so a
22//! copy of a list copies everything under it; VLA.bas passes a list by
23//! reference and makes `cdr` a view (`VlaSlice`, since P-NTH), so a macro
24//! that walks a list of N rows pays for N rows, not N squared. The expander
25//! holds the forms it works on as nodes of its own, which share as the
26//! reference shares: a parameter's value at each use, a quoted argument's
27//! content, `car`, `cdr` and `cddr`, a call's arguments and the elements a
28//! trampoline sets aside. What the reference copies, the items of `cons`,
29//! `list`, the rest parameter and `unquote-splicing`, are copied here too,
30//! as references to the same items. A text is read into nodes once and the
31//! expansion written out as forms once.
32//!
33//! The refusals are the catalogue's, by id, in the same situations.
34
35use std::collections::HashMap;
36use std::sync::{Arc, OnceLock};
37
38use crate::form::{sym_text, Form, List};
39use crate::intrinsics::{fold, is_numeric_literal_text, str_, val};
40use crate::messages::{raise, Refusal};
41use crate::printer::write_pretty;
42use crate::reader::{count_lf, parse_all, src_line_tag, tokenize, FORM_DEPTH_LIMIT};
43use crate::refers::letters_to_col;
44use crate::sheet::{column_letters, MAX_COLUMN, MAX_ROW};
45
46/// One macro, as `DefineMacro` records it.
47#[derive(Clone, Debug)]
48pub struct Macro {
49    /// The parameter names, as written.
50    pub params: Vec<String>,
51    /// The rest parameter's name as written, or empty.
52    pub rest_name: String,
53    pub template: Form,
54    /// The docstring (L17), or empty.
55    pub doc: String,
56    /// The name as written.
57    pub name: String,
58}
59
60/// The expand-time names a macro may not take, each with the description
61/// its refusal gives (`DefineMacro`'s list, in its order).
62const RESERVED: &[(&str, &str)] = &[
63    ("quote", "data-literal form"),
64    ("quasiquote", "template-shielding form"),
65    ("unquote", "quasiquote escape form"),
66    ("unquote-splicing", "quasiquote splice form"),
67    ("symbol", "identifier-fusion primitive"),
68    ("car", "list-head primitive"),
69    ("cdr", "list-tail primitive"),
70    ("cddr", "list-tail primitive"),
71    ("cons", "list-construction primitive"),
72    ("list", "list-construction primitive"),
73    ("null?", "empty-list primitive"),
74    ("eq?", "atom-comparison primitive"),
75    ("equal?", "structural-comparison primitive"),
76    ("quote-if", "expand-time conditional"),
77    (
78        "cond",
79        "multi-clause conditional (folds at expand time when possible, defers to runtime otherwise)",
80    ),
81    ("+expand", "expand-time addition primitive"),
82    ("=expand", "expand-time equality primitive"),
83    ("<>expand", "expand-time inequality primitive"),
84    (">expand", "expand-time comparison primitive"),
85    ("<expand", "expand-time comparison primitive"),
86    (">=expand", "expand-time comparison primitive"),
87    ("<=expand", "expand-time comparison primitive"),
88    // VLA.3: the expand-time object model's ten.
89    ("-expand", "expand-time subtraction primitive"),
90    ("*expand", "expand-time multiplication primitive"),
91    ("quotient-expand", "expand-time integer quotient primitive"),
92    ("mod-expand", "expand-time remainder primitive"),
93    ("&expand", "expand-time text-joining primitive"),
94    ("characters-expand", "expand-time text-splitting primitive"),
95    ("address-expand", "expand-time address primitive"),
96    ("row-expand", "expand-time row-number primitive"),
97    ("column-expand", "expand-time column-number primitive"),
98    ("column-letters-expand", "expand-time column-letters primitive"),
99];
100
101/// The twenty-seven LISTOPS primitives `Substitute` and `ExpandMacros` both
102/// recognise at a form's head: the original nine, LISTOPS-EXPAND's seven,
103/// `cond`, and the expand-time object model's ten (VLA.3).
104const LISTOPS: &[&str] = &[
105    "car",
106    "cdr",
107    "cddr",
108    "cons",
109    "list",
110    "null?",
111    "eq?",
112    "equal?",
113    "quote-if",
114    "cond",
115    "+expand",
116    "=expand",
117    "<>expand",
118    ">expand",
119    "<expand",
120    ">=expand",
121    "<=expand",
122    "-expand",
123    "*expand",
124    "quotient-expand",
125    "mod-expand",
126    "&expand",
127    "characters-expand",
128    "address-expand",
129    "row-expand",
130    "column-expand",
131    "column-letters-expand",
132];
133
134fn is_listops(head_fold: &str) -> bool {
135    LISTOPS.contains(&head_fold)
136}
137
138/// A form as the expander holds it (VLA.2): VLA.bas's own model, where an
139/// atom is a text and a list a `Collection` passed by reference. Cloning a
140/// node clones a reference, never the tree under it.
141#[derive(Clone, Debug)]
142enum Node {
143    Sym(Arc<str>),
144    Str(Arc<str>),
145    List(Seq),
146}
147
148/// A list: the items of a shared [`Run`] from `start` on, under a line of
149/// its own. At `start` 0 it is the reference's `Collection`; past it, its
150/// `VlaSlice`, the view `cdr` makes. Its weight is kept beside it, made
151/// when it is made: `forms`, the forms in its tree as the printer would
152/// write them, itself among them (a list shared twice is counted twice,
153/// saturating), and `depth`, its nesting, itself 1.
154#[derive(Clone, Debug)]
155struct Seq {
156    run: Arc<Run>,
157    start: usize,
158    line: u32,
159    forms: u32,
160    depth: u32,
161}
162
163/// The items a list was made with, shared by every view of them.
164#[derive(Debug)]
165struct Run {
166    items: Vec<Node>,
167    /// For each `k`, the deepest list among `items[k..]` (0 for none),
168    /// made the first time a view of this run is made, so that a view's
169    /// depth is read and not walked.
170    deepest: OnceLock<Vec<u32>>,
171}
172
173impl Run {
174    fn deepest_from(&self, k: usize) -> u32 {
175        let deepest = self.deepest.get_or_init(|| {
176            let mut v = vec![0; self.items.len() + 1];
177            for i in (0..self.items.len()).rev() {
178                v[i] = v[i + 1].max(self.items[i].weight().1);
179            }
180            v
181        });
182        deepest[k]
183    }
184}
185
186impl Seq {
187    fn new(items: Vec<Node>, line: u32) -> Seq {
188        let (mut forms, mut deepest) = (1u32, 0u32);
189        for item in &items {
190            let (f, d) = item.weight();
191            forms = forms.saturating_add(f);
192            deepest = deepest.max(d);
193        }
194        Seq {
195            run: Arc::new(Run {
196                items,
197                deepest: OnceLock::new(),
198            }),
199            start: 0,
200            line,
201            forms,
202            depth: deepest.saturating_add(1),
203        }
204    }
205
206    fn items(&self) -> &[Node] {
207        &self.run.items[self.start..]
208    }
209
210    fn count(&self) -> usize {
211        self.run.items.len() - self.start
212    }
213
214    /// VBA `ListTail`'s view: the items from position `n + 1` on, the same
215    /// items, untagged. Its forms are this list's less the `n` it passes;
216    /// a count that saturated says only "at least", so it stays saturated
217    /// and the walk in [`Expander::weigh`] decides.
218    fn tail(&self, n: usize) -> Seq {
219        let passed = self.items()[..n]
220            .iter()
221            .fold(0u32, |sum, item| sum.saturating_add(item.weight().0));
222        let start = self.start + n;
223        Seq {
224            run: Arc::clone(&self.run),
225            start,
226            line: 0,
227            forms: if self.forms == u32::MAX {
228                u32::MAX
229            } else {
230                self.forms - passed
231            },
232            depth: self.run.deepest_from(start).saturating_add(1),
233        }
234    }
235}
236
237impl Node {
238    fn sym(text: &str) -> Node {
239        Node::Sym(Arc::from(text))
240    }
241
242    /// A list with no line, as every list the macro system makes has none.
243    fn list(items: Vec<Node>) -> Node {
244        Node::List(Seq::new(items, 0))
245    }
246
247    /// A form read into nodes, every list keeping its line.
248    fn of(f: &Form) -> Node {
249        match f {
250            Form::Sym(s) => Node::Sym(Arc::from(s.as_str())),
251            Form::Str(s) => Node::Str(Arc::from(s.as_str())),
252            Form::List(l) => Node::List(Seq::new(l.items.iter().map(Node::of).collect(), l.line)),
253        }
254    }
255
256    /// The node written out as a form: a list shared in two places is two
257    /// lists of the form, as the reference's printer writes it twice.
258    fn form(&self) -> Form {
259        match self {
260            Node::Sym(s) => Form::Sym(s.to_string()),
261            Node::Str(s) => Form::Str(s.to_string()),
262            Node::List(l) => Form::List(List::new(
263                l.items().iter().map(Node::form).collect(),
264                l.line,
265            )),
266        }
267    }
268
269    /// The forms in the node's tree and its nesting: an atom is one form
270    /// and no list.
271    fn weight(&self) -> (u32, u32) {
272        match self {
273            Node::List(l) => (l.forms, l.depth),
274            _ => (1, 0),
275        }
276    }
277
278    fn is_list(&self) -> bool {
279        matches!(self, Node::List(_))
280    }
281
282    /// [`Form::atom_text`]: a symbol's text, or a string literal's content
283    /// behind its quote marker. `None` for a list.
284    fn atom_text(&self) -> Option<String> {
285        match self {
286            Node::Sym(s) => Some(s.to_string()),
287            Node::Str(s) => Some(format!("\"{s}")),
288            Node::List(_) => None,
289        }
290    }
291
292    /// VBA `ListHeadIs`: a list whose first element is a symbol folding
293    /// equal to `name`.
294    fn head_is(&self, name: &str) -> bool {
295        match self {
296            Node::List(l) => {
297                matches!(l.items().first(), Some(Node::Sym(s)) if fold(s) == fold(name))
298            }
299            _ => false,
300        }
301    }
302}
303
304/// VBA `Nth` over a list's items: element `i`, 1-based, refusing past the
305/// end ([`List::nth`]'s refusal).
306fn nth(items: &[Node], i: usize) -> Result<&Node, Refusal> {
307    if i == 0 || i > items.len() {
308        return Err(raise("vla-form-missing-element", &[("n", &i.to_string())]));
309    }
310    Ok(&items[i - 1])
311}
312
313/// VBA `NthList`: element `i` as a list, refusing an atom there
314/// ([`List::nth_list`]'s refusal).
315fn nth_list(items: &[Node], i: usize) -> Result<&Seq, Refusal> {
316    match nth(items, i)? {
317        Node::List(l) => Ok(l),
318        other => Err(raise(
319            "vla-expected-list-at-position",
320            &[
321                ("n", &i.to_string()),
322                ("value", &other.atom_text().unwrap_or_default()),
323            ],
324        )),
325    }
326}
327
328/// The substitution environment of one macro application: `Substitute`'s
329/// `bindings`, `restName` (folded) and `restItems`. Empty for a primitive
330/// met outside any template.
331#[derive(Default)]
332struct Env<'r> {
333    bindings: HashMap<&'r str, Node>,
334    rest_name: &'r str,
335    rest_items: Vec<Node>,
336}
337
338/// A macro as the expander applies it (VLA.2): its parameters folded and
339/// its template read into nodes once, when it is defined.
340struct Rule {
341    params: Vec<String>,
342    rest_name: String,
343    template: Node,
344}
345
346/// The macro table and the application counters: `mMacros`, `mBudgetOn`,
347/// `mExpandBudget` and `mExpandFired`.
348#[derive(Default)]
349pub struct Expander {
350    macros: HashMap<String, Macro>,
351    /// Each macro of `macros` as it is applied, under the same name.
352    rules: HashMap<String, Rule>,
353    /// L15: when on, applications beyond the budget do not fire.
354    pub budget_on: bool,
355    pub expand_budget: u64,
356    /// L1: macro applications since the last reset.
357    pub expand_fired: u64,
358}
359
360/// The most forms one macro application's result may hold (VLA.1), counted
361/// as the printer would write them, so a value its template uses twice
362/// counts twice. A macro that doubles its argument at every application is
363/// refused at its nineteenth, long before the chain's 5,000: its value is
364/// shared and cheap to hold (VLA.2), but its expansion is written out as a
365/// tree. One application's result, not the program's sum: a walk over a
366/// long list holds the rest of the list in every result, so a sum grows as
367/// the square of the list. The largest form the corpus expands to is 20,144
368/// forms; the table generator's first application holds 30,041 at 2,499
369/// rows, the most its chain allows at two links a row.
370pub const EXPANSION_SIZE_LIMIT: usize = 1_000_000;
371
372impl Expander {
373    pub fn new() -> Expander {
374        Expander::default()
375    }
376
377    /// VBA `GetMacro`: by name, folded.
378    pub fn get_macro(&self, name: &str) -> Option<&Macro> {
379        self.macros.get(&fold(name))
380    }
381
382    /// VBA `VlaMacroDoc`: a macro's docstring, or empty.
383    pub fn macro_doc(&self, name: &str) -> String {
384        self.get_macro(name)
385            .map(|m| m.doc.clone())
386            .unwrap_or_default()
387    }
388
389    /// VBA `DefineMacro`: `(defmacro (name params... [& rest]) ["doc"]
390    /// template...)`.
391    pub fn define_macro(&mut self, f: &List) -> Result<(), Refusal> {
392        let sig = f.nth_list(2)?;
393        let mname = sig.head_sym()?;
394        let mfold = fold(&mname);
395        if let Some((word, desc)) = RESERVED.iter().find(|(w, _)| *w == mfold) {
396            return Err(raise(
397                "vla-defmacro-reserved-name",
398                &[("word", word), ("desc", desc)],
399            ));
400        }
401
402        let mut params = Vec::new();
403        let mut rest_name = String::new();
404        let mut j = 2;
405        while j <= sig.count() {
406            let t = sym_text(sig.nth(j)?)?;
407            if t == "&" {
408                if j + 1 > sig.count() {
409                    return Err(raise(
410                        "vla-defmacro-rest-param-missing",
411                        &[("name", &mname)],
412                    ));
413                }
414                rest_name = sym_text(sig.nth(j + 1)?)?;
415                if j + 1 != sig.count() {
416                    return Err(raise(
417                        "vla-defmacro-rest-param-not-last",
418                        &[("name", &mname)],
419                    ));
420                }
421                break;
422            }
423            params.push(t);
424            j += 1;
425        }
426
427        // L17: a string at form 3 is documentation only when at least one
428        // more form follows; a lone string is the template.
429        let mut doc = String::new();
430        let mut doc_idx = 3;
431        if f.count() >= 4 {
432            if let Form::Str(s) = f.nth(3)? {
433                doc = s.clone();
434                doc_idx = 4;
435            }
436        }
437
438        let template = if f.count() == doc_idx {
439            f.nth(doc_idx)?.clone()
440        } else if f.count() > doc_idx {
441            let mut items = vec![Form::sym("begin")];
442            items.extend(f.items[doc_idx - 1..].iter().cloned());
443            Form::list(items)
444        } else {
445            return Err(raise("vla-defmacro-missing-template", &[("name", &mname)]));
446        };
447
448        // A redefinition overwrites, as the Dictionary's keyed assignment does.
449        self.rules.insert(
450            mfold.clone(),
451            Rule {
452                params: params.iter().map(|p| fold(p)).collect(),
453                rest_name: fold(&rest_name),
454                template: Node::of(&template),
455            },
456        );
457        self.macros.insert(
458            mfold,
459            Macro {
460                params,
461                rest_name,
462                template,
463                doc,
464                name: mname,
465            },
466        );
467        Ok(())
468    }
469
470    /// VBA `ExpandMacros`: a form to its fixpoint.
471    pub fn expand(&mut self, d: &Form, depth: u32) -> Result<Form, Refusal> {
472        self.expand_at(&Node::of(d), depth, 1)
473    }
474
475    /// [`Expander::expand`] at `walk`, the depth of the list `d` would be
476    /// within its top-level form (VLA.1): a list deeper than the reader's
477    /// limit is refused, whether a text or a macro nested it so.
478    fn expand_at(&mut self, d: &Node, depth: u32, walk: u32) -> Result<Form, Refusal> {
479        if let Node::List(lst) = d {
480            if walk > FORM_DEPTH_LIMIT {
481                return Err(too_deep(lst.line));
482            }
483        }
484        if depth > 200 {
485            return Err(raise("vla-macro-expansion-too-deep", &[]));
486        }
487        let mut cur = d.clone();
488        let mut chain_len: u32 = 0;
489        let mut pending_head: Vec<Node> = Vec::new();
490        loop {
491            let Node::List(lst) = &cur else {
492                return Ok(cur.form());
493            };
494            let items = lst.items();
495            let Some(Node::Sym(head)) = items.first() else {
496                break;
497            };
498            let head_fold = fold(head);
499            // P.L5: quote is a data context; expansion never enters.
500            if head_fold == "quote" {
501                return Ok(cur.form());
502            }
503            // QUASIQUOTE: (symbol ...) needs no ambient bindings.
504            if head_fold == "symbol" {
505                return Ok(fuse_symbol(items, &Env::default())?.form());
506            }
507            if matches!(
508                head_fold.as_str(),
509                "quasiquote" | "unquote" | "unquote-splicing"
510            ) {
511                return Err(raise(
512                    "vla-quasiquote-outside-template",
513                    &[("head", &head_fold)],
514                ));
515            }
516            // LISTOPS: the twenty-seven primitives, standalone.
517            if is_listops(&head_fold) {
518                return Ok(eval_listops_prim(&head_fold, items, &Env::default())?.form());
519            }
520            if head_fold == "begin" && items.len() > 1 && lst.line == 0 {
521                // TABLESPEC-SCALE: a begin a macro made is a tail-position
522                // wrapper; its other elements wait, its last is looked at
523                // again.
524                pending_head.extend(items[1..items.len() - 1].iter().cloned());
525                chain_len += 1;
526                if chain_len > 5000 {
527                    return Err(raise("vla-macro-self-expansion-limit", &[]));
528                }
529                let last = items[items.len() - 1].clone();
530                cur = last;
531            } else if head_fold == "begin" {
532                break;
533            } else {
534                let Some(rule) = self.rules.get(&head_fold) else {
535                    break;
536                };
537                if self.budget_on && self.expand_fired >= self.expand_budget {
538                    break; // L15
539                }
540                chain_len += 1;
541                if chain_len > 5000 {
542                    return Err(raise("vla-macro-self-expansion-limit", &[]));
543                }
544                let r = expand_one(items, rule)?;
545                self.weigh(&r)?;
546                self.expand_fired += 1; // L1: one per application
547                cur = r;
548            }
549        }
550        // No macro at the head: rebuild with expanded elements, keeping the
551        // list's own line (C2).
552        let Node::List(cur_list) = &cur else {
553            unreachable!("the loop leaves only on a list");
554        };
555        let mut out = Vec::with_capacity(cur_list.count());
556        for e in cur_list.items() {
557            out.push(self.expand_at(e, depth, walk + 1)?);
558        }
559        let out = Form::List(List::new(out, cur_list.line));
560        if pending_head.is_empty() {
561            return Ok(out);
562        }
563        let mut final_out = vec![Form::sym("begin")];
564        for e in &pending_head {
565            final_out.push(self.expand_at(e, depth, walk + 1)?);
566        }
567        final_out.push(out);
568        Ok(Form::list(final_out))
569    }
570
571    /// VBA `ExpandOnePass`: top-down; a list whose head is a macro is
572    /// replaced by its substitution and not walked further.
573    pub fn expand_one_pass(&mut self, d: &Form) -> Result<Form, Refusal> {
574        self.expand_one_pass_at(&Node::of(d), 1)
575    }
576
577    /// [`Expander::expand_one_pass`] at `walk`, held to the reader's limit
578    /// as [`Expander::expand`]'s walk is (VLA.1).
579    fn expand_one_pass_at(&mut self, d: &Node, walk: u32) -> Result<Form, Refusal> {
580        let Node::List(lst) = d else {
581            return Ok(d.form());
582        };
583        if walk > FORM_DEPTH_LIMIT {
584            return Err(too_deep(lst.line));
585        }
586        let items = lst.items();
587        if let Some(Node::Sym(head)) = items.first() {
588            let head_fold = fold(head);
589            if head_fold == "quote" {
590                return Ok(d.form());
591            }
592            if let Some(rule) = self.rules.get(&head_fold) {
593                if !(self.budget_on && self.expand_fired >= self.expand_budget) {
594                    let r = expand_one(items, rule)?;
595                    self.weigh(&r)?;
596                    self.expand_fired += 1;
597                    return Ok(r.form());
598                }
599            }
600        }
601        let mut out = Vec::with_capacity(items.len());
602        for e in items {
603            out.push(self.expand_one_pass_at(e, walk + 1)?);
604        }
605        Ok(Form::List(List::new(out, lst.line)))
606    }
607
608    /// VLA.1: one application's result, weighed before it is used: no list
609    /// in it nested past the reader's limit, and no more than
610    /// [`EXPANSION_SIZE_LIMIT`] forms in it. So a macro that deepens its
611    /// argument on every application is refused at the depth the walk would
612    /// refuse it, before a form thousands deep runs the stack out, and one
613    /// that doubles it is refused within twenty applications. The result's
614    /// weight was made with it (VLA.2), so a walk that holds the rest of
615    /// its list in every result does not walk that rest at every step; only
616    /// a result past a limit is walked, a stack of its own since the form
617    /// is what may be deep, and in the order the copies were walked, so
618    /// the refusal and the list it names are the same.
619    fn weigh(&self, r: &Node) -> Result<(), Refusal> {
620        let (forms, depth) = r.weight();
621        if forms as usize <= EXPANSION_SIZE_LIMIT && depth <= FORM_DEPTH_LIMIT {
622            return Ok(());
623        }
624        let mut forms = 0usize;
625        let mut stack = vec![(r, 1u32)];
626        while let Some((f, depth)) = stack.pop() {
627            forms += 1;
628            if forms > EXPANSION_SIZE_LIMIT {
629                return Err(raise(
630                    "vla-macro-expansion-too-large",
631                    &[("limit", "1,000,000")],
632                ));
633            }
634            if let Node::List(l) = f {
635                if depth > FORM_DEPTH_LIMIT {
636                    return Err(too_deep(l.line));
637                }
638                stack.extend(l.items().iter().map(|item| (item, depth + 1)));
639            }
640        }
641        Ok(())
642    }
643
644    /// `VlaTranspile`'s and `VlaExpandText`'s pass 1 over the prelude and
645    /// the source read together: every `defmacro` is defined, in order, and
646    /// the other forms come back as the body.
647    pub fn collect(&mut self, forms: Vec<Form>) -> Result<Vec<Form>, Refusal> {
648        let mut body = Vec::with_capacity(forms.len());
649        for f in forms {
650            if f.head_is("defmacro") {
651                let Form::List(l) = &f else { unreachable!() };
652                self.define_macro(l)?;
653            } else {
654                body.push(f);
655            }
656        }
657        Ok(body)
658    }
659}
660
661/// VBA `VlaExpandText`: the prelude and the source read together, every
662/// `defmacro` defined, every other form expanded (to its fixpoint, or one
663/// pass) and written pretty, one per line. Returns the text and the number
664/// of applications that fired.
665pub fn expand_text(
666    source: &str,
667    prelude: &str,
668    to_fixpoint: bool,
669) -> Result<(String, u64), Refusal> {
670    let line_offset = count_lf(prelude) as u32 + 1;
671    let text = format!("{prelude}\r\n{source}");
672    let forms = parse_all(&tokenize(&text), line_offset)?;
673    let mut ex = Expander::new();
674    let body = ex.collect(forms)?;
675    let mut out = String::new();
676    for f in &body {
677        let expanded = if to_fixpoint {
678            ex.expand(f, 0)?
679        } else {
680            ex.expand_one_pass(f)?
681        };
682        out.push_str(&write_pretty(&expanded, 0));
683        out.push_str("\r\n");
684    }
685    Ok((out, ex.expand_fired))
686}
687
688/// The walk's refusal of a list past the reader's limit, at the list's own
689/// line, or at none for a list a macro made (VLA.1).
690fn too_deep(line: u32) -> Refusal {
691    raise(
692        "vla-form-too-deep",
693        &[
694            ("limit", &FORM_DEPTH_LIMIT.to_string()),
695            ("loc", &src_line_tag(line, 0)),
696        ],
697    )
698}
699
700/// VBA `ExpandOne`: one application of a macro to a call form's items. A
701/// parameter is bound to its argument itself, not a copy of it.
702fn expand_one(call: &[Node], rule: &Rule) -> Result<Node, Refusal> {
703    let argc = call.len() - 1;
704    let name = call[0].atom_text().unwrap_or_default();
705    if rule.rest_name.is_empty() {
706        if argc != rule.params.len() {
707            return Err(raise(
708                "vla-macro-arity",
709                &[
710                    ("name", &name),
711                    ("n", &rule.params.len().to_string()),
712                    ("given", &argc.to_string()),
713                ],
714            ));
715        }
716    } else if argc < rule.params.len() {
717        return Err(raise(
718            "vla-macro-arity-min",
719            &[
720                ("name", &name),
721                ("n", &rule.params.len().to_string()),
722                ("given", &argc.to_string()),
723            ],
724        ));
725    }
726    let mut env = Env {
727        bindings: HashMap::new(),
728        rest_name: &rule.rest_name,
729        rest_items: Vec::new(),
730    };
731    for (j, p) in rule.params.iter().enumerate() {
732        env.bindings.insert(p, call[j + 1].clone());
733    }
734    env.rest_items
735        .extend(call[rule.params.len() + 1..].iter().cloned());
736    substitute(&rule.template, &env, false)
737}
738
739/// VBA `Substitute`: a template with its parameters replaced, each by its
740/// value itself (`Set Substitute = v`). Inside a quasiquote shield
741/// (`in_quasi`) a bare symbol is data, and only an explicit `unquote` or
742/// `unquote-splicing` reaches the bindings.
743fn substitute(t: &Node, env: &Env, in_quasi: bool) -> Result<Node, Refusal> {
744    let lst = match t {
745        Node::List(l) => l,
746        Node::Sym(s) if !in_quasi => {
747            let key = fold(s);
748            if !env.rest_name.is_empty() && key == env.rest_name {
749                // The rest parameter standalone: the whole list.
750                return Ok(Node::list(env.rest_items.clone()));
751            }
752            if let Some(v) = env.bindings.get(key.as_str()) {
753                return Ok(v.clone());
754            }
755            return Ok(t.clone());
756        }
757        _ => return Ok(t.clone()),
758    };
759    let items = lst.items();
760
761    if let Some(Node::Sym(head)) = items.first() {
762        let h = fold(head);
763        match h.as_str() {
764            "symbol" => return fuse_symbol(items, env),
765            "quasiquote" => {
766                if in_quasi {
767                    return Err(raise("vla-quasiquote-nested", &[]));
768                }
769                if items.len() != 2 {
770                    return Err(raise(
771                        "vla-quasiquote-arity",
772                        &[("n", &(items.len() - 1).to_string())],
773                    ));
774                }
775                return substitute(nth(items, 2)?, env, true);
776            }
777            "unquote" => {
778                if !in_quasi {
779                    return Err(raise("vla-unquote-outside-quasiquote", &[]));
780                }
781                if items.len() != 2 {
782                    return Err(raise(
783                        "vla-unquote-arity",
784                        &[("n", &(items.len() - 1).to_string())],
785                    ));
786                }
787                return substitute(nth(items, 2)?, env, false);
788            }
789            "unquote-splicing" => {
790                // A splice in its place is taken by the element walk below;
791                // reaching here it is a bare value, or outside a shield.
792                if !in_quasi {
793                    return Err(raise("vla-unquote-splicing-outside-quasiquote", &[]));
794                }
795                return Err(raise("vla-unquote-splicing-not-element", &[]));
796            }
797            _ if is_listops(&h) && !in_quasi => {
798                return eval_listops_prim(&h, items, env);
799            }
800            _ => {}
801        }
802    }
803
804    let mut out = Vec::with_capacity(items.len());
805    for e in items {
806        let mut spliced = false;
807        if in_quasi && e.head_is("unquote-splicing") {
808            let Node::List(spl) = e else { unreachable!() };
809            let spl = spl.items();
810            if spl.len() != 2 {
811                return Err(raise(
812                    "vla-unquote-splicing-arity",
813                    &[("n", &(spl.len() - 1).to_string())],
814                ));
815            }
816            let val = substitute(nth(spl, 2)?, env, false)?;
817            let Node::List(val) = val else {
818                return Err(raise("vla-unquote-splicing-not-list", &[]));
819            };
820            out.extend(val.items().iter().cloned());
821            spliced = true;
822        } else if !in_quasi {
823            if let Node::Sym(s) = e {
824                if !env.rest_name.is_empty() && fold(s) == env.rest_name {
825                    // The rest parameter as an element: its forms spliced in.
826                    out.extend(env.rest_items.iter().cloned());
827                    spliced = true;
828                }
829            }
830        }
831        if !spliced {
832            out.push(substitute(e, env, in_quasi)?);
833        }
834    }
835    // S3.1: a template copy is explicitly untagged; the user's own forms
836    // spliced in above keep their lines.
837    Ok(Node::list(out))
838}
839
840/// VBA `FuseSymbol`: `(symbol a b ...)` fuses each argument's resolved
841/// text into one new atom. A fused text that begins with a quote mark is
842/// a string literal, as the VBA's leading-quote marker makes it.
843fn fuse_symbol(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
844    if lst.len() < 2 {
845        return Err(raise("vla-symbol-arity", &[]));
846    }
847    let mut fused = String::new();
848    for k in 2..=lst.len() {
849        let piece = substitute(nth(lst, k)?, env, false)?;
850        match piece {
851            Node::List(_) => {
852                return Err(raise(
853                    "vla-symbol-arg-is-list",
854                    &[("n", &(k - 1).to_string())],
855                ));
856            }
857            Node::Str(s) | Node::Sym(s) => fused.push_str(&s),
858        }
859    }
860    Ok(match fused.strip_prefix('"') {
861        Some(rest) => Node::Str(Arc::from(rest)),
862        None => Node::Sym(Arc::from(fused.as_str())),
863    })
864}
865
866/// VBA `EvalListopsPrim`: the dispatcher the two recognition sites share,
867/// over the primitive's call form.
868fn eval_listops_prim(head_fold: &str, lst: &[Node], env: &Env) -> Result<Node, Refusal> {
869    match head_fold {
870        "car" => eval_car(lst, env),
871        "cdr" => eval_cdr(lst, env),
872        "cddr" => eval_cddr(lst, env),
873        "cons" => eval_cons(lst, env),
874        "list" => eval_list(lst, env),
875        "null?" => eval_nullq(lst, env),
876        "eq?" => eval_eq(lst, env),
877        "equal?" => eval_equal(lst, env),
878        "quote-if" => eval_quote_if(lst, env),
879        "cond" => eval_cond_from(lst, 2, env),
880        "&expand" => eval_concat_expand(lst, env),
881        "characters-expand" => eval_characters_expand(lst, env),
882        "address-expand" => eval_address_expand(lst, env),
883        "row-expand" | "column-expand" => eval_address_part_expand(head_fold, lst, env),
884        "column-letters-expand" => eval_column_letters_expand(lst, env),
885        _ => eval_arith_expand(head_fold, lst, env),
886    }
887}
888
889/// VBA `ResolveListopsArg`: the argument through `Substitute`, then one
890/// top-level `(quote X)` unwrapped to its data, X itself.
891fn resolve_listops_arg(arg: &Node, env: &Env) -> Result<Node, Refusal> {
892    let v = substitute(arg, env, false)?;
893    if v.head_is("quote") {
894        let Node::List(qc) = &v else { unreachable!() };
895        let qc = qc.items();
896        if qc.len() != 2 {
897            return Err(raise("vla-quote-arity", &[]));
898        }
899        return Ok(qc[1].clone());
900    }
901    Ok(v)
902}
903
904fn arity_n(lst: &[Node]) -> String {
905    (lst.len() - 1).to_string()
906}
907
908fn eval_car(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
909    if lst.len() != 2 {
910        return Err(raise("vla-car-arity", &[("n", &arity_n(lst))]));
911    }
912    let v = resolve_listops_arg(nth(lst, 2)?, env)?;
913    let Node::List(c) = &v else {
914        return Err(raise(
915            "vla-car-expected-list",
916            &[("value", &v.atom_text().unwrap_or_default())],
917        ));
918    };
919    let Some(first) = c.items().first() else {
920        return Err(raise("vla-car-empty-list", &[]));
921    };
922    Ok(first.clone())
923}
924
925/// VBA `ListTail`: the items from position `n + 1` on, untagged, a view
926/// of the same items (`VlaSlice`).
927fn list_tail(c: &Seq, n: usize, caller: &str) -> Result<Node, Refusal> {
928    if c.count() < n {
929        return Err(raise(
930            "vla-list-too-short",
931            &[
932                ("caller", caller),
933                ("n", &n.to_string()),
934                ("count", &c.count().to_string()),
935            ],
936        ));
937    }
938    Ok(Node::List(c.tail(n)))
939}
940
941fn eval_cdr(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
942    if lst.len() != 2 {
943        return Err(raise("vla-cdr-arity", &[("n", &arity_n(lst))]));
944    }
945    let v = resolve_listops_arg(nth(lst, 2)?, env)?;
946    let Node::List(c) = &v else {
947        return Err(raise(
948            "vla-cdr-expected-list",
949            &[("value", &v.atom_text().unwrap_or_default())],
950        ));
951    };
952    list_tail(c, 1, "cdr")
953}
954
955fn eval_cddr(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
956    if lst.len() != 2 {
957        return Err(raise("vla-cddr-arity", &[("n", &arity_n(lst))]));
958    }
959    let v = resolve_listops_arg(nth(lst, 2)?, env)?;
960    let Node::List(c) = &v else {
961        return Err(raise(
962            "vla-cddr-expected-list",
963            &[("value", &v.atom_text().unwrap_or_default())],
964        ));
965    };
966    list_tail(c, 2, "cddr")
967}
968
969/// `(cons item lst)`: a new list of the item and the tail's items, as
970/// VBA's `EvalCons` makes it, which shares no tail (P-NTH: a flat view
971/// cannot hold one element ahead of a shared tail). The items themselves
972/// are shared.
973fn eval_cons(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
974    if lst.len() != 3 {
975        return Err(raise("vla-cons-arity", &[("n", &arity_n(lst))]));
976    }
977    let item = resolve_listops_arg(nth(lst, 2)?, env)?;
978    let tail = resolve_listops_arg(nth(lst, 3)?, env)?;
979    let Node::List(tail) = &tail else {
980        return Err(raise(
981            "vla-cons-second-not-list",
982            &[("value", &tail.atom_text().unwrap_or_default())],
983        ));
984    };
985    let mut out = Vec::with_capacity(tail.count() + 1);
986    out.push(item);
987    out.extend(tail.items().iter().cloned());
988    Ok(Node::list(out))
989}
990
991fn eval_list(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
992    let mut out = Vec::with_capacity(lst.len());
993    for k in 2..=lst.len() {
994        out.push(resolve_listops_arg(nth(lst, k)?, env)?);
995    }
996    Ok(Node::list(out))
997}
998
999fn bool_sym(b: bool) -> Node {
1000    Node::sym(if b { "true" } else { "false" })
1001}
1002
1003/// VBA `AtomEqual`: symbols folded, strings exact, never across the kinds.
1004fn atom_equal(a: &Node, b: &Node) -> bool {
1005    match (a, b) {
1006        (Node::Sym(x), Node::Sym(y)) => fold(x) == fold(y),
1007        (Node::Str(x), Node::Str(y)) => x == y,
1008        _ => false,
1009    }
1010}
1011
1012/// VBA `DeepEqual`.
1013fn deep_equal(a: &Node, b: &Node) -> bool {
1014    match (a, b) {
1015        (Node::List(x), Node::List(y)) => {
1016            x.count() == y.count()
1017                && x.items()
1018                    .iter()
1019                    .zip(y.items())
1020                    .all(|(p, q)| deep_equal(p, q))
1021        }
1022        (Node::List(_), _) | (_, Node::List(_)) => false,
1023        _ => atom_equal(a, b),
1024    }
1025}
1026
1027fn eval_nullq(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
1028    if lst.len() != 2 {
1029        return Err(raise("vla-nullq-arity", &[("n", &arity_n(lst))]));
1030    }
1031    let v = resolve_listops_arg(nth(lst, 2)?, env)?;
1032    Ok(match &v {
1033        Node::List(c) => bool_sym(c.count() == 0),
1034        _ => bool_sym(false),
1035    })
1036}
1037
1038fn eval_eq(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
1039    if lst.len() != 3 {
1040        return Err(raise("vla-eq-arity", &[("n", &arity_n(lst))]));
1041    }
1042    let a = resolve_listops_arg(nth(lst, 2)?, env)?;
1043    let b = resolve_listops_arg(nth(lst, 3)?, env)?;
1044    if a.is_list() || b.is_list() {
1045        return Err(raise("vla-eq-expected-atom", &[]));
1046    }
1047    Ok(bool_sym(atom_equal(&a, &b)))
1048}
1049
1050fn eval_equal(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
1051    if lst.len() != 3 {
1052        return Err(raise("vla-equal-arity", &[("n", &arity_n(lst))]));
1053    }
1054    let a = resolve_listops_arg(nth(lst, 2)?, env)?;
1055    let b = resolve_listops_arg(nth(lst, 3)?, env)?;
1056    Ok(bool_sym(deep_equal(&a, &b)))
1057}
1058
1059/// `(quote-if test then else)`: only the selected branch is ever resolved.
1060fn eval_quote_if(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
1061    if lst.len() != 4 {
1062        return Err(raise("vla-quote-if-arity", &[("n", &arity_n(lst))]));
1063    }
1064    let t = resolve_listops_arg(nth(lst, 2)?, env)?;
1065    let tf = match &t {
1066        Node::List(_) => return Err(raise("vla-quote-if-test-is-list", &[])),
1067        Node::Str(_) => {
1068            return Err(raise(
1069                "vla-quote-if-test-invalid",
1070                &[("value", &t.atom_text().unwrap_or_default())],
1071            ))
1072        }
1073        Node::Sym(s) => fold(s),
1074    };
1075    let branch = match tf.as_str() {
1076        "true" => nth(lst, 3)?,
1077        "false" => nth(lst, 4)?,
1078        _ => {
1079            return Err(raise(
1080                "vla-quote-if-test-invalid",
1081                &[("value", &t.atom_text().unwrap_or_default())],
1082            ))
1083        }
1084    };
1085    substitute(branch, env, false)
1086}
1087
1088/// LISTOPS-EXPAND: `(+expand a b)` and the six comparisons, over literal
1089/// numeric operands only, through `Val` and `Str$`. VLA.3 adds `-expand`
1090/// and `*expand`, and `quotient-expand` and `mod-expand`: Excel's
1091/// `QUOTIENT` (truncated toward zero) and `MOD` (the divisor's sign,
1092/// `a - b * floor(a / b)`), over whole numbers only, a zero divisor
1093/// refused.
1094fn eval_arith_expand(op: &str, lst: &[Node], env: &Env) -> Result<Node, Refusal> {
1095    if lst.len() != 3 {
1096        return Err(raise(
1097            "vla-arith-expand-arity",
1098            &[("op", op), ("n", &arity_n(lst))],
1099        ));
1100    }
1101    let a = resolve_listops_arg(nth(lst, 2)?, env)?;
1102    let b = resolve_listops_arg(nth(lst, 3)?, env)?;
1103    let [ta, tb] = number_texts(op, [&a, &b])?;
1104    let na = val(&ta);
1105    let nb = val(&tb);
1106    let number = |x: f64| Node::sym(str_(x).trim());
1107    Ok(match op {
1108        "+expand" => number(na + nb),
1109        "=expand" => bool_sym(na == nb),
1110        "<>expand" => bool_sym(na != nb),
1111        ">expand" => bool_sym(na > nb),
1112        "<expand" => bool_sym(na < nb),
1113        ">=expand" => bool_sym(na >= nb),
1114        "<=expand" => bool_sym(na <= nb),
1115        "-expand" => number(na - nb),
1116        "*expand" => number(na * nb),
1117        _ => {
1118            for (n, text) in [(na, &ta), (nb, &tb)] {
1119                if n.fract() != 0.0 {
1120                    return Err(raise(
1121                        "vla-arith-expand-not-whole",
1122                        &[("op", op), ("value", text)],
1123                    ));
1124                }
1125            }
1126            if nb == 0.0 {
1127                return Err(raise("vla-arith-expand-divide-by-zero", &[("op", op)]));
1128            }
1129            if op == "quotient-expand" {
1130                number((na / nb).trunc())
1131            } else {
1132                number(na - nb * (na / nb).floor())
1133            }
1134        }
1135    })
1136}
1137
1138/// The seven's gate over two operands, in the reference's order: both
1139/// checked as lists, then both as numeric literals. Their texts.
1140fn number_texts(op: &str, operands: [&Node; 2]) -> Result<[String; 2], Refusal> {
1141    let mut texts = [String::new(), String::new()];
1142    for (k, v) in operands.iter().enumerate() {
1143        let Some(text) = v.atom_text() else {
1144            return Err(raise("vla-arith-expand-not-number-list", &[("op", op)]));
1145        };
1146        texts[k] = text;
1147    }
1148    for text in &texts {
1149        if !is_numeric_literal_text(text) {
1150            return Err(raise(
1151                "vla-arith-expand-not-number-value",
1152                &[("op", op), ("value", text)],
1153            ));
1154        }
1155    }
1156    Ok(texts)
1157}
1158
1159/// The same gate over one operand.
1160fn number_text(op: &str, v: &Node) -> Result<String, Refusal> {
1161    let Some(text) = v.atom_text() else {
1162        return Err(raise("vla-arith-expand-not-number-list", &[("op", op)]));
1163    };
1164    if !is_numeric_literal_text(&text) {
1165        return Err(raise(
1166            "vla-arith-expand-not-number-value",
1167            &[("op", op), ("value", &text)],
1168        ));
1169    }
1170    Ok(text)
1171}
1172
1173/// VLA.3's arity refusal for a primitive taking `want` arguments.
1174fn expand_arity(op: &str, want: usize, lst: &[Node]) -> Refusal {
1175    raise(
1176        "vla-expand-arity",
1177        &[
1178            ("op", op),
1179            ("want", &want.to_string()),
1180            ("n", &arity_n(lst)),
1181        ],
1182    )
1183}
1184
1185/// VLA.3: an atom's text as the object model's primitives read it, a
1186/// string literal's content or a symbol's (a number's) own text.
1187fn atom_text_expand(v: &Node) -> String {
1188    match v {
1189        Node::Str(s) | Node::Sym(s) => s.to_string(),
1190        Node::List(_) => String::new(),
1191    }
1192}
1193
1194/// VLA.3: `(&expand a b ...)`, each argument resolved as every LISTOPS
1195/// argument is and its text joined. Always a string literal, never a
1196/// symbol, so a macro writes an address or a formula's text with no
1197/// leading-quote trick; `symbol` keeps that trick for identifiers. At
1198/// least one argument, as `symbol` takes.
1199fn eval_concat_expand(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
1200    if lst.len() < 2 {
1201        return Err(raise("vla-concat-expand-arity", &[]));
1202    }
1203    let mut joined = String::new();
1204    for k in 2..=lst.len() {
1205        let piece = resolve_listops_arg(nth(lst, k)?, env)?;
1206        if piece.is_list() {
1207            return Err(raise(
1208                "vla-expand-arg-is-list",
1209                &[("op", "&expand"), ("n", &(k - 1).to_string())],
1210            ));
1211        }
1212        joined.push_str(&atom_text_expand(&piece));
1213    }
1214    Ok(Node::Str(Arc::from(joined.as_str())))
1215}
1216
1217/// VLA.3: `(characters-expand text)`, the text split into one-character
1218/// string literals in order. A character is a Unicode scalar value, as
1219/// the reference counts one by joining a UTF-16 surrogate pair. The empty
1220/// text gives the empty list.
1221fn eval_characters_expand(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
1222    if lst.len() != 2 {
1223        return Err(expand_arity("characters-expand", 1, lst));
1224    }
1225    let v = resolve_listops_arg(nth(lst, 2)?, env)?;
1226    if v.is_list() {
1227        return Err(raise(
1228            "vla-expand-arg-is-list",
1229            &[("op", "characters-expand"), ("n", "1")],
1230        ));
1231    }
1232    let items = atom_text_expand(&v)
1233        .chars()
1234        .map(|c| Node::Str(Arc::from(c.to_string().as_str())))
1235        .collect();
1236    Ok(Node::list(items))
1237}
1238
1239/// VLA.3: `(address-expand row column)`, a cell's address, relative, as
1240/// Excel's `ADDRESS(row, column, 4)` writes it: `B3`. Each argument a
1241/// number literal under the seven's gate, then a whole number within
1242/// Excel's bounds. A string literal.
1243fn eval_address_expand(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
1244    const OP: &str = "address-expand";
1245    if lst.len() != 3 {
1246        return Err(expand_arity(OP, 2, lst));
1247    }
1248    let a = resolve_listops_arg(nth(lst, 2)?, env)?;
1249    let b = resolve_listops_arg(nth(lst, 3)?, env)?;
1250    let [ta, tb] = number_texts(OP, [&a, &b])?;
1251    let (row, col) = (val(&ta), val(&tb));
1252    if row.fract() != 0.0 || !(1.0..=f64::from(MAX_ROW)).contains(&row) {
1253        return Err(raise(
1254            "vla-address-expand-row",
1255            &[("op", OP), ("value", &ta)],
1256        ));
1257    }
1258    if col.fract() != 0.0 || !(1.0..=f64::from(MAX_COLUMN)).contains(&col) {
1259        return Err(raise(
1260            "vla-address-expand-column",
1261            &[("op", OP), ("value", &tb)],
1262        ));
1263    }
1264    let address = format!("{}{}", column_letters(col as u32), str_(row).trim());
1265    Ok(Node::Str(Arc::from(address.as_str())))
1266}
1267
1268/// VLA.3: `(row-expand address)` and `(column-expand address)`, an
1269/// address's row and column numbers, as Excel's `ROW` and `COLUMN` of the
1270/// reference; and `(column-expand letters)`, a column's letters alone, the
1271/// reverse of `column-letters-expand`.
1272fn eval_address_part_expand(op: &str, lst: &[Node], env: &Env) -> Result<Node, Refusal> {
1273    if lst.len() != 2 {
1274        return Err(expand_arity(op, 1, lst));
1275    }
1276    let v = resolve_listops_arg(nth(lst, 2)?, env)?;
1277    if v.is_list() {
1278        return Err(raise("vla-expand-arg-is-list", &[("op", op), ("n", "1")]));
1279    }
1280    let text = atom_text_expand(&v);
1281    let Some((row, col)) = parse_address_text(&text, op == "column-expand") else {
1282        return Err(raise(
1283            "vla-address-expand-not-address",
1284            &[("op", op), ("value", &text)],
1285        ));
1286    };
1287    let n = if op == "row-expand" { row } else { col };
1288    Ok(Node::sym(str_(f64::from(n)).trim()))
1289}
1290
1291/// VLA.3: one grammar for an address, the reference's `ParseAddressText`
1292/// rule for rule: an optional `$`, one to three ASCII letters in either
1293/// case, an optional `$`, then one to seven ASCII digits; the column at
1294/// most XFD, the row 1 to 1,048,576. With `letters_alone`, the letters with
1295/// their optional `$` and nothing after them are a column, the row 0.
1296/// Anything else, a sheet's name before it, a range, a space or a `$`
1297/// anywhere else, is not an address. (`sheet.rs`'s `parse_a1_cell` strips
1298/// a `$` wherever it stands, so it cannot be the rule both implementations
1299/// keep.)
1300fn parse_address_text(s: &str, letters_alone: bool) -> Option<(u32, u32)> {
1301    let b = s.as_bytes();
1302    let n = b.len();
1303    let i = usize::from(n >= 1 && b[0] == b'$');
1304    let mut j = i;
1305    while j < n && b[j].is_ascii_alphabetic() {
1306        j += 1;
1307    }
1308    if j == i || j - i > 3 {
1309        return None;
1310    }
1311    let col = letters_to_col(&s[i..j])?;
1312    if j == n {
1313        return letters_alone.then_some((0, col));
1314    }
1315    if b[j] == b'$' {
1316        j += 1;
1317    }
1318    let mut k = j;
1319    while k < n && b[k].is_ascii_digit() {
1320        k += 1;
1321    }
1322    if k < n || k == j || k - j > 7 {
1323        return None;
1324    }
1325    let row: u32 = s[j..k].parse().ok()?;
1326    if row == 0 || row > MAX_ROW {
1327        return None;
1328    }
1329    Some((row, col))
1330}
1331
1332/// VLA.3: `(column-letters-expand column)`, a column's letters as a string
1333/// literal, 1 = A ... 16384 = XFD; the reverse of `column-expand`.
1334fn eval_column_letters_expand(lst: &[Node], env: &Env) -> Result<Node, Refusal> {
1335    const OP: &str = "column-letters-expand";
1336    if lst.len() != 2 {
1337        return Err(expand_arity(OP, 1, lst));
1338    }
1339    let v = resolve_listops_arg(nth(lst, 2)?, env)?;
1340    let text = number_text(OP, &v)?;
1341    let col = val(&text);
1342    if col.fract() != 0.0 || !(1.0..=f64::from(MAX_COLUMN)).contains(&col) {
1343        return Err(raise(
1344            "vla-address-expand-column",
1345            &[("op", OP), ("value", &text)],
1346        ));
1347    }
1348    Ok(Node::Str(Arc::from(column_letters(col as u32).as_str())))
1349}
1350
1351/// VBA `EvalCondFrom`: `(cond (test form) ... (else form))`, one clause at
1352/// a time from `start_idx`; a test that folds to true or false is taken or
1353/// skipped at expand time, any other test defers to a native `if`.
1354fn eval_cond_from(lst: &[Node], start_idx: usize, env: &Env) -> Result<Node, Refusal> {
1355    if start_idx > lst.len() {
1356        return Ok(Node::list(vec![Node::sym("begin")]));
1357    }
1358    let cl = nth_list(lst, start_idx)?.items();
1359    if cl.len() != 2 {
1360        return Err(raise(
1361            "vla-cond-clause-shape",
1362            &[("n", &cl.len().to_string())],
1363        ));
1364    }
1365    if let Node::Sym(s) = nth(cl, 1)? {
1366        if fold(s) == "else" {
1367            if start_idx != lst.len() {
1368                return Err(raise("vla-cond-else-not-last", &[]));
1369            }
1370            return substitute(nth(cl, 2)?, env, false);
1371        }
1372    }
1373    let t = resolve_listops_arg(nth(cl, 1)?, env)?;
1374    let tf = match &t {
1375        Node::Sym(s) => fold(s),
1376        _ => String::new(),
1377    };
1378    if tf == "true" {
1379        return substitute(nth(cl, 2)?, env, false);
1380    }
1381    if tf == "false" {
1382        return eval_cond_from(lst, start_idx + 1, env);
1383    }
1384    let raw_form = substitute(nth(cl, 2)?, env, false)?;
1385    let rest_form = eval_cond_from(lst, start_idx + 1, env)?;
1386    Ok(Node::list(vec![
1387        Node::sym("if"),
1388        t,
1389        Node::list(vec![Node::sym("then"), raw_form]),
1390        Node::list(vec![Node::sym("else"), rest_form]),
1391    ]))
1392}
1393
1394#[cfg(test)]
1395mod tests {
1396    use super::*;
1397    use crate::reader::read_forms;
1398
1399    const PRELUDE: &str = include_str!("../testdata/prelude.vla");
1400
1401    /// `VlaExpandText(src, True, fired)` under the real prelude, normalised
1402    /// to LF for the pins; the VBA pins compare fragments of this text.
1403    fn expand(src: &str) -> String {
1404        let (text, _) = expand_text(src, PRELUDE, true).unwrap_or_else(|e| panic!("{src}: {e}"));
1405        text.replace("\r\n", "\n")
1406    }
1407
1408    /// The pins' `CheckExpandErr`: the refusal's text holds the fragment.
1409    fn expand_err(src: &str) -> Refusal {
1410        match expand_text(src, PRELUDE, true) {
1411            Ok((text, _)) => panic!("{src} expanded instead of refusing: {text}"),
1412            Err(e) => e,
1413        }
1414    }
1415
1416    fn one(src: &str) -> String {
1417        expand(src).trim_end().to_string()
1418    }
1419
1420    #[test]
1421    fn ordinary_substitution_and_the_rest_parameter() {
1422        assert_eq!(
1423            one("(defmacro (make-adder n) (begin (dim total Long) (set! total (+ total n)))) (make-adder 5)"),
1424            "(begin (dim total Long) (set! total (+ total 5)))"
1425        );
1426        assert_eq!(
1427            one("(defmacro (all & xs) (list-of xs)) (all a b c)"),
1428            "(list-of a b c)"
1429        );
1430        // In element position the rest parameter splices; only a template
1431        // that is the bare name gives the whole list.
1432        assert_eq!(
1433            one("(defmacro (whole & xs) (f xs 1)) (whole a b)"),
1434            "(f a b 1)"
1435        );
1436        assert_eq!(one("(defmacro (bare & xs) xs) (bare a b)"), "(a b)");
1437        // Two template forms become one begin; a docstring is not one.
1438        assert_eq!(
1439            one("(defmacro (two x) \"the doc\" (a x) (b x)) (two 1)"),
1440            "(begin (a 1) (b 1))"
1441        );
1442        assert_eq!(
1443            one("(defmacro (lone) \"just this\") (lone)"),
1444            "\"just this\""
1445        );
1446        // A nested macro call inside a substitution expands too.
1447        assert_eq!(
1448            one("(defmacro (inner x) (set! x 1)) (defmacro (outer y) (inner y)) (outer q)"),
1449            "(set! q 1)"
1450        );
1451        assert_eq!(one("(quote (when unless))"), "(quote (when unless))");
1452    }
1453
1454    #[test]
1455    fn the_prelude_macros_fire_and_the_count_is_reported() {
1456        let (text, fired) = expand_text("(when c a b)", PRELUDE, true).unwrap();
1457        assert_eq!(text.trim_end(), "(if c (then a b))");
1458        assert_eq!(fired, 1);
1459        let (text, fired) = expand_text("(when c a b)", PRELUDE, false).unwrap();
1460        assert_eq!(text.trim_end(), "(if c (then a b))");
1461        assert_eq!(fired, 1);
1462        let (_, fired) = expand_text("(set! x 1)", PRELUDE, true).unwrap();
1463        assert_eq!(fired, 0);
1464    }
1465
1466    #[test]
1467    fn arity_refusals_name_the_macro() {
1468        let r = expand_err("(defmacro (two a b) (f a b)) (two 1)");
1469        assert_eq!(r.id, "vla-macro-arity");
1470        assert_eq!(r.text, "macro 'two' expects 2 argument(s), got 1");
1471        let r = expand_err("(defmacro (atleast a & r) (f a r)) (atleast)");
1472        assert_eq!(r.id, "vla-macro-arity-min");
1473        assert_eq!(
1474            r.text,
1475            "macro 'atleast' expects at least 1 argument(s), got 0"
1476        );
1477        assert_eq!(
1478            expand_err("(defmacro (m a &) a)").id,
1479            "vla-defmacro-rest-param-missing"
1480        );
1481        assert_eq!(
1482            expand_err("(defmacro (m & r x) r)").id,
1483            "vla-defmacro-rest-param-not-last"
1484        );
1485        assert_eq!(
1486            expand_err("(defmacro (m x))").id,
1487            "vla-defmacro-missing-template"
1488        );
1489    }
1490
1491    // TestListops (VLA_Tests.bas), the standalone primitives.
1492    #[test]
1493    fn listops_car_cdr_cddr_cons_list() {
1494        assert_eq!(one("(car (quote (1 2 3)))"), "1");
1495        assert_eq!(one("(cdr (quote (1 2 3)))"), "(2 3)");
1496        assert_eq!(one("(cddr (quote (1 2 3 4)))"), "(3 4)");
1497        assert!(expand_err("(car (quote ()))")
1498            .text
1499            .contains("car: expected a non-empty list"));
1500        assert!(expand_err("(cdr (quote ()))")
1501            .text
1502            .contains("cdr: expected a list of at least 1 element(s), got 0"));
1503        assert!(expand_err("(cddr (quote (1)))")
1504            .text
1505            .contains("cddr: expected a list of at least 2 element(s), got 1"));
1506        assert!(expand_err("(car 5)")
1507            .text
1508            .contains("car: expected a list, got '5'"));
1509        assert!(expand_err("(car (quote (1 2)) (quote (3 4)))")
1510            .text
1511            .contains("car expects exactly 1 argument, got 2"));
1512        assert_eq!(one("(cons 1 (quote (2 3)))"), "(1 2 3)");
1513        assert!(expand_err("(cons 1 2)")
1514            .text
1515            .contains("cons: second argument must be a list, got '2'"));
1516        assert_eq!(one("(list 1 2 3)"), "(1 2 3)");
1517        assert_eq!(one("(list)"), "()");
1518    }
1519
1520    #[test]
1521    fn listops_predicates_and_quote_if() {
1522        assert_eq!(one("(null? (quote ()))"), "true");
1523        assert_eq!(one("(null? (quote (1)))"), "false");
1524        assert_eq!(one("(null? 5)"), "false");
1525        assert_eq!(one("(eq? (quote a) (quote a))"), "true");
1526        assert_eq!(one("(eq? (quote a) (quote b))"), "false");
1527        assert_eq!(one("(eq? (quote A) (quote a))"), "true");
1528        assert_eq!(one("(eq? \"a\" (quote a))"), "false");
1529        assert!(expand_err("(eq? (quote (1)) (quote (1)))")
1530            .text
1531            .contains("eq?: expected an atom, got a list"));
1532        assert_eq!(
1533            one("(equal? (quote (1 2 (3 4))) (quote (1 2 (3 4))))"),
1534            "true"
1535        );
1536        assert_eq!(
1537            one("(equal? (quote (1 2 (3 4))) (quote (1 2 (3 5))))"),
1538            "false"
1539        );
1540        assert_eq!(
1541            one("(quote-if (null? (quote ())) (debug-print \"base\") (car (quote ())))"),
1542            "(debug-print \"base\")"
1543        );
1544        assert_eq!(
1545            one("(quote-if (null? (quote (1))) (car (quote ())) (debug-print \"recurse\"))"),
1546            "(debug-print \"recurse\")"
1547        );
1548        assert!(
1549            expand_err("(quote-if 5 (debug-print \"a\") (debug-print \"b\"))")
1550                .text
1551                .contains("quote-if: test must resolve to true or false")
1552        );
1553        assert!(
1554            expand_err("(quote-if (null? (quote ())) (debug-print \"a\"))")
1555                .text
1556                .contains("quote-if expects exactly 3 arguments")
1557        );
1558        for (word, frag) in [
1559            (
1560                "car",
1561                "'car' is the list-head primitive and cannot be a macro name",
1562            ),
1563            ("cond", "'cond' is the multi-clause conditional"),
1564            ("quote", "'quote' is the data-literal form"),
1565            ("+expand", "'+expand' is the expand-time addition primitive"),
1566        ] {
1567            let r = expand_err(&format!("(defmacro ({word} x) x)"));
1568            assert_eq!(r.id, "vla-defmacro-reserved-name");
1569            assert!(r.text.contains(frag), "{word}: {}", r.text);
1570        }
1571        assert_eq!(
1572            one("(defmacro (first-of xs) (car xs)) (first-of (quote (7 8 9)))"),
1573            "7"
1574        );
1575        assert_eq!(
1576            one("(defmacro (demo xs) (quasiquote (unquote (car xs)))) (demo (quote (1 2 3)))"),
1577            "1"
1578        );
1579    }
1580
1581    #[test]
1582    fn a_self_terminating_walker_emits_one_statement_per_row() {
1583        let walker = "(defmacro (walk-rows lst) (quote-if (null? lst) (begin) (begin (debug-print (car lst)) (walk-rows (cdr lst)))))";
1584        let text = one(&format!("{walker} (walk-rows (quote (10 20 30)))"));
1585        // The trampoline flattens the chain into one begin, as the VBA's
1586        // own pendingHead combine does.
1587        assert_eq!(
1588            text,
1589            "(begin (debug-print 10) (debug-print 20) (debug-print 30) (begin))"
1590        );
1591    }
1592
1593    // TestListopsExpand: the seven arithmetic primitives.
1594    #[test]
1595    fn expand_time_arithmetic() {
1596        assert_eq!(one("(+expand 2 3)"), "5");
1597        assert_eq!(one("(+expand -2 3)"), "1");
1598        assert_eq!(one("(+expand 2.5 1.5)"), "4");
1599        assert_eq!(one("(+expand 0.1 0.2)"), ".3");
1600        assert_eq!(one("(=expand 5 5)"), "true");
1601        assert_eq!(one("(=expand 5 6)"), "false");
1602        assert_eq!(one("(<>expand 5 6)"), "true");
1603        assert_eq!(one("(>expand 5 3)"), "true");
1604        assert_eq!(one("(>expand 3 5)"), "false");
1605        assert_eq!(one("(<expand 3 5)"), "true");
1606        assert_eq!(one("(>=expand 5 5)"), "true");
1607        assert_eq!(one("(<=expand 5 5)"), "true");
1608        assert!(expand_err("(+expand 2 (quote x))")
1609            .text
1610            .contains("+expand: expected a number, got 'x'"));
1611        assert!(expand_err("(>expand (quote (1)) 2)")
1612            .text
1613            .contains(">expand: expected a number, got a list"));
1614        assert!(expand_err("(+expand (quote 1,000) 1)")
1615            .text
1616            .contains("+expand: expected a number, got '1,000'"));
1617        assert!(expand_err("(+expand 2)")
1618            .text
1619            .contains("+expand expects exactly 2 arguments, got 1"));
1620        assert_eq!(
1621            one("(quote-if (>expand 5 3) (debug-print \"yes\") (debug-print \"no\"))"),
1622            "(debug-print \"yes\")"
1623        );
1624        assert_eq!(
1625            one("(defmacro (bigger x) (quote-if (>expand x 10) (quote yes) (quote no))) (bigger 20)"),
1626            "(quote yes)"
1627        );
1628    }
1629
1630    // TestListopsObjectModel (VLA.3), pin for pin.
1631    #[test]
1632    fn the_expand_time_object_model_folds_and_refuses() {
1633        let refused = |src: &str, id: &str, text: &str| {
1634            let e = expand_err(src);
1635            assert_eq!((e.id.as_str(), e.text.as_str()), (id, text), "{src}");
1636        };
1637        // Arithmetic: -expand and *expand as +expand; quotient-expand and
1638        // mod-expand Excel's QUOTIENT and MOD over whole numbers.
1639        assert_eq!(one("(-expand 5 2)"), "3");
1640        assert_eq!(one("(-expand 2 5)"), "-3");
1641        assert_eq!(one("(-expand 2.5 1)"), "1.5");
1642        assert_eq!(one("(*expand 6 7)"), "42");
1643        assert_eq!(one("(*expand 1.5 2)"), "3");
1644        assert_eq!(one("(quotient-expand 7 2)"), "3");
1645        assert_eq!(one("(quotient-expand -7 2)"), "-3");
1646        assert_eq!(one("(mod-expand 7 3)"), "1");
1647        assert_eq!(one("(mod-expand -7 2)"), "1");
1648        assert_eq!(one("(mod-expand 7 -2)"), "-1");
1649        refused(
1650            "(quotient-expand 7.5 2)",
1651            "vla-arith-expand-not-whole",
1652            "quotient-expand: expected a whole number, got '7.5'",
1653        );
1654        refused(
1655            "(mod-expand 7 0)",
1656            "vla-arith-expand-divide-by-zero",
1657            "mod-expand: cannot divide by zero",
1658        );
1659        refused(
1660            "(-expand 1)",
1661            "vla-arith-expand-arity",
1662            "-expand expects exactly 2 arguments, got 1",
1663        );
1664        refused(
1665            "(*expand 2 \"3\")",
1666            "vla-arith-expand-not-number-value",
1667            "*expand: expected a number, got '\"3'",
1668        );
1669        // Text: &expand joins atoms into a string; characters-expand splits.
1670        assert_eq!(one("(&expand \"A\" 1)"), "\"A1\"");
1671        assert_eq!(one("(&expand x)"), "\"x\"");
1672        assert_eq!(
1673            one("(&expand \"=SUM(\" (address-expand 1 2) \":\" (address-expand 9 2) \")\")"),
1674            "\"=SUM(B1:B9)\""
1675        );
1676        refused(
1677            "(&expand)",
1678            "vla-concat-expand-arity",
1679            "&expand expects at least 1 argument, got 0",
1680        );
1681        refused(
1682            "(&expand \"a\" (quote (b)))",
1683            "vla-expand-arg-is-list",
1684            "&expand: argument 2 is a list, expected an atom or string literal",
1685        );
1686        assert_eq!(one("(characters-expand \"ab#\")"), "(\"a\" \"b\" \"#\")");
1687        assert_eq!(one("(characters-expand \"\")"), "()");
1688        assert_eq!(one("(car (cdr (characters-expand \"xyz\")))"), "\"y\"");
1689        assert_eq!(
1690            one("(car (cdr (characters-expand \"a\u{1F600}b\")))"),
1691            "\"\u{1F600}\""
1692        );
1693        assert_eq!(
1694            one("(null? (cdr (cdr (cdr (characters-expand \"a\u{1F600}b\")))))"),
1695            "true"
1696        );
1697        refused(
1698            "(characters-expand (quote (a)))",
1699            "vla-expand-arg-is-list",
1700            "characters-expand: argument 1 is a list, expected an atom or string literal",
1701        );
1702        refused(
1703            "(characters-expand \"a\" \"b\")",
1704            "vla-expand-arity",
1705            "characters-expand expects exactly 1 argument(s), got 2",
1706        );
1707        // Addresses, by one grammar, within Excel's bounds.
1708        assert_eq!(one("(address-expand 3 2)"), "\"B3\"");
1709        assert_eq!(one("(address-expand 1 16384)"), "\"XFD1\"");
1710        assert_eq!(one("(address-expand 1048576 27)"), "\"AA1048576\"");
1711        refused(
1712            "(address-expand 0 1)",
1713            "vla-address-expand-row",
1714            "address-expand: a row is a whole number from 1 to 1048576, got '0'",
1715        );
1716        refused(
1717            "(address-expand 1 16385)",
1718            "vla-address-expand-column",
1719            "address-expand: a column is a whole number from 1 to 16384, got '16385'",
1720        );
1721        refused(
1722            "(address-expand 1.5 1)",
1723            "vla-address-expand-row",
1724            "address-expand: a row is a whole number from 1 to 1048576, got '1.5'",
1725        );
1726        assert_eq!(one("(row-expand \"B3\")"), "3");
1727        assert_eq!(one("(column-expand \"$AA$10\")"), "27");
1728        assert_eq!(one("(column-expand \"xfd1\")"), "16384");
1729        assert_eq!(one("(column-expand \"AA\")"), "27");
1730        for (src, value) in [
1731            ("(row-expand \"AA\")", "AA"),
1732            ("(row-expand \"Sheet1!B3\")", "Sheet1!B3"),
1733            ("(column-expand \"B3:C4\")", "B3:C4"),
1734            ("(row-expand \"B0\")", "B0"),
1735        ] {
1736            let op = &src[1..src.find(' ').unwrap()];
1737            refused(
1738                src,
1739                "vla-address-expand-not-address",
1740                &format!("{op}: expected an address such as B3, got '{value}'"),
1741            );
1742        }
1743        assert_eq!(one("(column-letters-expand 28)"), "\"AB\"");
1744        refused(
1745            "(column-letters-expand 0)",
1746            "vla-address-expand-column",
1747            "column-letters-expand: a column is a whole number from 1 to 16384, got '0'",
1748        );
1749        // Inside a macro's template, the other recognition site.
1750        assert_eq!(
1751            one("(defmacro (below a) (address-expand (+expand (row-expand a) 1) (column-expand a))) (below \"C7\")"),
1752            "\"C8\""
1753        );
1754        assert_eq!(
1755            one(concat!(
1756                "(defmacro (picture r txt) (picture-from r 1 (characters-expand txt))) ",
1757                "(defmacro (picture-from r c m) (quote-if (null? m) (begin) (begin ",
1758                "(quote-if (eq? (car m) \"#\") (cell \"S\" (address-expand r c) 1) (begin)) ",
1759                "(picture-from r (+expand c 1) (cdr m))))) (picture 2 \".#.#\")"
1760            )),
1761            "(begin (begin) (cell \"S\" \"B2\" 1) (begin) (cell \"S\" \"D2\" 1) (begin))"
1762        );
1763        // Reserved: none of the ten can be a macro's name.
1764        for (word, desc) in [
1765            ("-expand", "subtraction"),
1766            ("address-expand", "address"),
1767            ("characters-expand", "text-splitting"),
1768        ] {
1769            refused(
1770                &format!("(defmacro ({word} x) x)"),
1771                "vla-defmacro-reserved-name",
1772                &format!("defmacro '{word}': '{word}' is the expand-time {desc} primitive and cannot be a macro name"),
1773            );
1774        }
1775    }
1776
1777    /// Every name the reference reserves is a primitive both recognition
1778    /// sites know, and the other way round, the quote bundle aside.
1779    #[test]
1780    fn every_listops_name_is_reserved() {
1781        let reserved: Vec<&str> = RESERVED.iter().map(|(w, _)| *w).collect();
1782        let quote_bundle = [
1783            "quote",
1784            "quasiquote",
1785            "unquote",
1786            "unquote-splicing",
1787            "symbol",
1788        ];
1789        for name in LISTOPS {
1790            assert!(
1791                reserved.contains(name),
1792                "{name} is recognised but not reserved"
1793            );
1794        }
1795        for name in reserved {
1796            assert!(
1797                LISTOPS.contains(&name) || quote_bundle.contains(&name),
1798                "{name} is reserved but not recognised"
1799            );
1800        }
1801        assert_eq!(LISTOPS.len(), 27);
1802    }
1803
1804    // TestCond.
1805    #[test]
1806    fn cond_folds_defers_and_refuses() {
1807        assert_eq!(
1808            one("(cond (true (debug-print \"a\")) (false (car (quote ()))))"),
1809            "(debug-print \"a\")"
1810        );
1811        assert_eq!(
1812            one("(cond (false (car (quote ()))) (true (debug-print \"b\")))"),
1813            "(debug-print \"b\")"
1814        );
1815        assert_eq!(
1816            one("(cond ((null? (quote ())) (debug-print \"yes\")) (else (debug-print \"no\")))"),
1817            "(debug-print \"yes\")"
1818        );
1819        assert_eq!(
1820            one("(cond ((null? (quote (1))) (debug-print \"wrong\")) (else (debug-print \"right\")))"),
1821            "(debug-print \"right\")"
1822        );
1823        // A runtime test defers to a native if, the rest in its else.
1824        assert_eq!(
1825            one("(cond ((> x 0) (debug-print \"pos\")) (else (debug-print \"nonpos\")))"),
1826            "(if (> x 0) (then (debug-print \"pos\")) (else (debug-print \"nonpos\")))"
1827        );
1828        assert_eq!(
1829            one("(cond ((> x 0) (debug-print \"pos\")) (true (debug-print \"fallback\")))"),
1830            "(if (> x 0) (then (debug-print \"pos\")) (else (debug-print \"fallback\")))"
1831        );
1832        assert_eq!(one("(cond (false (debug-print \"a\")))"), "(begin)");
1833        assert_eq!(one("(cond)"), "(begin)");
1834        assert!(
1835            expand_err("(cond (else (debug-print \"a\")) (true (debug-print \"b\")))")
1836                .text
1837                .contains("cond: 'else' must be the last clause")
1838        );
1839        assert!(expand_err("(cond ((> 1 0)))")
1840            .text
1841            .contains("cond: each clause must be (test form) or (else form), got 1 element(s)"));
1842        assert_eq!(
1843            one("(defmacro (branch x) (cond ((null? x) (quote empty)) (else (quote nonempty)))) (branch (quote ()))"),
1844            "(quote empty)"
1845        );
1846    }
1847
1848    // TestQuasiquote.
1849    #[test]
1850    fn quasiquote_shields_and_unquote_punches_through() {
1851        assert_eq!(one("(symbol \"make-\" \"bold\")"), "make-bold");
1852        assert_eq!(one("(symbol \"bold\")"), "bold");
1853        assert!(expand_err("(symbol)")
1854            .text
1855            .contains("symbol expects at least 1 argument, got 0"));
1856        assert_eq!(
1857            one("(defmacro (make-getter suffix) (function (symbol \"get-\" suffix) () String (return \"hi\"))) (make-getter widget)"),
1858            "(function get-widget () String (return \"hi\"))"
1859        );
1860        for (word, frag) in [
1861            ("symbol", "'symbol' is the identifier-fusion primitive"),
1862            ("quasiquote", "'quasiquote' is the template-shielding form"),
1863            ("unquote", "'unquote' is the quasiquote escape form"),
1864            (
1865                "unquote-splicing",
1866                "'unquote-splicing' is the quasiquote splice form",
1867            ),
1868        ] {
1869            assert!(expand_err(&format!("(defmacro ({word} x) x)"))
1870                .text
1871                .contains(frag));
1872        }
1873        assert_eq!(
1874            one("(defmacro (demo x) (quasiquote (x (unquote x)))) (demo hello)"),
1875            "(x hello)"
1876        );
1877        assert_eq!(
1878            one("(defmacro (demo & rest) (quasiquote (literal (unquote-splicing rest) end))) (demo a b c)"),
1879            "(literal a b c end)"
1880        );
1881        assert!(expand_err(
1882            "(defmacro (demo x) (quasiquote (a (quasiquote (unquote x))))) (demo hello)"
1883        )
1884        .text
1885        .contains("nested quasiquote is not supported"));
1886        assert!(expand_err("(unquote x)")
1887            .text
1888            .contains("'unquote' only has meaning inside a defmacro's own template"));
1889        assert!(expand_err("(defmacro (demo x) (unquote x)) (demo hello)")
1890            .text
1891            .contains("unquote used outside quasiquote"));
1892        assert!(
1893            expand_err("(defmacro (demo x) (unquote-splicing x)) (demo hello)")
1894                .text
1895                .contains("unquote-splicing used outside quasiquote")
1896        );
1897        assert!(
1898            expand_err("(defmacro (demo x) (quasiquote (unquote-splicing x))) (demo hello)")
1899                .text
1900                .contains("unquote-splicing must appear as a list element, not as a value")
1901        );
1902        assert!(expand_err(
1903            "(defmacro (demo x) (quasiquote (a (unquote-splicing x) b))) (demo hello)"
1904        )
1905        .text
1906        .contains("unquote-splicing: operand did not resolve to a list"));
1907        assert!(
1908            expand_err("(defmacro (demo x) (quasiquote a b)) (demo hello)")
1909                .text
1910                .contains("quasiquote expects exactly 1 argument, got 2")
1911        );
1912        assert!(
1913            expand_err("(defmacro (demo x) (quasiquote (unquote x y))) (demo hello)")
1914                .text
1915                .contains("unquote expects exactly 1 argument, got 2")
1916        );
1917        assert!(expand_err(
1918            "(defmacro (demo x) (quasiquote (a (unquote-splicing x y) b))) (demo hello)"
1919        )
1920        .text
1921        .contains("unquote-splicing expects exactly 1 argument, got 2"));
1922    }
1923
1924    #[test]
1925    fn lines_survive_where_the_vba_keeps_them() {
1926        // A user's argument keeps its line through substitution; the
1927        // template's own lists carry none.
1928        let mut ex = Expander::new();
1929        let defs = read_forms("(defmacro (wrap x) (begin x))").unwrap();
1930        let body = ex.collect(defs).unwrap();
1931        assert!(body.is_empty());
1932        let call = read_forms("\n\n(wrap (f 1))").unwrap().remove(0);
1933        // A one-element begin a macro made is unwrapped by the trampoline;
1934        // the user's own form comes through with its line.
1935        let out = ex.expand(&call, 0).unwrap();
1936        assert_eq!(out, read_forms("(f 1)").unwrap()[0]);
1937        assert_eq!(out.as_list().unwrap().line, 3);
1938        let defs = read_forms("(defmacro (wrap2 x) (begin (g 0) x))").unwrap();
1939        ex.collect(defs).unwrap();
1940        let call = read_forms("\n\n(wrap2 (f 1))").unwrap().remove(0);
1941        let out = ex.expand(&call, 0).unwrap();
1942        let Form::List(l) = &out else { panic!() };
1943        assert_eq!(l.line, 0);
1944        assert_eq!(l.items[1].as_list().unwrap().line, 0);
1945        assert_eq!(l.items[2].as_list().unwrap().line, 3);
1946        // A hand-written begin keeps its line through the rebuild.
1947        let hand = read_forms("\n(begin (f 1) (g 2))").unwrap().remove(0);
1948        let out = ex.expand(&hand, 0).unwrap();
1949        assert_eq!(out.as_list().unwrap().line, 2);
1950    }
1951
1952    #[test]
1953    fn every_golden_form_expands_under_the_prelude() {
1954        // The corpus golden carries its own defmacros at the end; every
1955        // other form expands without a refusal (the compile oracle holds
1956        // the result to the byte in slice 5e).
1957        const GOLDEN: &str = include_str!("../testdata/instructions_golden.vla");
1958        let (text, fired) = expand_text(GOLDEN, PRELUDE, true).unwrap();
1959        assert!(fired > 100, "{fired} applications");
1960        assert!(text.starts_with("(const hot-pink \"#FF69B4\")"));
1961    }
1962
1963    #[test]
1964    fn a_macro_nesting_a_call_past_the_depth_limit_is_refused_by_the_walk() {
1965        // VLA.1, TestFormTooDeep's second pair: a ten-deep macro called
1966        // inside 54 lists expands to exactly 64; inside 55 it would reach
1967        // 65, which the walk refuses though the text is 56 deep. The list
1968        // past the limit is the macro's, so the refusal names no line.
1969        let deep10 = "(defmacro (deep10) (a (a (a (a (a (a (a (a (a (a 1)))))))))))\r\n";
1970        let around = |n: usize| format!("{deep10}{}(deep10){}", "(".repeat(n), ")".repeat(n));
1971        let (_, fired) = expand_text(&around(54), "", true).unwrap();
1972        assert_eq!(fired, 1);
1973        let r = expand_text(&around(55), "", true).unwrap_err();
1974        assert_eq!(r.id, "vla-form-too-deep");
1975        assert_eq!(
1976            r.text,
1977            "lists nested more than 64 deep - no program needs that many"
1978        );
1979        // The one-pass walk holds the same limit over the lists it walks.
1980        let mut ex = Expander::new();
1981        let deep = read_forms(&format!("{}{}", "(".repeat(64), ")".repeat(64))).unwrap();
1982        let wrapped = Form::list(vec![deep[0].clone()]);
1983        assert_eq!(
1984            ex.expand_one_pass(&wrapped).unwrap_err().id,
1985            "vla-form-too-deep"
1986        );
1987        assert_eq!(ex.expand(&wrapped, 0).unwrap_err().id, "vla-form-too-deep");
1988    }
1989
1990    #[test]
1991    fn a_macro_that_deepens_or_doubles_its_argument_is_refused_by_name() {
1992        // VLA.1: each application's result is weighed, so a macro that
1993        // deepens its argument every time is refused once it nests past 64,
1994        // and one that doubles it once one application writes a million
1995        // forms. In the port, which copied arguments until VLA.2, the first
1996        // ran the stack out and the second the memory, before the 5000
1997        // chain limit could stop either; the reference shares arguments,
1998        // builds no copies, and meets the chain limit (TestFormTooDeep's
1999        // last pair). The port shares them now too, and still writes its
2000        // expansion out as a tree, so both stay refused here by name.
2001        let deeper = expand_text("(defmacro (deeper x) (deeper (x))) (deeper 1)", "", true);
2002        assert_eq!(deeper.unwrap_err().id, "vla-form-too-deep");
2003        let dup = expand_text("(defmacro (dup x) (dup (x x))) (dup 1)", "", true).unwrap_err();
2004        assert_eq!(dup.id, "vla-macro-expansion-too-large");
2005        assert_eq!(
2006            dup.text,
2007            "one macro application wrote more than 1,000,000 forms (a macro that doubles its argument?)"
2008        );
2009        // One pass weighs the result of each application it makes too.
2010        let mut ex = Expander::new();
2011        let forms = read_forms("(defmacro (wrap x) (w (w (w x))))").unwrap();
2012        ex.collect(forms).unwrap();
2013        let deep = read_forms(&format!("(wrap {}1{})", "(".repeat(62), ")".repeat(62))).unwrap();
2014        assert_eq!(
2015            ex.expand_one_pass(&deep[0]).unwrap_err().id,
2016            "vla-form-too-deep"
2017        );
2018    }
2019
2020    #[test]
2021    fn a_long_walk_writes_millions_of_forms_but_none_too_many_at_once() {
2022        // VLA.1, found by the owner's run of the reference's scale pins
2023        // (2026-10-10): a walk over a long list writes the rest of the list
2024        // into every application's result, so the results summed grow as
2025        // the square of the list. A budget over the program's sum refused
2026        // the 2,000-row walk TABLESPEC-SCALE expands; the limit is one
2027        // application's result, which a walk keeps to the list's length.
2028        let walker = "(defmacro (walk-rows lst) (quote-if (null? lst) (begin) \
2029                      (begin (debug-print (car lst)) (walk-rows (cdr lst)))))\r\n";
2030        let rows: Vec<String> = (1..=2000).map(|i| i.to_string()).collect();
2031        let program = format!(
2032            "{walker}(sub t () (walk-rows (quote ({}))))",
2033            rows.join(" ")
2034        );
2035        let (text, fired) = expand_text(&program, "", true).unwrap();
2036        assert_eq!(fired, 2001, "one application a row, and the empty end");
2037        assert!(text.contains("(debug-print 2000)"));
2038    }
2039
2040    /// A node's weight found by walking its tree, as `weigh` walked it.
2041    fn walked(n: &Node) -> (u32, u32) {
2042        match n {
2043            Node::List(l) => {
2044                let (mut forms, mut deepest) = (1, 0);
2045                for item in l.items() {
2046                    let (f, d) = walked(item);
2047                    forms += f;
2048                    deepest = deepest.max(d);
2049                }
2050                (forms, deepest + 1)
2051            }
2052            _ => (1, 0),
2053        }
2054    }
2055
2056    #[test]
2057    fn a_list_keeps_the_weight_its_tree_has_and_a_view_its_own() {
2058        // VLA.2: the forms and the depth a list keeps are what a walk of
2059        // its tree finds, for a list as read, every view `cdr` and `cddr`
2060        // make of it from every start, a view of a view, and a list that
2061        // holds views beside the list itself. Every view is of the one run.
2062        for text in [
2063            "(a (b (c (d))) \"s\" (e f) ((g)) h)",
2064            "((((1))) 2 (3 (4 (5 (6)))) () 7)",
2065            "(1 2 3)",
2066            "()",
2067            "(quote (a quote b))",
2068        ] {
2069            let node = Node::of(&read_forms(text).unwrap()[0]);
2070            let Node::List(seq) = &node else { panic!() };
2071            assert_eq!(node.weight(), walked(&node), "{text}");
2072            for n in 1..=seq.count() {
2073                let Node::List(view) = list_tail(seq, n, "cdr").unwrap() else {
2074                    panic!()
2075                };
2076                assert!(Arc::ptr_eq(&view.run, &seq.run), "{text} from {n}");
2077                let once = Node::List(view.clone());
2078                assert_eq!(once.weight(), walked(&once), "{text} from {n}");
2079                for m in 1..=view.count() {
2080                    let twice = Node::List(view.tail(m));
2081                    assert_eq!(twice.weight(), walked(&twice), "{text} from {n}, {m}");
2082                }
2083                let holder = Node::list(vec![once.clone(), node.clone(), once]);
2084                assert_eq!(holder.weight(), walked(&holder), "{text} held from {n}");
2085            }
2086            assert_eq!(
2087                list_tail(seq, seq.count() + 1, "cddr").unwrap_err().id,
2088                "vla-list-too-short"
2089            );
2090        }
2091    }
2092
2093    #[test]
2094    fn a_parameter_s_value_is_the_argument_itself_at_every_use() {
2095        // VLA.2, the reference's `Set Substitute = v`: a value used twice is
2096        // the argument's own list twice, a quoted argument's content is that
2097        // content, and `cdr` of it a view of its items. A list the template
2098        // writes is made anew, untagged.
2099        let mut ex = Expander::new();
2100        ex.collect(read_forms("(defmacro (m x y) (f x x (cdr y) (car y)))").unwrap())
2101            .unwrap();
2102        let call = Node::of(&read_forms("(m (g 1) (quote ((h 2) 3)))").unwrap()[0]);
2103        let Node::List(call) = &call else { panic!() };
2104        let r = expand_one(call.items(), &ex.rules["m"]).unwrap();
2105        let Node::List(r) = &r else { panic!() };
2106        let shared = |n: &Node, with: &Node| match (n, with) {
2107            (Node::List(a), Node::List(b)) => Arc::ptr_eq(&a.run, &b.run),
2108            _ => false,
2109        };
2110        let [_, x, y] = call.items() else { panic!() };
2111        let Node::List(quoted) = y else { panic!() };
2112        let content = &quoted.items()[1];
2113        let Node::List(rows) = content else { panic!() };
2114        let [_, x1, x2, tail, head] = r.items() else {
2115            panic!()
2116        };
2117        assert!(shared(x1, x) && shared(x2, x));
2118        assert!(shared(tail, content));
2119        let Node::List(tail) = tail else { panic!() };
2120        assert_eq!((tail.start, tail.line), (1, 0));
2121        assert!(shared(head, &rows.items()[0]));
2122        assert_eq!(r.line, 0);
2123        assert_eq!(
2124            Node::List(r.clone()).form(),
2125            read_forms("(f (g 1) (g 1) (3) (h 2))").unwrap()[0]
2126        );
2127    }
2128
2129    #[test]
2130    fn a_result_past_a_limit_is_refused_as_the_walk_refused_it() {
2131        // VLA.1's weighing reads a result's two numbers (VLA.2) and walks it
2132        // only past a limit, in the copies' order, so the refusal is the
2133        // walk's: a value doubled refused at its nineteenth doubling, past a
2134        // million forms, a list nested past 64 named at its line, none for a
2135        // list a macro made.
2136        let small = Node::of(&read_forms("(a (b) c)").unwrap()[0]);
2137        assert_eq!(small.weight(), (5, 2));
2138        let ex = Expander::new();
2139        let mut doubled = Node::sym("1");
2140        for k in 1..=19 {
2141            doubled = Node::list(vec![doubled.clone(), doubled.clone()]);
2142            let refused = ex.weigh(&doubled);
2143            assert_eq!(refused.is_err(), k == 19, "{k} doublings");
2144        }
2145        assert_eq!(doubled.weight().0, (1 << 20) - 1);
2146        assert_eq!(
2147            ex.weigh(&doubled).unwrap_err().id,
2148            "vla-macro-expansion-too-large"
2149        );
2150        let mut deep = Node::sym("1");
2151        for k in 1..=65 {
2152            deep = Node::list(vec![deep]);
2153            assert_eq!(ex.weigh(&deep).is_err(), k == 65, "{k} deep");
2154        }
2155        let r = ex.weigh(&deep).unwrap_err();
2156        assert_eq!(r.id, "vla-form-too-deep");
2157        assert_eq!(r.text, too_deep(0).text);
2158        // A count past what a u32 holds saturates and stays saturated in
2159        // every view, so the walk decides.
2160        let mut huge = Node::sym("1");
2161        for _ in 0..40 {
2162            huge = Node::list(vec![huge.clone(), huge.clone(), huge]);
2163        }
2164        let Node::List(seq) = &huge else { panic!() };
2165        assert_eq!(seq.forms, u32::MAX);
2166        assert_eq!(seq.tail(1).forms, u32::MAX);
2167        assert_eq!(
2168            ex.weigh(&huge).unwrap_err().id,
2169            "vla-macro-expansion-too-large"
2170        );
2171    }
2172
2173    #[test]
2174    fn a_quoted_list_and_a_pass_s_arguments_keep_their_lines() {
2175        // VLA.2: a form read into nodes and written out again keeps every
2176        // list's line where the walk does not rebuild it: a quoted list,
2177        // returned as it stands, and a user's argument inside the result of
2178        // one pass. Found by a mutant that wrote every list at line 0.
2179        let mut ex = Expander::new();
2180        ex.collect(read_forms("(defmacro (wrap2 x) (begin (g 0) x))").unwrap())
2181            .unwrap();
2182        let quoted = read_forms("\n\n(quote (a\n(b)))").unwrap().remove(0);
2183        let out = ex.expand(&quoted, 0).unwrap();
2184        let Form::List(q) = &out else { panic!() };
2185        let Form::List(data) = &q.items[1] else {
2186            panic!()
2187        };
2188        let Form::List(b) = &data.items[1] else {
2189            panic!()
2190        };
2191        assert_eq!((q.line, data.line, b.line), (3, 3, 4));
2192        let call = read_forms("\n\n(wrap2\n(f 1))").unwrap().remove(0);
2193        let out = ex.expand_one_pass(&call).unwrap();
2194        let Form::List(r) = &out else { panic!() };
2195        assert_eq!(r.line, 0);
2196        assert_eq!(r.items[2].as_list().unwrap().line, 4);
2197    }
2198
2199    #[test]
2200    fn the_expander_crosses_threads_as_it_did() {
2201        // VLA.2 keeps a macro's template as nodes in the expander; a
2202        // published type's auto traits are part of its interface, so the
2203        // nodes count their references atomically and the expander stays
2204        // Send, Sync and unwind-safe, as `Macro` does.
2205        fn interface<T: Send + Sync + std::panic::UnwindSafe + std::panic::RefUnwindSafe>() {}
2206        interface::<Expander>();
2207        interface::<Macro>();
2208    }
2209}