stak_native/
equal.rs

1use stak_vm::{Error, Heap, Memory, PrimitiveSet, Type};
2use winter_maybe_async::maybe_async;
3
4/// An equality primitive.
5pub enum EqualPrimitive {
6    /// An `eqv` procedure.
7    Eqv,
8    /// A primitive to check equality of rib inners.
9    EqualInner,
10}
11
12impl EqualPrimitive {
13    const EQV: usize = Self::Eqv as _;
14    const EQUAL_INNER: usize = Self::EqualInner as _;
15}
16
17/// An equality primitive set.
18#[derive(Debug, Default)]
19pub struct EqualPrimitiveSet {}
20
21impl EqualPrimitiveSet {
22    /// Creates a primitive set.
23    pub fn new() -> Self {
24        Self::default()
25    }
26}
27
28impl<H: Heap> PrimitiveSet<H> for EqualPrimitiveSet {
29    type Error = Error;
30
31    #[maybe_async]
32    fn operate(&mut self, memory: &mut Memory<H>, primitive: usize) -> Result<(), Self::Error> {
33        match primitive {
34            EqualPrimitive::EQV => {
35                let [x, y] = memory.pop_many()?;
36
37                memory.push(
38                    memory
39                        .boolean(
40                            x == y
41                                || if let (Some(x), Some(y)) = (x.to_cons(), y.to_cons()) {
42                                    memory.cdr(x)?.tag() == Type::Character as _
43                                        && memory.cdr(y)?.tag() == Type::Character as _
44                                        && memory.car(x) == memory.car(y)
45                                } else {
46                                    false
47                                },
48                        )?
49                        .into(),
50                )?;
51            }
52            EqualPrimitive::EQUAL_INNER => {
53                let [x, y] = memory.pop_many()?;
54
55                memory.push(
56                    memory
57                        .boolean(if let (Some(x), Some(y)) = (x.to_cons(), y.to_cons()) {
58                            // - Optimize checks for unique values.
59                            // - Optimize checks for strings and vectors where `car`s are integers.
60                            memory.cdr(x)?.tag() == memory.cdr(y)?.tag()
61                                && ![Type::Boolean as _, Type::Null as _, Type::Symbol as _]
62                                    .contains(&memory.cdr(x)?.tag())
63                                && (memory.car(x)?.is_cons() || memory.car(x)? == memory.car(y)?)
64                        } else {
65                            false
66                        })?
67                        .into(),
68                )?;
69            }
70            _ => return Err(Error::IllegalPrimitive),
71        }
72
73        Ok(())
74    }
75}