stak_native/
list.rs

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