dazzle_core/scheme/
vm.rs

1//! Stack-based virtual machine for executing bytecode instructions
2//!
3//! This module implements OpenJade's VM execution model:
4//!
5//! ```cpp
6//! ELObj *VM::eval(const Insn *insn, ELObj **display, ELObj *arg) {
7//!     initStack();
8//!     // The inner loop.
9//!     while (insn)
10//!         insn = insn->execute(*this);  // Just a virtual call!
11//!     return *sp;
12//! }
13//! ```
14//!
15//! Key advantages over tree-walking interpreter:
16//! - No recursion - simple while loop
17//! - Stack-based - minimal GC pressure
18//! - Direct dispatch - no pattern matching overhead
19//! - Cache-friendly - tight instruction loop
20
21use crate::scheme::arena::{Arena, ProcedureData, ValueData, ValueId, NIL_ID, TRUE_ID, FALSE_ID};
22use crate::scheme::instruction::Instruction;
23use std::collections::HashMap;
24
25/// Call frame for returns
26#[derive(Debug, Clone)]
27struct Frame {
28    /// Return instruction pointer
29    return_ip: usize,
30    /// Frame pointer (stack base for this call)
31    frame_pointer: usize,
32    /// Environment display (lexical closure)
33    display: Vec<Vec<ValueId>>,
34}
35
36/// Virtual machine state
37pub struct VM<'a> {
38    /// Value stack
39    stack: Vec<ValueId>,
40    /// Call frames
41    frames: Vec<Frame>,
42    /// Arena reference
43    arena: &'a mut Arena,
44    /// Global environment (name -> ValueId)
45    globals: HashMap<String, ValueId>,
46    /// Names of primitive functions (to distinguish from user-defined globals)
47    primitive_names: std::collections::HashSet<String>,
48}
49
50impl<'a> VM<'a> {
51    /// Create a new VM
52    pub fn new(arena: &'a mut Arena) -> Self {
53        VM {
54            stack: Vec::with_capacity(1024),
55            frames: Vec::with_capacity(256),
56            arena,
57            globals: HashMap::new(),
58            primitive_names: std::collections::HashSet::new(),
59        }
60    }
61
62    /// Create a VM with all primitives registered
63    pub fn with_primitives(arena: &'a mut Arena) -> Self {
64        let mut vm = Self::new(arena);
65        vm.register_primitives();
66        vm
67    }
68
69    /// Register all arena-based primitives in the global environment
70    pub fn register_primitives(&mut self) {
71        use crate::scheme::primitives;
72
73        // ===== R4RS List Operations =====
74        self.register_primitive_immut("car", primitives::car);
75        self.register_primitive_immut("cdr", primitives::cdr);
76        self.register_primitive("cons", primitives::cons);
77        self.register_primitive_immut("null?", primitives::null);
78        self.register_primitive("list", primitives::list);
79        self.register_primitive("length", primitives::length);
80        self.register_primitive("reverse", primitives::reverse);
81        self.register_primitive("append", primitives::append);
82        self.register_primitive_immut("list?", primitives::list_p);
83        self.register_primitive_immut("pair?", primitives::pair_p);
84        self.register_primitive_immut("list-ref", primitives::list_ref);
85        self.register_primitive_immut("list-tail", primitives::list_tail);
86
87        // Composite list accessors
88        self.register_primitive_immut("cadr", primitives::cadr);
89        self.register_primitive_immut("caddr", primitives::caddr);
90        self.register_primitive_immut("cadddr", primitives::cadddr);
91        self.register_primitive_immut("caar", primitives::caar);
92        self.register_primitive_immut("cdar", primitives::cdar);
93        self.register_primitive_immut("cddr", primitives::cddr);
94        self.register_primitive_immut("caaar", primitives::caaar);
95        self.register_primitive_immut("caadr", primitives::caadr);
96        self.register_primitive_immut("cadar", primitives::cadar);
97        self.register_primitive_immut("cdaar", primitives::cdaar);
98        self.register_primitive_immut("cdadr", primitives::cdadr);
99        self.register_primitive_immut("cddar", primitives::cddar);
100        self.register_primitive_immut("cdddr", primitives::cdddr);
101
102        // List utilities
103        self.register_primitive_immut("memq", primitives::memq);
104        self.register_primitive_immut("memv", primitives::memv);
105        self.register_primitive_immut("member", primitives::member);
106        self.register_primitive_immut("assq", primitives::assq);
107        self.register_primitive_immut("assv", primitives::assv);
108        self.register_primitive_immut("assoc", primitives::assoc);
109        self.register_primitive_immut("last", primitives::last);
110        self.register_primitive_immut("last-pair", primitives::last_pair);
111
112        // SRFI-1 list operations
113        self.register_primitive("list-copy", primitives::list_copy);
114        self.register_primitive("append!", primitives::append_bang);
115        self.register_primitive("reverse!", primitives::reverse_bang);
116        self.register_primitive("iota", primitives::iota);
117        self.register_primitive("take", primitives::take);
118        self.register_primitive_immut("drop", primitives::drop);
119        self.register_primitive("split-at", primitives::split_at);
120        self.register_primitive_immut("filter", primitives::filter);
121        self.register_primitive_immut("remove", primitives::remove);
122        self.register_primitive_immut("list?", primitives::list_p_improved);
123        self.register_primitive_immut("null-list?", primitives::null_list_p);
124        self.register_primitive_immut("improper-list?", primitives::improper_list_p);
125        self.register_primitive_immut("circular-list?", primitives::circular_list_p);
126
127        // Pair mutations
128        self.register_primitive("set-car!", primitives::set_car);
129        self.register_primitive("set-cdr!", primitives::set_cdr);
130
131        // ===== R4RS Arithmetic =====
132        self.register_primitive("+", primitives::add);
133        self.register_primitive("-", primitives::subtract);
134        self.register_primitive("*", primitives::multiply);
135        self.register_primitive("/", primitives::divide);
136        self.register_primitive("quotient", primitives::quotient);
137        self.register_primitive("remainder", primitives::remainder);
138        self.register_primitive("modulo", primitives::modulo);
139        self.register_primitive("abs", primitives::abs);
140        self.register_primitive("min", primitives::min);
141        self.register_primitive("max", primitives::max);
142        self.register_primitive("gcd", primitives::gcd);
143        self.register_primitive("lcm", primitives::lcm);
144
145        // Numeric comparisons
146        self.register_primitive_immut("=", primitives::num_eq);
147        self.register_primitive_immut("<", primitives::num_lt);
148        self.register_primitive_immut(">", primitives::num_gt);
149        self.register_primitive_immut("<=", primitives::num_le);
150        self.register_primitive_immut(">=", primitives::num_ge);
151
152        // Numeric predicates
153        self.register_primitive_immut("zero?", primitives::zero_p);
154        self.register_primitive_immut("positive?", primitives::positive_p);
155        self.register_primitive_immut("negative?", primitives::negative_p);
156        self.register_primitive_immut("odd?", primitives::odd_p);
157        self.register_primitive_immut("even?", primitives::even_p);
158        self.register_primitive_immut("exact?", primitives::exact_p);
159        self.register_primitive_immut("inexact?", primitives::inexact_p);
160
161        // Math functions
162        self.register_primitive("floor", primitives::floor);
163        self.register_primitive("ceiling", primitives::ceiling);
164        self.register_primitive("truncate", primitives::truncate);
165        self.register_primitive("round", primitives::round);
166        self.register_primitive("sqrt", primitives::sqrt);
167        self.register_primitive("sin", primitives::sin);
168        self.register_primitive("cos", primitives::cos);
169        self.register_primitive("tan", primitives::tan);
170        self.register_primitive("asin", primitives::asin);
171        self.register_primitive("acos", primitives::acos);
172        self.register_primitive("atan", primitives::atan);
173        self.register_primitive("exp", primitives::exp);
174        self.register_primitive("log", primitives::log);
175        self.register_primitive("expt", primitives::expt);
176
177        // Numeric conversions
178        self.register_primitive("exact->inexact", primitives::exact_to_inexact);
179        self.register_primitive("inexact->exact", primitives::inexact_to_exact);
180        self.register_primitive("numerator", primitives::numerator);
181        self.register_primitive("denominator", primitives::denominator);
182        self.register_primitive_immut("rationalize", primitives::rationalize);
183        self.register_primitive("angle", primitives::angle);
184        self.register_primitive("magnitude", primitives::magnitude);
185
186        // ===== R4RS Type Predicates =====
187        self.register_primitive_immut("number?", primitives::number_p);
188        self.register_primitive_immut("integer?", primitives::integer_p);
189        self.register_primitive_immut("real?", primitives::real_p);
190        self.register_primitive_immut("string?", primitives::string_p);
191        self.register_primitive_immut("symbol?", primitives::symbol_p);
192        self.register_primitive_immut("char?", primitives::char_p);
193        self.register_primitive_immut("boolean?", primitives::boolean_p);
194        self.register_primitive_immut("vector?", primitives::vector_p);
195        self.register_primitive_immut("procedure?", primitives::procedure_p);
196
197        // ===== R4RS Comparison =====
198        self.register_primitive_immut("equal?", primitives::equal);
199        self.register_primitive_immut("eqv?", primitives::eqv_p);
200        self.register_primitive_immut("eq?", primitives::eq_p);
201        self.register_primitive_immut("not", primitives::not);
202
203        // ===== R4RS Strings =====
204        self.register_primitive("string-length", primitives::string_length);
205        self.register_primitive("string-ref", primitives::string_ref);
206        self.register_primitive("substring", primitives::substring);
207        self.register_primitive("string-append", primitives::string_append);
208        self.register_primitive_immut("string=?", primitives::string_eq);
209        self.register_primitive_immut("string<?", primitives::string_lt);
210        self.register_primitive_immut("string>?", primitives::string_gt);
211        self.register_primitive_immut("string<=?", primitives::string_le);
212        self.register_primitive_immut("string>=?", primitives::string_ge);
213        self.register_primitive_immut("string-ci=?", primitives::string_ci_eq);
214        self.register_primitive_immut("string-ci<?", primitives::string_ci_lt);
215        self.register_primitive_immut("string-ci>?", primitives::string_ci_gt);
216        self.register_primitive_immut("string-ci<=?", primitives::string_ci_le);
217        self.register_primitive_immut("string-ci>=?", primitives::string_ci_ge);
218        self.register_primitive("string-upcase", primitives::string_upcase);
219        self.register_primitive("string-downcase", primitives::string_downcase);
220        self.register_primitive("case-fold-down", primitives::case_fold_down);
221        self.register_primitive("string-index", primitives::string_index);
222        self.register_primitive("make-string", primitives::make_string);
223        self.register_primitive("string", primitives::string);
224        self.register_primitive("string-set!", primitives::string_set);
225        self.register_primitive("string-copy", primitives::string_copy);
226        self.register_primitive("string-fill!", primitives::string_fill);
227
228        // String conversions
229        self.register_primitive("string->number", primitives::string_to_number);
230        self.register_primitive("number->string", primitives::number_to_string);
231        self.register_primitive("string->list", primitives::string_to_list);
232        self.register_primitive("list->string", primitives::list_to_string);
233        self.register_primitive("string->number", primitives::string_to_number_radix);
234        self.register_primitive("number->string", primitives::number_to_string_radix);
235
236        // ===== R4RS Characters =====
237        self.register_primitive_immut("char=?", primitives::char_eq);
238        self.register_primitive_immut("char<?", primitives::char_lt);
239        self.register_primitive_immut("char>?", primitives::char_gt);
240        self.register_primitive_immut("char<=?", primitives::char_le);
241        self.register_primitive_immut("char>=?", primitives::char_ge);
242        self.register_primitive_immut("char-ci=?", primitives::char_ci_eq);
243        self.register_primitive_immut("char-ci<?", primitives::char_ci_lt);
244        self.register_primitive_immut("char-ci>?", primitives::char_ci_gt);
245        self.register_primitive_immut("char-ci<=?", primitives::char_ci_le);
246        self.register_primitive_immut("char-ci>=?", primitives::char_ci_ge);
247        self.register_primitive("char-upcase", primitives::char_upcase);
248        self.register_primitive("char-downcase", primitives::char_downcase);
249        self.register_primitive_immut("char-alphabetic?", primitives::char_alphabetic_p);
250        self.register_primitive_immut("char-numeric?", primitives::char_numeric_p);
251        self.register_primitive_immut("char-whitespace?", primitives::char_whitespace_p);
252        self.register_primitive_immut("char-lower-case?", primitives::char_lower_case_p);
253        self.register_primitive_immut("char-upper-case?", primitives::char_upper_case_p);
254        self.register_primitive("char->integer", primitives::char_to_integer);
255        self.register_primitive("integer->char", primitives::integer_to_char);
256        self.register_primitive("char-property", primitives::char_property);
257        self.register_primitive("char-script-case", primitives::char_script_case);
258
259        // ===== R4RS Symbols & Keywords =====
260        self.register_primitive("symbol->string", primitives::symbol_to_string);
261        self.register_primitive("string->symbol", primitives::string_to_symbol);
262        self.register_primitive_immut("keyword?", primitives::keyword_p);
263        self.register_primitive("keyword->string", primitives::keyword_to_string);
264        self.register_primitive("string->keyword", primitives::string_to_keyword);
265
266        // ===== R4RS Vectors =====
267        self.register_primitive("vector", primitives::vector);
268        self.register_primitive("make-vector", primitives::make_vector);
269        self.register_primitive("vector-length", primitives::vector_length);
270        self.register_primitive_immut("vector-ref", primitives::vector_ref);
271        self.register_primitive("vector-set!", primitives::vector_set);
272        self.register_primitive("vector->list", primitives::vector_to_list);
273        self.register_primitive("list->vector", primitives::list_to_vector);
274        self.register_primitive("vector-fill!", primitives::vector_fill);
275
276        // ===== Bitwise Operations =====
277        self.register_primitive("bitwise-and", primitives::bitwise_and);
278        self.register_primitive("bitwise-ior", primitives::bitwise_ior);
279        self.register_primitive("bitwise-xor", primitives::bitwise_xor);
280        self.register_primitive("bitwise-not", primitives::bitwise_not);
281        self.register_primitive("arithmetic-shift", primitives::arithmetic_shift);
282        self.register_primitive("bit-extract", primitives::bit_extract);
283        self.register_primitive_immut("bitwise-bit-set?", primitives::bitwise_bit_set_p);
284        self.register_primitive("bitwise-bit-count", primitives::bitwise_bit_count);
285
286        // ===== I/O Operations =====
287        self.register_primitive_immut("display", primitives::display);
288        self.register_primitive_immut("newline", primitives::newline);
289        self.register_primitive_immut("write", primitives::write);
290        self.register_primitive_immut("write-char", primitives::write_char);
291        self.register_primitive_immut("read-char", primitives::read_char);
292        self.register_primitive_immut("eof-object?", primitives::eof_object_p);
293
294        // ===== DSSSL Formatting =====
295        self.register_primitive("format-number", primitives::format_number);
296        self.register_primitive("format-number-list", primitives::format_number_list);
297
298        // ===== DSSSL Sosofo Operations =====
299        self.register_primitive("empty-sosofo", primitives::empty_sosofo);
300        self.register_primitive("sosofo-append", primitives::sosofo_append);
301        self.register_primitive("if-first-page", primitives::if_first_page);
302        self.register_primitive("if-front-page", primitives::if_front_page);
303        self.register_primitive_immut("sosofo?", primitives::sosofo_p);
304
305        // ===== DSSSL Grove Operations =====
306        self.register_primitive("current-node", primitives::current_node);
307        self.register_primitive("gi", primitives::gi);
308        self.register_primitive("data", primitives::data);
309        self.register_primitive("id", primitives::id);
310        self.register_primitive("children", primitives::children);
311        self.register_primitive("parent", primitives::parent);
312        self.register_primitive("attributes", primitives::attributes);
313        self.register_primitive("ancestor", primitives::ancestor);
314        self.register_primitive("ancestors", primitives::ancestors);
315        self.register_primitive("descendants", primitives::descendants);
316        self.register_primitive("follow", primitives::follow);
317        self.register_primitive("preced", primitives::preced);
318        self.register_primitive("ipreced", primitives::ipreced);
319        self.register_primitive("document-element", primitives::document_element);
320
321        // ===== DSSSL Node List Operations =====
322        self.register_primitive_immut("node-list?", primitives::node_list_p);
323        self.register_primitive("empty-node-list", primitives::empty_node_list);
324        self.register_primitive_immut("node-list-empty?", primitives::node_list_empty_p);
325        self.register_primitive("node-list-length", primitives::node_list_length);
326        self.register_primitive("node-list-first", primitives::node_list_first);
327        self.register_primitive("node-list-rest", primitives::node_list_rest);
328        self.register_primitive("node-list-ref", primitives::node_list_ref);
329        self.register_primitive("node-list-last", primitives::node_list_last);
330        self.register_primitive("node-list-reverse", primitives::node_list_reverse);
331        self.register_primitive("node-list-union", primitives::node_list_union);
332        self.register_primitive("node-list-intersection", primitives::node_list_intersection);
333        self.register_primitive("node-list-difference", primitives::node_list_difference);
334        self.register_primitive("node-list-remove-duplicates", primitives::node_list_remove_duplicates);
335        self.register_primitive("node-list->list", primitives::node_list_to_list);
336        self.register_primitive("node-list-contains?", primitives::node_list_contains_p);
337        self.register_primitive("node-list-map", primitives::node_list_map);
338
339        // ===== DSSSL Node Predicates =====
340        self.register_primitive_immut("node?", primitives::node_p);
341        self.register_primitive("first-sibling?", primitives::first_sibling_p);
342        self.register_primitive("last-sibling?", primitives::last_sibling_p);
343        self.register_primitive("absolute-first-sibling?", primitives::absolute_first_sibling_p);
344        self.register_primitive("absolute-last-sibling?", primitives::absolute_last_sibling_p);
345        self.register_primitive("have-ancestor?", primitives::have_ancestor_p);
346        self.register_primitive("match-element?", primitives::match_element_p);
347
348        // ===== DSSSL Node Queries =====
349        self.register_primitive("attribute-string", primitives::attribute_string);
350        self.register_primitive("node-property", primitives::node_property);
351        self.register_primitive("select-elements", primitives::select_elements);
352        self.register_primitive("element-with-id", primitives::element_with_id);
353        self.register_primitive("child-number", primitives::child_number);
354        self.register_primitive("element-number", primitives::element_number);
355        self.register_primitive("hierarchical-number", primitives::hierarchical_number);
356        self.register_primitive("hierarchical-number-recursive", primitives::hierarchical_number_recursive);
357
358        // ===== DSSSL Entity & Notation Operations =====
359        self.register_primitive("entity-system-id", primitives::entity_system_id);
360        self.register_primitive("entity-public-id", primitives::entity_public_id);
361        self.register_primitive("entity-type", primitives::entity_type);
362        self.register_primitive("notation-system-id", primitives::notation_system_id);
363        self.register_primitive("notation-public-id", primitives::notation_public_id);
364
365        // ===== DSSSL Quantity & Color Operations =====
366        self.register_primitive_immut("quantity?", primitives::quantity_p);
367        self.register_primitive_immut("color?", primitives::color_p);
368        self.register_primitive("color", primitives::color);
369        self.register_primitive_immut("display-space?", primitives::display_space_p);
370        self.register_primitive_immut("inline-space?", primitives::inline_space_p);
371        self.register_primitive("quantity->number", primitives::quantity_to_number);
372        self.register_primitive("number->quantity", primitives::number_to_quantity);
373        self.register_primitive("quantity-convert", primitives::quantity_convert);
374        self.register_primitive("device-length", primitives::device_length);
375        self.register_primitive("label-distance", primitives::label_distance);
376        self.register_primitive_immut("address?", primitives::address_p);
377        self.register_primitive_immut("address-local?", primitives::address_local_p);
378        self.register_primitive_immut("address-visited?", primitives::address_visited_p);
379        self.register_primitive_immut("color-space?", primitives::color_space_p);
380        self.register_primitive_immut("color-space", primitives::color_space);
381        self.register_primitive("display-space", primitives::display_space);
382        self.register_primitive("inline-space", primitives::inline_space);
383        self.register_primitive_immut("glyph-id?", primitives::glyph_id_p);
384        self.register_primitive_immut("glyph-id", primitives::glyph_id);
385
386        // ===== DSSSL Utilities =====
387        self.register_primitive_immut("current-language", primitives::current_language);
388        self.register_primitive_immut("current-mode", primitives::current_mode);
389        self.register_primitive_immut("current-node-address", primitives::current_node_address);
390        self.register_primitive("current-node-page-number-sosofo", primitives::current_node_page_number_sosofo);
391        self.register_primitive_immut("debug", primitives::debug);
392        self.register_primitive("error", primitives::error);
393    }
394
395    /// Register a single primitive function (mutable arena)
396    fn register_primitive(
397        &mut self,
398        name: &'static str,
399        func: fn(&mut Arena, &[ValueId]) -> Result<ValueId, String>,
400    ) {
401        let proc = ProcedureData::Primitive { name, func };
402        let proc_id = self.arena.alloc(ValueData::Procedure(proc));
403        self.globals.insert(name.to_string(), proc_id);
404        self.primitive_names.insert(name.to_string());
405    }
406
407    /// Register a primitive function that only needs immutable arena access
408    /// Creates a wrapper that adapts the signature
409    fn register_primitive_immut(
410        &mut self,
411        name: &'static str,
412        immut_func: fn(&Arena, &[ValueId]) -> Result<ValueId, String>,
413    ) {
414        // We need to create a wrapper function because we can't use closures in function pointers
415        // The trick is that &mut Arena can be coerced to &Arena, so this is safe
416        // We use unsafe transmute to convert the function pointer type
417        let wrapper: fn(&mut Arena, &[ValueId]) -> Result<ValueId, String> = unsafe {
418            std::mem::transmute(immut_func)
419        };
420
421        let proc = ProcedureData::Primitive { name, func: wrapper };
422        let proc_id = self.arena.alloc(ValueData::Procedure(proc));
423        self.globals.insert(name.to_string(), proc_id);
424        self.primitive_names.insert(name.to_string());
425    }
426
427    /// Set a global variable
428    pub fn define_global(&mut self, name: String, value_id: ValueId) {
429        self.globals.insert(name, value_id);
430    }
431
432    /// Look up a global variable
433    pub fn lookup_global(&self, name: &str) -> Option<ValueId> {
434        self.globals.get(name).copied()
435    }
436
437    /// Get a clone of all global variables
438    pub fn get_globals(&self) -> HashMap<String, ValueId> {
439        self.globals.clone()
440    }
441
442    /// Set all global variables (replaces existing globals)
443    pub fn set_globals(&mut self, globals: HashMap<String, ValueId>) {
444        self.globals = globals;
445    }
446
447    /// Extend global variables with additional bindings (merges, doesn't replace)
448    pub fn extend_globals(&mut self, additional: HashMap<String, ValueId>) {
449        for (name, value_id) in additional {
450            self.globals.insert(name, value_id);
451        }
452    }
453
454    /// Get only user-defined global variables (excluding primitives)
455    pub fn get_user_globals(&self) -> HashMap<String, ValueId> {
456        self.globals
457            .iter()
458            .filter(|(name, _)| !self.primitive_names.contains(*name))
459            .map(|(name, value_id)| (name.clone(), *value_id))
460            .collect()
461    }
462
463    /// Execute bytecode instructions starting at the given instruction pointer
464    pub fn run(&mut self, instructions: &[Instruction], start_ip: usize) -> Result<ValueId, String> {
465        let mut ip = start_ip;
466
467        // Main execution loop - replaces recursive eval()
468        loop {
469            if ip >= instructions.len() {
470                return Err(format!("Instruction pointer {} out of bounds", ip));
471            }
472
473            match &instructions[ip] {
474                Instruction::Constant { value_id } => {
475                    self.stack.push(*value_id);
476                    ip += 1;
477                }
478
479                Instruction::Variable { depth, offset } => {
480                    // Look up in lexical environment (display)
481                    if let Some(frame) = self.frames.last() {
482                        if *depth < frame.display.len() {
483                            if *offset < frame.display[*depth].len() {
484                                let value_id = frame.display[*depth][*offset];
485                                self.stack.push(value_id);
486                                ip += 1;
487                                continue;
488                            }
489                        }
490                    }
491                    return Err(format!("Variable not found at depth {} offset {}", depth, offset));
492                }
493
494                Instruction::GlobalVariable { name } => {
495                    if let Some(value_id) = self.lookup_global(name) {
496                        self.stack.push(value_id);
497                        ip += 1;
498                    } else {
499                        return Err(format!("Undefined variable: {} (globals: {:?})", name, self.globals.keys().collect::<Vec<_>>()));
500                    }
501                }
502
503                Instruction::Apply { n_args } => {
504                    // Pop procedure and arguments from stack
505                    if self.stack.len() < n_args + 1 {
506                        return Err("Stack underflow in Apply".to_string());
507                    }
508
509                    // Pop procedure first (it's at the top of the stack)
510                    let proc_id = self.stack.pop().unwrap();
511
512                    // Pop arguments (they're now at the top, in reverse order)
513                    let args_start = self.stack.len() - n_args;
514                    let args: Vec<ValueId> = self.stack.drain(args_start..).collect();
515
516                    // Get procedure
517                    let proc_data = self.arena.get(proc_id);
518
519                    match proc_data {
520                        ValueData::Procedure(ProcedureData::Primitive { name: _, func }) => {
521                            // Call primitive
522                            let result = func(self.arena, &args)?;
523                            self.stack.push(result);
524                            ip += 1;
525                        }
526                        ValueData::Procedure(ProcedureData::CompiledLambda {
527                            params,
528                            required_count,
529                            optional_defaults,
530                            body_ip,
531                            env,
532                            ..
533                        }) => {
534                            // Check argument count
535                            if args.len() < *required_count {
536                                return Err(format!(
537                                    "Lambda: expected at least {} arguments, got {}",
538                                    required_count,
539                                    args.len()
540                                ));
541                            }
542
543                            // Build display for lambda call
544                            let mut display = Vec::new();
545
546                            // Current frame: parameters (depth 0)
547                            let mut frame_values = args;
548
549                            // Add optional parameter defaults if needed
550                            for i in frame_values.len()..params.len() {
551                                if i - required_count < optional_defaults.len() {
552                                    frame_values.push(optional_defaults[i - required_count]);
553                                } else {
554                                    frame_values.push(NIL_ID);
555                                }
556                            }
557
558                            display.push(frame_values);
559
560                            // Reconstruct parent environment from captured free variables (depth 1)
561                            if *env != NIL_ID {
562                                let env_data = self.arena.get(*env);
563                                match env_data {
564                                    ValueData::Vector(free_vars) => {
565                                        // Captured environment becomes depth 1
566                                        display.push(free_vars.clone());
567                                    }
568                                    _ => {}
569                                }
570                            }
571
572                            // Push call frame
573                            self.frames.push(Frame {
574                                return_ip: ip + 1,
575                                frame_pointer: self.stack.len(),
576                                display,
577                            });
578
579                            // Jump to lambda body
580                            ip = *body_ip;
581                        }
582                        ValueData::Procedure(ProcedureData::Lambda { .. }) => {
583                            return Err("Interpreted lambda not supported in VM (must be compiled first)".to_string());
584                        }
585                        _ => return Err("Apply: not a procedure".to_string()),
586                    }
587                }
588
589                Instruction::Test { else_ip } => {
590                    let test_id = self.stack.pop().ok_or("Stack underflow in Test")?;
591                    let test_data = self.arena.get(test_id);
592
593                    // #f is false, everything else is true
594                    if matches!(test_data, ValueData::Bool(false)) {
595                        ip = *else_ip;
596                    } else {
597                        ip += 1;
598                    }
599                }
600
601                Instruction::Jump { target_ip } => {
602                    ip = *target_ip;
603                }
604
605                Instruction::MakeClosure {
606                    params,
607                    required_count,
608                    body_ip,
609                    n_free,
610                } => {
611                    // Pop free variables from stack and store in closure's environment
612                    let mut free_vars = Vec::new();
613                    for _ in 0..*n_free {
614                        if let Some(var_id) = self.stack.pop() {
615                            free_vars.push(var_id);
616                        } else {
617                            return Err("Stack underflow in MakeClosure".to_string());
618                        }
619                    }
620                    // Reverse because we popped in reverse order
621                    free_vars.reverse();
622
623                    // Store captured environment as a vector
624                    let env_id = if free_vars.is_empty() {
625                        NIL_ID
626                    } else {
627                        self.arena.vector(free_vars)
628                    };
629
630                    let lambda = ProcedureData::CompiledLambda {
631                        params: params.clone(),
632                        required_count: *required_count,
633                        optional_defaults: vec![],
634                        body_ip: *body_ip,
635                        env: env_id,
636                        source: None,
637                        name: None,
638                    };
639
640                    let closure_id = self.arena.alloc(ValueData::Procedure(lambda));
641                    self.stack.push(closure_id);
642                    ip += 1;
643                }
644
645                Instruction::Return => {
646                    // Pop return value
647                    let result_id = self.stack.pop().ok_or("Stack underflow in Return")?;
648
649                    // Pop call frame
650                    if let Some(frame) = self.frames.pop() {
651                        // Restore stack
652                        self.stack.truncate(frame.frame_pointer);
653                        self.stack.push(result_id);
654                        ip = frame.return_ip;
655                    } else {
656                        // Top-level return
657                        return Ok(result_id);
658                    }
659                }
660
661                // Inline primitive operations
662                Instruction::Cons => {
663                    let cdr_id = self.stack.pop().ok_or("Stack underflow in Cons")?;
664                    let car_id = self.stack.pop().ok_or("Stack underflow in Cons")?;
665                    let pair_id = self.arena.cons(car_id, cdr_id);
666                    self.stack.push(pair_id);
667                    ip += 1;
668                }
669
670                Instruction::Car => {
671                    let pair_id = self.stack.pop().ok_or("Stack underflow in Car")?;
672                    let pair_data = self.arena.get(pair_id);
673                    match pair_data {
674                        ValueData::Pair { car, .. } => {
675                            self.stack.push(*car);
676                            ip += 1;
677                        }
678                        _ => return Err("car: not a pair".to_string()),
679                    }
680                }
681
682                Instruction::Cdr => {
683                    let pair_id = self.stack.pop().ok_or("Stack underflow in Cdr")?;
684                    let pair_data = self.arena.get(pair_id);
685                    match pair_data {
686                        ValueData::Pair { cdr, .. } => {
687                            self.stack.push(*cdr);
688                            ip += 1;
689                        }
690                        _ => return Err("cdr: not a pair".to_string()),
691                    }
692                }
693
694                Instruction::IsNull => {
695                    let value_id = self.stack.pop().ok_or("Stack underflow in IsNull")?;
696                    let value_data = self.arena.get(value_id);
697                    let result = matches!(value_data, ValueData::Nil);
698                    self.stack.push(if result { TRUE_ID } else { FALSE_ID });
699                    ip += 1;
700                }
701
702                Instruction::Add => {
703                    let b_id = self.stack.pop().ok_or("Stack underflow in Add")?;
704                    let a_id = self.stack.pop().ok_or("Stack underflow in Add")?;
705                    let a = self.arena.get(a_id);
706                    let b = self.arena.get(b_id);
707
708                    let result = match (a, b) {
709                        (ValueData::Integer(x), ValueData::Integer(y)) => {
710                            self.arena.int(x + y)
711                        }
712                        (ValueData::Real(x), ValueData::Real(y)) => {
713                            self.arena.real(x + y)
714                        }
715                        (ValueData::Integer(x), ValueData::Real(y)) => {
716                            self.arena.real(*x as f64 + y)
717                        }
718                        (ValueData::Real(x), ValueData::Integer(y)) => {
719                            self.arena.real(x + *y as f64)
720                        }
721                        _ => return Err("+: expected numbers".to_string()),
722                    };
723                    self.stack.push(result);
724                    ip += 1;
725                }
726
727                Instruction::Subtract => {
728                    let b_id = self.stack.pop().ok_or("Stack underflow in Subtract")?;
729                    let a_id = self.stack.pop().ok_or("Stack underflow in Subtract")?;
730                    let a = self.arena.get(a_id);
731                    let b = self.arena.get(b_id);
732
733                    let result = match (a, b) {
734                        (ValueData::Integer(x), ValueData::Integer(y)) => {
735                            self.arena.int(x - y)
736                        }
737                        (ValueData::Real(x), ValueData::Real(y)) => {
738                            self.arena.real(x - y)
739                        }
740                        (ValueData::Integer(x), ValueData::Real(y)) => {
741                            self.arena.real(*x as f64 - y)
742                        }
743                        (ValueData::Real(x), ValueData::Integer(y)) => {
744                            self.arena.real(x - *y as f64)
745                        }
746                        _ => return Err("-: expected numbers".to_string()),
747                    };
748                    self.stack.push(result);
749                    ip += 1;
750                }
751
752                Instruction::Multiply => {
753                    let b_id = self.stack.pop().ok_or("Stack underflow in Multiply")?;
754                    let a_id = self.stack.pop().ok_or("Stack underflow in Multiply")?;
755                    let a = self.arena.get(a_id);
756                    let b = self.arena.get(b_id);
757
758                    let result = match (a, b) {
759                        (ValueData::Integer(x), ValueData::Integer(y)) => {
760                            self.arena.int(x * y)
761                        }
762                        (ValueData::Real(x), ValueData::Real(y)) => {
763                            self.arena.real(x * y)
764                        }
765                        (ValueData::Integer(x), ValueData::Real(y)) => {
766                            self.arena.real(*x as f64 * y)
767                        }
768                        (ValueData::Real(x), ValueData::Integer(y)) => {
769                            self.arena.real(x * *y as f64)
770                        }
771                        _ => return Err("*: expected numbers".to_string()),
772                    };
773                    self.stack.push(result);
774                    ip += 1;
775                }
776
777                Instruction::Divide => {
778                    let b_id = self.stack.pop().ok_or("Stack underflow in Divide")?;
779                    let a_id = self.stack.pop().ok_or("Stack underflow in Divide")?;
780                    let a = self.arena.get(a_id);
781                    let b = self.arena.get(b_id);
782
783                    let result = match (a, b) {
784                        (ValueData::Integer(x), ValueData::Integer(y)) => {
785                            if *y == 0 {
786                                return Err("/: division by zero".to_string());
787                            }
788                            self.arena.int(x / y)
789                        }
790                        (ValueData::Real(x), ValueData::Real(y)) => {
791                            if *y == 0.0 {
792                                return Err("/: division by zero".to_string());
793                            }
794                            self.arena.real(x / y)
795                        }
796                        (ValueData::Integer(x), ValueData::Real(y)) => {
797                            if *y == 0.0 {
798                                return Err("/: division by zero".to_string());
799                            }
800                            self.arena.real(*x as f64 / y)
801                        }
802                        (ValueData::Real(x), ValueData::Integer(y)) => {
803                            if *y == 0 {
804                                return Err("/: division by zero".to_string());
805                            }
806                            self.arena.real(x / *y as f64)
807                        }
808                        _ => return Err("/: expected numbers".to_string()),
809                    };
810                    self.stack.push(result);
811                    ip += 1;
812                }
813
814                Instruction::Equal => {
815                    let b_id = self.stack.pop().ok_or("Stack underflow in Equal")?;
816                    let a_id = self.stack.pop().ok_or("Stack underflow in Equal")?;
817                    let result = self.values_equal(a_id, b_id);
818                    self.stack.push(if result { TRUE_ID } else { FALSE_ID });
819                    ip += 1;
820                }
821
822                Instruction::NumLt => {
823                    let b_id = self.stack.pop().ok_or("Stack underflow in NumLt")?;
824                    let a_id = self.stack.pop().ok_or("Stack underflow in NumLt")?;
825                    let a = self.arena.get(a_id);
826                    let b = self.arena.get(b_id);
827
828                    let result = match (a, b) {
829                        (ValueData::Integer(x), ValueData::Integer(y)) => x < y,
830                        (ValueData::Real(x), ValueData::Real(y)) => x < y,
831                        (ValueData::Integer(x), ValueData::Real(y)) => (*x as f64) < *y,
832                        (ValueData::Real(x), ValueData::Integer(y)) => *x < (*y as f64),
833                        _ => return Err("<: expected numbers".to_string()),
834                    };
835                    self.stack.push(if result { TRUE_ID } else { FALSE_ID });
836                    ip += 1;
837                }
838
839                Instruction::NumGt => {
840                    let b_id = self.stack.pop().ok_or("Stack underflow in NumGt")?;
841                    let a_id = self.stack.pop().ok_or("Stack underflow in NumGt")?;
842                    let a = self.arena.get(a_id);
843                    let b = self.arena.get(b_id);
844
845                    let result = match (a, b) {
846                        (ValueData::Integer(x), ValueData::Integer(y)) => x > y,
847                        (ValueData::Real(x), ValueData::Real(y)) => x > y,
848                        (ValueData::Integer(x), ValueData::Real(y)) => (*x as f64) > *y,
849                        (ValueData::Real(x), ValueData::Integer(y)) => *x > (*y as f64),
850                        _ => return Err(">: expected numbers".to_string()),
851                    };
852                    self.stack.push(if result { TRUE_ID } else { FALSE_ID });
853                    ip += 1;
854                }
855
856                Instruction::MakeList { n } => {
857                    if self.stack.len() < *n {
858                        return Err("Stack underflow in MakeList".to_string());
859                    }
860
861                    let start = self.stack.len() - n;
862                    let items: Vec<ValueId> = self.stack.drain(start..).collect();
863
864                    let mut list_id = NIL_ID;
865                    for &item_id in items.iter().rev() {
866                        list_id = self.arena.cons(item_id, list_id);
867                    }
868
869                    self.stack.push(list_id);
870                    ip += 1;
871                }
872
873                Instruction::Pop => {
874                    self.stack.pop().ok_or("Stack underflow in Pop")?;
875                    ip += 1;
876                }
877
878                Instruction::Dup => {
879                    let value_id = self.stack.last().copied().ok_or("Stack underflow in Dup")?;
880                    self.stack.push(value_id);
881                    ip += 1;
882                }
883
884                Instruction::SetVariable { depth, offset } => {
885                    // Pop value from stack
886                    let value_id = self.stack.pop().ok_or("Stack underflow in SetVariable")?;
887
888                    // Set in lexical environment (display)
889                    if let Some(frame) = self.frames.last_mut() {
890                        if *depth < frame.display.len() {
891                            if *offset < frame.display[*depth].len() {
892                                frame.display[*depth][*offset] = value_id;
893                                self.stack.push(value_id); // set! returns the value
894                                ip += 1;
895                                continue;
896                            }
897                        }
898                    }
899                    return Err(format!("set!: variable not found at depth {} offset {}", depth, offset));
900                }
901
902                Instruction::SetGlobalVariable { name } => {
903                    // Pop value from stack
904                    let value_id = self.stack.pop().ok_or("Stack underflow in SetGlobalVariable")?;
905
906                    // Check if global exists
907                    if self.globals.contains_key(name) {
908                        self.globals.insert(name.clone(), value_id);
909                        self.stack.push(value_id); // set! returns the value
910                        ip += 1;
911                    } else {
912                        return Err(format!("set!: undefined variable: {}", name));
913                    }
914                }
915
916                Instruction::DefineGlobal { name } => {
917                    // Pop value from stack
918                    let value_id = self.stack.pop().ok_or("Stack underflow in DefineGlobal")?;
919
920                    // Debug: Log % variable definitions (DSSSL parameters)
921                    if std::env::var("DAZZLE_DEBUG").is_ok() && name.starts_with('%') {
922                        eprintln!("VM: Defining {} = {:?}", name, self.arena.get(value_id));
923                    }
924
925                    // Define (or redefine) global
926                    self.globals.insert(name.clone(), value_id);
927
928                    // define returns unspecified
929                    use crate::scheme::arena::UNSPECIFIED_ID;
930                    self.stack.push(UNSPECIFIED_ID);
931                    ip += 1;
932                }
933            }
934        }
935    }
936
937    /// Check if two values are equal (deep structural equality)
938    fn values_equal(&self, a_id: ValueId, b_id: ValueId) -> bool {
939        let a = self.arena.get(a_id);
940        let b = self.arena.get(b_id);
941
942        match (a, b) {
943            (ValueData::Nil, ValueData::Nil) => true,
944            (ValueData::Bool(x), ValueData::Bool(y)) => x == y,
945            (ValueData::Integer(x), ValueData::Integer(y)) => x == y,
946            (ValueData::Real(x), ValueData::Real(y)) => (x - y).abs() < f64::EPSILON,
947            (ValueData::Char(x), ValueData::Char(y)) => x == y,
948            (ValueData::String(x), ValueData::String(y)) => x == y,
949            (ValueData::Symbol(x), ValueData::Symbol(y)) => x == y,
950            (ValueData::Pair { car: car1, cdr: cdr1, .. }, ValueData::Pair { car: car2, cdr: cdr2, .. }) => {
951                self.values_equal(*car1, *car2) && self.values_equal(*cdr1, *cdr2)
952            }
953            _ => false,
954        }
955    }
956}
957
958#[cfg(test)]
959mod tests {
960    use super::*;
961    use crate::scheme::compiler::Compiler;
962    use crate::scheme::instruction::Program;
963    use std::rc::Rc;
964
965    #[test]
966    fn test_vm_constant() {
967        let mut arena = Arena::new();
968        let value_id = arena.int(42);
969
970        let mut program = Program::new();
971        program.emit(Instruction::Constant { value_id });
972        program.emit(Instruction::Return);
973
974        let mut vm = VM::new(&mut arena);
975        let result_id = vm.run(&program.instructions, 0).unwrap();
976        let result = arena.get(result_id);
977
978        assert!(matches!(result, ValueData::Integer(42)));
979    }
980
981    #[test]
982    fn test_vm_arithmetic() {
983        let mut arena = Arena::new();
984
985        let mut program = Program::new();
986
987        // Compute (+ 2 3)
988        let a_id = arena.int(2);
989        let b_id = arena.int(3);
990
991        program.emit(Instruction::Constant { value_id: a_id });
992        program.emit(Instruction::Constant { value_id: b_id });
993        program.emit(Instruction::Add);
994        program.emit(Instruction::Return);
995
996        let mut vm = VM::new(&mut arena);
997        let result_id = vm.run(&program.instructions, 0).unwrap();
998        let result = arena.get(result_id);
999
1000        assert!(matches!(result, ValueData::Integer(5)));
1001    }
1002
1003    #[test]
1004    fn test_vm_list_ops() {
1005        let mut arena = Arena::new();
1006
1007        let mut program = Program::new();
1008
1009        // Build (cons 1 2)
1010        let a_id = arena.int(1);
1011        let b_id = arena.int(2);
1012
1013        program.emit(Instruction::Constant { value_id: a_id });
1014        program.emit(Instruction::Constant { value_id: b_id });
1015        program.emit(Instruction::Cons);
1016        program.emit(Instruction::Car); // Get car of the pair
1017        program.emit(Instruction::Return);
1018
1019        let mut vm = VM::new(&mut arena);
1020        let result_id = vm.run(&program.instructions, 0).unwrap();
1021        let result = arena.get(result_id);
1022
1023        assert!(matches!(result, ValueData::Integer(1)));
1024    }
1025
1026    #[test]
1027    fn test_vm_with_primitive_call() {
1028        // Create arena and program separately
1029        let mut arena = Arena::new();
1030        let mut program = Program::new();
1031
1032        // Build expression: (+ 10 32)
1033        let ten = arena.int(10);
1034        let thirty_two = arena.int(32);
1035        let arg_list = arena.cons(thirty_two, NIL_ID);
1036        let args = arena.cons(ten, arg_list);
1037        let plus = arena.symbol(Rc::from("+"));
1038        let expr = arena.cons(plus, args);
1039
1040        // Compile the expression
1041        let mut compiler = Compiler::new(&arena);
1042        let start_ip = compiler.compile(expr).unwrap();
1043
1044        // Get the compiled instructions
1045        let compiled_program = compiler.into_program();
1046        program.instructions = compiled_program.instructions;
1047        program.emit(Instruction::Return);  // Top-level return
1048
1049        // Run with primitives registered
1050        let mut vm = VM::with_primitives(&mut arena);
1051        let result_id = vm.run(&program.instructions, start_ip).unwrap();
1052        let result = arena.get(result_id);
1053
1054        assert!(matches!(result, ValueData::Integer(42)));
1055    }
1056
1057    #[test]
1058    fn test_compile_and_run_if() {
1059        // Create arena and program separately
1060        let mut arena = Arena::new();
1061        let mut program = Program::new();
1062
1063        // Build: (if #t 100 200)
1064        let test = TRUE_ID;
1065        let consequent = arena.int(100);
1066        let alternative = arena.int(200);
1067
1068        // Build list step by step to avoid multiple mutable borrows
1069        let alt_list = arena.cons(alternative, NIL_ID);
1070        let cons_list = arena.cons(consequent, alt_list);
1071        let args = arena.cons(test, cons_list);
1072        let if_sym = arena.symbol(Rc::from("if"));
1073        let expr = arena.cons(if_sym, args);
1074
1075        // Compile
1076        let mut compiler = Compiler::new(&arena);
1077        let start_ip = compiler.compile(expr).unwrap();
1078        let compiled_program = compiler.into_program();
1079        program.instructions = compiled_program.instructions;
1080        program.emit(Instruction::Return);  // Top-level return
1081
1082        // Run
1083        let mut vm = VM::new(&mut arena);
1084        let result_id = vm.run(&program.instructions, start_ip).unwrap();
1085        let result = arena.get(result_id);
1086
1087        assert!(matches!(result, ValueData::Integer(100)));
1088    }
1089
1090    #[test]
1091    fn test_vm_let() {
1092        // Test: (let ((x 10) (y 20)) (+ x y))
1093        let mut arena = Arena::new();
1094        let mut program = Program::new();
1095
1096        let x_sym = arena.symbol(Rc::from("x"));
1097        let y_sym = arena.symbol(Rc::from("y"));
1098        let plus_sym = arena.symbol(Rc::from("+"));
1099        let ten = arena.int(10);
1100        let twenty = arena.int(20);
1101
1102        // Build binding (x 10)
1103        let x_val_list = arena.cons(ten, NIL_ID);
1104        let x_binding = arena.cons(x_sym, x_val_list);
1105
1106        // Build binding (y 20)
1107        let y_val_list = arena.cons(twenty, NIL_ID);
1108        let y_binding = arena.cons(y_sym, y_val_list);
1109
1110        // Build bindings list ((x 10) (y 20))
1111        let y_binding_list = arena.cons(y_binding, NIL_ID);
1112        let bindings = arena.cons(x_binding, y_binding_list);
1113
1114        // Build body (+ x y)
1115        let y_list = arena.cons(y_sym, NIL_ID);
1116        let x_list = arena.cons(x_sym, y_list);
1117        let body = arena.cons(plus_sym, x_list);
1118
1119        // Build let form
1120        let body_list = arena.cons(body, NIL_ID);
1121        let args = arena.cons(bindings, body_list);
1122        let let_sym = arena.symbol(Rc::from("let"));
1123        let expr = arena.cons(let_sym, args);
1124
1125        // Compile
1126        let mut compiler = Compiler::new(&arena);
1127        let start_ip = compiler.compile(expr).unwrap();
1128        let compiled_program = compiler.into_program();
1129        program.instructions = compiled_program.instructions;
1130        program.emit(Instruction::Return);
1131
1132        // Run with primitives
1133        let mut vm = VM::with_primitives(&mut arena);
1134        let result_id = vm.run(&program.instructions, start_ip).unwrap();
1135        let result = arena.get(result_id);
1136
1137        assert!(matches!(result, ValueData::Integer(30)));
1138    }
1139
1140    #[test]
1141    fn test_vm_let_star() {
1142        // Test: (let* ((x 10) (y (+ x 5))) y)
1143        // Should return 15 (y can reference x)
1144        let mut arena = Arena::new();
1145        let mut program = Program::new();
1146
1147        let x_sym = arena.symbol(Rc::from("x"));
1148        let y_sym = arena.symbol(Rc::from("y"));
1149        let plus_sym = arena.symbol(Rc::from("+"));
1150        let ten = arena.int(10);
1151        let five = arena.int(5);
1152
1153        // Build binding (x 10)
1154        let x_val_list = arena.cons(ten, NIL_ID);
1155        let x_binding = arena.cons(x_sym, x_val_list);
1156
1157        // Build (+ x 5)
1158        let five_list = arena.cons(five, NIL_ID);
1159        let x_plus_list = arena.cons(x_sym, five_list);
1160        let y_val = arena.cons(plus_sym, x_plus_list);
1161
1162        // Build binding (y (+ x 5))
1163        let y_val_list = arena.cons(y_val, NIL_ID);
1164        let y_binding = arena.cons(y_sym, y_val_list);
1165
1166        // Build bindings list ((x 10) (y (+ x 5)))
1167        let y_binding_list = arena.cons(y_binding, NIL_ID);
1168        let bindings = arena.cons(x_binding, y_binding_list);
1169
1170        // Build body (just y)
1171        let body_list = arena.cons(y_sym, NIL_ID);
1172
1173        // Build let* form
1174        let args = arena.cons(bindings, body_list);
1175        let let_star_sym = arena.symbol(Rc::from("let*"));
1176        let expr = arena.cons(let_star_sym, args);
1177
1178        // Compile
1179        let mut compiler = Compiler::new(&arena);
1180        let start_ip = compiler.compile(expr).unwrap();
1181        let compiled_program = compiler.into_program();
1182        program.instructions = compiled_program.instructions;
1183        program.emit(Instruction::Return);
1184
1185        // Run with primitives
1186        let mut vm = VM::with_primitives(&mut arena);
1187        let result_id = vm.run(&program.instructions, start_ip).unwrap();
1188        let result = arena.get(result_id);
1189
1190        assert!(matches!(result, ValueData::Integer(15)));
1191    }
1192
1193    #[test]
1194    fn test_vm_cond() {
1195        // Test: (cond (#f 1) (#t 42) (else 99))
1196        // Should return 42
1197        let mut arena = Arena::new();
1198        let mut program = Program::new();
1199
1200        let one = arena.int(1);
1201        let forty_two = arena.int(42);
1202        let ninety_nine = arena.int(99);
1203
1204        // Build clause (#f 1)
1205        let clause1_body = arena.cons(one, NIL_ID);
1206        let clause1 = arena.cons(FALSE_ID, clause1_body);
1207
1208        // Build clause (#t 42)
1209        let clause2_body = arena.cons(forty_two, NIL_ID);
1210        let clause2 = arena.cons(TRUE_ID, clause2_body);
1211
1212        // Build clause (else 99)
1213        let else_sym = arena.symbol(Rc::from("else"));
1214        let clause3_body = arena.cons(ninety_nine, NIL_ID);
1215        let clause3 = arena.cons(else_sym, clause3_body);
1216
1217        // Build clauses list
1218        let clause3_list = arena.cons(clause3, NIL_ID);
1219        let clause2_list = arena.cons(clause2, clause3_list);
1220        let clauses = arena.cons(clause1, clause2_list);
1221
1222        // Build cond form
1223        let cond_sym = arena.symbol(Rc::from("cond"));
1224        let expr = arena.cons(cond_sym, clauses);
1225
1226        // Compile
1227        let mut compiler = Compiler::new(&arena);
1228        let start_ip = compiler.compile(expr).unwrap();
1229        let compiled_program = compiler.into_program();
1230        program.instructions = compiled_program.instructions;
1231        program.emit(Instruction::Return);
1232
1233        // Run
1234        let mut vm = VM::new(&mut arena);
1235        let result_id = vm.run(&program.instructions, start_ip).unwrap();
1236        let result = arena.get(result_id);
1237
1238        assert!(matches!(result, ValueData::Integer(42)));
1239    }
1240
1241    #[test]
1242    fn test_vm_define_and_call() {
1243        // Test: (define x 42) x
1244        // Should return 42
1245        let mut arena = Arena::new();
1246        let mut program = Program::new();
1247
1248        let x_sym = arena.symbol(Rc::from("x"));
1249        let forty_two = arena.int(42);
1250
1251        // Build (define x 42)
1252        let val_list = arena.cons(forty_two, NIL_ID);
1253        let define_args = arena.cons(x_sym, val_list);
1254        let define_sym = arena.symbol(Rc::from("define"));
1255        let define_expr = arena.cons(define_sym, define_args);
1256
1257        // Compile define
1258        let mut compiler = Compiler::new(&arena);
1259        let start_ip = compiler.compile(define_expr).unwrap();
1260        let compiled_program = compiler.into_program();
1261        program.instructions = compiled_program.instructions;
1262
1263        // Now compile reference to x
1264        let mut compiler2 = Compiler::new(&arena);
1265        compiler2.compile(x_sym).unwrap();
1266        let compiled_program2 = compiler2.into_program();
1267        program.instructions.extend(compiled_program2.instructions);
1268        program.emit(Instruction::Return);
1269
1270        // Run
1271        let mut vm = VM::new(&mut arena);
1272        let result_id = vm.run(&program.instructions, start_ip).unwrap();
1273        let result = arena.get(result_id);
1274
1275        assert!(matches!(result, ValueData::Integer(42)));
1276    }
1277
1278    #[test]
1279    fn test_vm_lambda_call() {
1280        // Test: ((lambda (x y) (+ x y)) 10 20)
1281        // Should return 30
1282        let mut arena = Arena::new();
1283        let mut program = Program::new();
1284
1285        let x_sym = arena.symbol(Rc::from("x"));
1286        let y_sym = arena.symbol(Rc::from("y"));
1287        let plus_sym = arena.symbol(Rc::from("+"));
1288        let ten = arena.int(10);
1289        let twenty = arena.int(20);
1290
1291        // Build parameter list (x y)
1292        let y_param_list = arena.cons(y_sym, NIL_ID);
1293        let params = arena.cons(x_sym, y_param_list);
1294
1295        // Build body (+ x y)
1296        let y_arg_list = arena.cons(y_sym, NIL_ID);
1297        let x_arg_list = arena.cons(x_sym, y_arg_list);
1298        let body = arena.cons(plus_sym, x_arg_list);
1299
1300        // Build lambda (lambda (x y) (+ x y))
1301        let body_list = arena.cons(body, NIL_ID);
1302        let lambda_args = arena.cons(params, body_list);
1303        let lambda_sym = arena.symbol(Rc::from("lambda"));
1304        let lambda_expr = arena.cons(lambda_sym, lambda_args);
1305
1306        // Build arguments (10 20)
1307        let twenty_list = arena.cons(twenty, NIL_ID);
1308        let args = arena.cons(ten, twenty_list);
1309
1310        // Build application ((lambda ...) 10 20)
1311        let app_args = arena.cons(lambda_expr, args);
1312        let expr = app_args;
1313
1314        // Compile
1315        let mut compiler = Compiler::new(&arena);
1316        let start_ip = compiler.compile(expr).unwrap();
1317        let compiled_program = compiler.into_program();
1318        program.instructions = compiled_program.instructions;
1319        program.emit(Instruction::Return);
1320
1321        // Run with primitives
1322        let mut vm = VM::with_primitives(&mut arena);
1323        let result_id = vm.run(&program.instructions, start_ip).unwrap();
1324        let result = arena.get(result_id);
1325
1326        assert!(matches!(result, ValueData::Integer(30)));
1327    }
1328
1329    #[test]
1330    fn test_vm_closure_capture() {
1331        // Test: ((lambda (x) (lambda (y) (+ x y))) 10)
1332        // Returns a closure that captures x=10
1333        // Then call it with 20 to get 30
1334        let mut arena = Arena::new();
1335        let mut program = Program::new();
1336
1337        let x_sym = arena.symbol(Rc::from("x"));
1338        let y_sym = arena.symbol(Rc::from("y"));
1339        let plus_sym = arena.symbol(Rc::from("+"));
1340        let ten = arena.int(10);
1341        let twenty = arena.int(20);
1342
1343        // Build inner lambda body: (+ x y)
1344        let y_list = arena.cons(y_sym, NIL_ID);
1345        let x_list = arena.cons(x_sym, y_list);
1346        let inner_body = arena.cons(plus_sym, x_list);
1347
1348        // Build inner lambda: (lambda (y) (+ x y))
1349        let y_params = arena.cons(y_sym, NIL_ID);
1350        let inner_body_list = arena.cons(inner_body, NIL_ID);
1351        let inner_lambda_args = arena.cons(y_params, inner_body_list);
1352        let lambda_sym = arena.symbol(Rc::from("lambda"));
1353        let inner_lambda = arena.cons(lambda_sym, inner_lambda_args);
1354
1355        // Build outer lambda: (lambda (x) (lambda (y) (+ x y)))
1356        let x_params = arena.cons(x_sym, NIL_ID);
1357        let outer_body_list = arena.cons(inner_lambda, NIL_ID);
1358        let outer_lambda_args = arena.cons(x_params, outer_body_list);
1359        let outer_lambda = arena.cons(lambda_sym, outer_lambda_args);
1360
1361        // Build application: ((lambda (x) ...) 10)
1362        let ten_list = arena.cons(ten, NIL_ID);
1363        let app1 = arena.cons(outer_lambda, ten_list);
1364
1365        // Build call to closure: (my-closure 20)
1366        let closure_sym = arena.symbol(Rc::from("my-closure"));
1367        let twenty_list = arena.cons(twenty, NIL_ID);
1368        let app2 = arena.cons(closure_sym, twenty_list);
1369
1370        // Compile first application
1371        let mut compiler = Compiler::new(&arena);
1372        let start_ip = compiler.compile(app1).unwrap();
1373        let compiled_program = compiler.into_program();
1374        program.instructions = compiled_program.instructions;
1375        program.emit(Instruction::Return);
1376
1377        // Compile second application and APPEND to same program
1378        let mut compiler2 = Compiler::new(&arena);
1379        let start_ip2 = compiler2.compile(app2).unwrap();
1380        let compiled_program2 = compiler2.into_program();
1381
1382        // Append to existing program (so body_ip references remain valid)
1383        let offset = program.instructions.len();
1384        program.instructions.extend(compiled_program2.instructions);
1385        program.emit(Instruction::Return);
1386
1387        // Adjust start_ip2 for the offset
1388        let adjusted_start_ip2 = offset + start_ip2;
1389
1390        // Run with primitives to get the inner closure
1391        let mut vm = VM::with_primitives(&mut arena);
1392        let closure_id = vm.run(&program.instructions, start_ip).unwrap();
1393
1394        // Store closure as global so we can reference it
1395        vm.define_global("my-closure".to_string(), closure_id);
1396
1397        // Run - should get 30 (10 + 20)
1398        let result_id = vm.run(&program.instructions, adjusted_start_ip2).unwrap();
1399        let result = arena.get(result_id);
1400
1401        assert!(matches!(result, ValueData::Integer(30)));
1402    }
1403
1404    #[test]
1405    fn test_vm_case_multiple_datums() {
1406        // Test: (case 'b ((a) 1) ((b c) 42) (else 99))
1407        // Should return 42 (matching second clause, first datum)
1408        let mut arena = Arena::new();
1409        let mut program = Program::new();
1410
1411        let a_sym = arena.symbol(Rc::from("a"));
1412        let b_sym = arena.symbol(Rc::from("b"));
1413        let c_sym = arena.symbol(Rc::from("c"));
1414        let one = arena.int(1);
1415        let forty_two = arena.int(42);
1416        let ninety_nine = arena.int(99);
1417
1418        // Build key 'b (quoted)
1419        let key_list = arena.cons(b_sym, NIL_ID);
1420        let quote_sym = arena.symbol(Rc::from("quote"));
1421        let key = arena.cons(quote_sym, key_list);
1422
1423        // Build clause ((a) 1)
1424        let clause1_datums = arena.cons(a_sym, NIL_ID);
1425        let clause1_body = arena.cons(one, NIL_ID);
1426        let clause1 = arena.cons(clause1_datums, clause1_body);
1427
1428        // Build clause ((b c) 42)
1429        let c_list = arena.cons(c_sym, NIL_ID);
1430        let bc_list = arena.cons(b_sym, c_list);
1431        let clause2_datums = bc_list;
1432        let clause2_body = arena.cons(forty_two, NIL_ID);
1433        let clause2 = arena.cons(clause2_datums, clause2_body);
1434
1435        // Build clause (else 99)
1436        let else_sym = arena.symbol(Rc::from("else"));
1437        let clause3_body = arena.cons(ninety_nine, NIL_ID);
1438        let clause3 = arena.cons(else_sym, clause3_body);
1439
1440        // Build clauses list
1441        let clause3_list = arena.cons(clause3, NIL_ID);
1442        let clause2_list = arena.cons(clause2, clause3_list);
1443        let clauses = arena.cons(clause1, clause2_list);
1444
1445        // Build case form (case key clauses...)
1446        let args = arena.cons(key, clauses);
1447        let case_sym = arena.symbol(Rc::from("case"));
1448        let expr = arena.cons(case_sym, args);
1449
1450        // Compile
1451        let mut compiler = Compiler::new(&arena);
1452        let start_ip = compiler.compile(expr).unwrap();
1453        let compiled_program = compiler.into_program();
1454        program.instructions = compiled_program.instructions;
1455        program.emit(Instruction::Return);
1456
1457        // Run
1458        let mut vm = VM::new(&mut arena);
1459        let result_id = vm.run(&program.instructions, start_ip).unwrap();
1460        let result = arena.get(result_id);
1461
1462        assert!(matches!(result, ValueData::Integer(42)));
1463    }
1464}
dazzle_core/scheme/vm.rs

dazzle_core/scheme/
vm.rs
