Optimized primitive sets of native functions

Cargo.toml

@@ -19,6 +19,7 @@ members = [
   "minifier",
   "minifier_macro",
   "module",
+  "native",
   "process_context",
   "profiler",
   "r7rs",

Gemfile.lock

@@ -36,7 +36,7 @@ GEM
     cucumber-messages (22.0.0)
     cucumber-tag-expressions (6.1.1)
     diff-lcs (1.5.1)
-    ffi (1.17.0-arm64-darwin)
+    ffi (1.17.0)
     mini_mime (1.1.5)
     multi_test (1.1.0)
     rspec-expectations (3.13.3)

native/Cargo.toml

@@ -0,0 +1,15 @@
+[package]
+name = "stak-native"
+description = "Optimized primitives of native functions for Stak Scheme"
+version = "0.1.0"
+edition.workspace = true
+keywords.workspace = true
+license-file.workspace = true
+readme.workspace = true
+repository.workspace = true
+
+[dependencies]
+stak-vm = { version = "0.7.14", path = "../vm" }
+
+[lints]
+workspace = true

native/src/lib.rs

@@ -0,0 +1,9 @@
+//! Stak Scheme primitive sets for optimized primitives of native functions.
+
+#![no_std]
+
+mod list;
+mod type_check;
+
+pub use list::*;
+pub use type_check::*;

native/src/list.rs

@@ -0,0 +1,80 @@
+use stak_vm::{Error, Memory, PrimitiveSet, Type};
+
+/// A list primitive.
+pub enum ListPrimitive {
+    /// A `assq` procedure.
+    Assq,
+    /// A `cons` procedure.
+    Cons,
+    /// A `memq` procedure.
+    Memq,
+}
+
+impl ListPrimitive {
+    const ASSQ: usize = Self::Assq as _;
+    const CONS: usize = Self::Cons as _;
+    const MEMQ: usize = Self::Memq as _;
+}
+
+/// A list primitive set.
+#[derive(Debug, Default)]
+pub struct ListPrimitiveSet {}
+
+impl ListPrimitiveSet {
+    /// Creates a primitive set.
+    pub fn new() -> Self {
+        Self::default()
+    }
+}
+
+impl PrimitiveSet for ListPrimitiveSet {
+    type Error = Error;
+
+    fn operate(&mut self, memory: &mut Memory, primitive: usize) -> Result<(), Self::Error> {
+        match primitive {
+            ListPrimitive::ASSQ => {
+                let [x, xs] = memory.pop_many();
+                let mut xs = xs.assume_cons();
+                let mut y = memory.boolean(false);
+
+                while xs != memory.null() {
+                    let cons = memory.car(xs).assume_cons();
+
+                    if x == memory.car(cons) {
+                        y = cons;
+                        break;
+                    }
+
+                    xs = memory.cdr(xs).assume_cons();
+                }
+
+                memory.push(y.into())?;
+            }
+            ListPrimitive::CONS => {
+                let [car, cdr] = memory.pop_many();
+
+                let rib = memory.allocate(car, cdr.set_tag(Type::Pair as _))?;
+                memory.push(rib.into())?;
+            }
+            ListPrimitive::MEMQ => {
+                let [x, xs] = memory.pop_many();
+                let mut xs = xs.assume_cons();
+                let mut y = memory.boolean(false);
+
+                while xs != memory.null() {
+                    if x == memory.car(xs) {
+                        y = xs;
+                        break;
+                    }
+
+                    xs = memory.cdr(xs).assume_cons();
+                }
+
+                memory.push(y.into())?;
+            }
+            _ => return Err(Error::IllegalPrimitive),
+        }
+
+        Ok(())
+    }
+}

native/src/type_check.rs

@@ -0,0 +1,59 @@
+use stak_vm::{Error, Memory, PrimitiveSet, Type, Value};
+
+/// A type check primitive.
+pub enum TypeCheckPrimitive {
+    /// A null type check.
+    Null,
+    /// A pair type check.
+    Pair,
+}
+
+impl TypeCheckPrimitive {
+    const NULL: usize = Self::Null as _;
+    const PAIR: usize = Self::Pair as _;
+}
+
+/// A type check primitive set.
+#[derive(Debug, Default)]
+pub struct TypeCheckPrimitiveSet {}
+
+impl TypeCheckPrimitiveSet {
+    /// Creates a primitive set.
+    pub fn new() -> Self {
+        Self::default()
+    }
+
+    fn operate_top<'a>(
+        memory: &mut Memory<'a>,
+        operate: impl Fn(&Memory<'a>, Value) -> Value,
+    ) -> Result<(), Error> {
+        let x = memory.pop();
+        memory.push(operate(memory, x))?;
+        Ok(())
+    }
+}
+
+impl PrimitiveSet for TypeCheckPrimitiveSet {
+    type Error = Error;
+
+    fn operate(&mut self, memory: &mut Memory, primitive: usize) -> Result<(), Self::Error> {
+        match primitive {
+            TypeCheckPrimitive::NULL => Self::operate_top(memory, |memory, value| {
+                memory.boolean(value == memory.null().into()).into()
+            })?,
+            TypeCheckPrimitive::PAIR => Self::operate_top(memory, |memory, value| {
+                memory
+                    .boolean(
+                        value
+                            .to_cons()
+                            .map(|cons| memory.cdr(cons).tag() == Type::Pair as _)
+                            .unwrap_or_default(),
+                    )
+                    .into()
+            })?,
+            _ => return Err(Error::IllegalPrimitive),
+        }
+
+        Ok(())
+    }
+}