Optimize equal? procedure

native/src/equal.rs

@@ -4,10 +4,13 @@ use stak_vm::{Error, Memory, PrimitiveSet, Type};
 pub enum EqualPrimitive {
     /// An `eqv` procedure.
     Eqv,
+    /// A primitive to check equality of rib inners.
+    EqualInner,
 }
 
 impl EqualPrimitive {
     const EQV: usize = Self::Eqv as _;
+    const EQUAL_INNER: usize = Self::EqualInner as _;
 }
 
 /// An equality primitive set.
@@ -44,6 +47,25 @@ impl PrimitiveSet for EqualPrimitiveSet {
                         .into(),
                 )?;
             }
+            EqualPrimitive::EQUAL_INNER => {
+                let [x, y] = memory.pop_many();
+
+                memory.push(
+                    memory
+                        .boolean(if let (Some(x), Some(y)) = (x.to_cons(), y.to_cons()) {
+                            // - Optimize checks for unique values.
+                            // - Optimize checks for strings and vectors where `car`s are integers.
+                            memory.cdr(x).tag() == memory.cdr(y).tag()
+                                && ![Type::Boolean as _, Type::Null as _, Type::Symbol as _]
+                                    .contains(&memory.cdr(x).tag())
+                                && (memory.car(x).is_cons() || memory.car(x) == memory.car(y))
+                        } else {
+                            false
+                        })
+                        .into(),
+                )?;
+            }
+
             _ => return Err(Error::IllegalPrimitive),
         }
 

prelude.scm

@@ -602,6 +602,7 @@
     (define cons (primitive 61))
     (define memq (primitive 62))
     (define eqv? (primitive 70))
+    (define equal-inner? (primitive 71))
 
     (define (data-rib type car cdr)
       (rib car cdr type))
@@ -626,15 +627,7 @@
       (boolean-or
         (eq? x y)
         (and
-          (rib? x)
-          (rib? y)
-          (eq? (rib-tag x) (rib-tag y))
-          ; Avoid checking values in global variables.
-          (not (eq? (rib-tag x) symbol-type))
-          ; Optimize for the cases of strings and vectors where `car`s are integers.
-          (boolean-or
-            (rib? (rib-car x))
-            (eq? (rib-car x) (rib-car y)))
+          (equal-inner? x y)
           (equal? (rib-car x) (rib-car y))
           (equal? (rib-cdr x) (rib-cdr y)))))
 

r7rs/src/small.rs

@@ -146,7 +146,9 @@ impl<D: Device, F: FileSystem, P: ProcessContext, C: Clock> PrimitiveSet
             Primitive::ASSQ | Primitive::CONS | Primitive::MEMQ => {
                 self.list.operate(memory, primitive - Primitive::ASSQ)?
             }
-            Primitive::EQV => self.equal.operate(memory, primitive - Primitive::EQV)?,
+            Primitive::EQV | Primitive::EQUAL_INNER => {
+                self.equal.operate(memory, primitive - Primitive::EQV)?
+            }
             Primitive::READ | Primitive::WRITE | Primitive::WRITE_ERROR => {
                 self.device.operate(memory, primitive - Primitive::READ)?
             }

r7rs/src/small/primitive.rs

@@ -24,6 +24,7 @@ pub(super) enum Primitive {
     Cons,
     Memq,
     Eqv = 70,
+    EqualInner,
     Read = 100,
     Write,
     WriteError,
@@ -63,6 +64,7 @@ impl Primitive {
     pub const CONS: usize = Self::Cons as _;
     pub const MEMQ: usize = Self::Memq as _;
     pub const EQV: usize = Self::Eqv as _;
+    pub const EQUAL_INNER: usize = Self::EqualInner as _;
     pub const READ: usize = Self::Read as _;
     pub const WRITE: usize = Self::Write as _;
     pub const WRITE_ERROR: usize = Self::WriteError as _;