1use stak_vm::{Error, Heap, Memory, PrimitiveSet, Type};
2use winter_maybe_async::maybe_async;
3
4pub enum ListPrimitive {
6 Assq,
8 Cons,
10 Memq,
12 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#[derive(Debug, Default)]
25pub struct ListPrimitiveSet {}
26
27impl ListPrimitiveSet {
28 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}