stak_native/
list.rs

1use stak_vm::{Error, Heap, Memory, PrimitiveSet, Type};
2use winter_maybe_async::maybe_async;
3
4/// A list primitive.
5pub enum ListPrimitive {
6    /// An `assq` procedure.
7    Assq,
8    /// A `cons` procedure.
9    Cons,
10    /// A `memq` procedure.
11    Memq,
12    /// A `list-tail` procedure.
13    Tail,
14}
15
16impl ListPrimitive {
17    const ASSQ: usize = Self::Assq as _;
18    const CONS: usize = Self::Cons as _;
19    const MEMQ: usize = Self::Memq as _;
20    const TAIL: usize = Self::Tail as _;
21}
22
23/// A list primitive set.
24#[derive(Debug, Default)]
25pub struct ListPrimitiveSet {}
26
27impl ListPrimitiveSet {
28    /// Creates a primitive set.
29    pub fn new() -> Self {
30        Self::default()
31    }
32}
33
34impl<H: Heap> PrimitiveSet<H> for ListPrimitiveSet {
35    type Error = Error;
36
37    #[maybe_async]
38    fn operate(&mut self, memory: &mut Memory<H>, primitive: usize) -> Result<(), Self::Error> {
39        match primitive {
40            ListPrimitive::ASSQ => {
41                let [x, xs] = memory.pop_many()?;
42                let mut xs = xs.assume_cons();
43                let mut y = memory.boolean(false)?;
44
45                while xs != memory.null()? {
46                    let cons = memory.car(xs)?.assume_cons();
47
48                    if x == memory.car(cons)? {
49                        y = cons;
50                        break;
51                    }
52
53                    xs = memory.cdr(xs)?.assume_cons();
54                }
55
56                memory.push(y.into())?;
57            }
58            ListPrimitive::CONS => {
59                let [car, cdr] = memory.pop_many()?;
60
61                let rib = memory.allocate(car, cdr.set_tag(Type::Pair as _))?;
62                memory.push(rib.into())?;
63            }
64            ListPrimitive::MEMQ => {
65                let [x, xs] = memory.pop_many()?;
66                let mut xs = xs.assume_cons();
67                let mut y = memory.boolean(false)?;
68
69                while xs != memory.null()? {
70                    if x == memory.car(xs)? {
71                        y = xs;
72                        break;
73                    }
74
75                    xs = memory.cdr(xs)?.assume_cons();
76                }
77
78                memory.push(y.into())?;
79            }
80            ListPrimitive::TAIL => {
81                let [mut xs, index] = memory.pop_many()?;
82                let mut index = index.assume_number().to_i64() as usize;
83
84                while index > 0 {
85                    let Some(cons) = xs.to_cons() else {
86                        break;
87                    };
88                    let cdr = memory.cdr(cons)?;
89
90                    if cdr.tag() != Type::Pair as _ {
91                        break;
92                    }
93
94                    xs = cdr;
95                    index -= 1;
96                }
97
98                memory.push(xs)?;
99            }
100            _ => return Err(Error::IllegalPrimitive),
101        }
102
103        Ok(())
104    }
105}