SCM sum type

runtime/Cargo.lock

@@ -30,6 +30,15 @@ dependencies = [
  "cc",
 ]
 
+[[package]]
+name = "const_panic"
+version = "0.2.15"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "e262cdaac42494e3ae34c43969f9cdeb7da178bdb4b66fa6a1ea2edb4c8ae652"
+dependencies = [
+ "typewit",
+]
+
 [[package]]
 name = "find-msvc-tools"
 version = "0.1.9"
@@ -41,6 +50,7 @@ name = "gyehoek"
 version = "0.1.0"
 dependencies = [
  "bdwgc-alloc",
+ "const_panic",
  "libc",
 ]
 
@@ -55,3 +65,9 @@ name = "shlex"
 version = "1.3.0"
 source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "0fda2ff0d084019ba4d7c6f371c95d8fd75ce3524c3cb8fb653a3023f6323e64"
+
+[[package]]
+name = "typewit"
+version = "1.15.2"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "214ca0b2191785cbc06209b9ca1861e048e39b5ba33574b3cedd58363d5bb5f6"

runtime/Cargo.toml

@@ -12,6 +12,7 @@ crate-type = ["staticlib"]
 bdwgc-alloc = { version = "0.6.13"
               , default-features = false
               , features = ["cmake"] }
+const_panic = "0.2.15"
 libc = "0.2.186"
 
 [patch.crates-io]

runtime/src/gc.rs

@@ -1,30 +1,34 @@
-use libc::{c_int, c_void, size_t};
+use libc::{c_void, size_t};
 
 #[link(name = "gc", kind = "static")]
 unsafe extern "C" {
-    fn GC_allow_register_threads ();
-    fn GC_alloc_lock ();
-    fn GC_alloc_unlock ();
-    fn GC_free (ptr: *mut c_void);
+    // fn GC_allow_register_threads ();
+    // fn GC_alloc_lock ();
+    // fn GC_alloc_unlock ();
+    // fn GC_free (ptr: *mut c_void);
     // fn GC_get_stack_base (stack_base: *mut GcStackBase) -> c_int;
-    fn GC_init ();
+    // fn GC_init ();
     fn GC_malloc (size: size_t) -> *mut c_void;
     fn GC_realloc (ptr: *mut c_void, size: size_t) -> *mut c_void;
     // fn GC_register_my_thread
     //     (stack_base: *const GcStackBase) -> c_int;
     // fn GC_set_stackbottom
     //     (thread: *const c_void, stack_bottom: *const GcStackBase);
-    fn GC_unregister_my_thread ();
-    fn GC_gcollect ();
-    fn GC_register_finalizer (
-        ptr: *const c_void,
-        finalizer: extern "C" fn (*mut c_void, *mut c_void),
-        client_data: *const c_void,
-        opt_old_finalizer: *const c_void,
-        opt_old_client_data: *const c_void,
-    ) -> *mut c_void;
+    // fn GC_unregister_my_thread ();
+    // fn GC_gcollect ();
+    // fn GC_register_finalizer (
+    //     ptr: *const c_void,
+    //     finalizer: extern "C" fn (*mut c_void, *mut c_void),
+    //     client_data: *const c_void,
+    //     opt_old_finalizer: *const c_void,
+    //     opt_old_client_data: *const c_void,
+    // ) -> *mut c_void;
 }
 
 pub unsafe fn malloc<T> (size: usize) -> *mut T {
     unsafe { GC_malloc (size) as *mut T }
 }
+
+pub unsafe fn realloc<T> (ptr: *mut T, size: usize) -> *mut T {
+    unsafe { GC_realloc (ptr as *mut c_void, size) as *mut T }
+}

runtime/src/lib.rs

@@ -3,128 +3,24 @@
 
 use std::{io::{stdout, Write}};
 mod gc;
-// use crate::gc;
-// use bdwgc_alloc:Allocator;
-
-pub const scm_tc2_int      : u64 = 2;
-pub const scm_tc3_cons     : u64 = 0;
-pub const scm_tc7_weak_set : u64 = 0x55;
-pub const scm_tc7_symbol   : u64 = 0x05;
-pub const scm_tc7_string   : u64 = 0x15;
-
-pub const scm_false : SCM = scm_pack (0b00100);
-pub const scm_true  : SCM = scm_pack (0b01100);
-pub const scm_eol   : SCM = scm_pack (0b10100);
-
-
-pub type scm_bits = u64;
-
-#[repr(C)]
-#[derive(Clone, Copy)]
-pub struct SCM {
-    n : scm_bits
-}
-
-const fn scm_pack (bits : scm_bits) -> SCM {
-    SCM {n: bits}
-}
-
-fn scm_unpack (x : SCM) -> scm_bits {
-    x.n
-}
-
-fn scm_unpack_pointer (x : SCM) -> *mut scm_bits {
-    x.n as *mut scm_bits
-}
-
-fn scm_pack_pointer (x : *const scm_bits) -> SCM {
-    SCM {n: x as scm_bits}
-}
-
-
-
-fn scm_words (ty: scm_bits, n: usize) -> SCM {
-    unsafe {
-        let r = gc::malloc (n * size_of::<scm_bits> ()) as *mut scm_bits;
-        *r = ty;
-        return scm_pack_pointer (r);
-    }
-}
-
-fn scm_cell_object (x: SCM, n: usize) -> SCM {
-    let p = scm_unpack_pointer (x) as *mut SCM;
-    unsafe {
-        *(p.wrapping_add (n))
-    }
-}
-
-fn scm_cell_word (x: SCM, n: usize) -> scm_bits {
-    scm_unpack (scm_cell_object (x, n))
-}
-
-fn is_immediate (x: SCM) -> bool {
-    6 & scm_unpack (x) != 0
-}
-
-fn scm_cell_type (x: SCM) -> scm_bits {
-    scm_cell_word (x, 0)
-}
-
-fn is_cons (x: SCM) -> bool {
-    ! is_immediate (x) && (1 & scm_cell_type (x)) == 0
-}
-
-fn is_small_int (x: SCM) -> bool {
-    3 & scm_unpack (x) == scm_tc2_int
-}
-
-fn get_small_int (x: SCM) -> scm_bits {
-    scm_unpack (x) >> 2
-}
-
-fn scm_car (x: SCM) -> SCM {
-    scm_cell_object (x, 0)
-}
-
-fn scm_cdr (x: SCM) -> SCM {
-    scm_cell_object (x, 1)
-}
+mod scm;
+use scm::{scm_bits, SCM};
 
 #[unsafe(no_mangle)]
-pub extern "C" fn scm_write (x: SCM) -> SCM {
-    if is_small_int (x) {
-        print! ("{:?}", get_small_int (x));
-    } else if is_cons (x) {
-        print! ("(");
-        scm_write (scm_car (x));
-        print! (" . ");
-        scm_write (scm_cdr (x));
-        print! (")");
-    } else {
-        let ty = if is_immediate (x) { "immediate" } else { "heap object" };
-        print! ("#<{ty} {:#016x}>", scm_unpack (x));
-    }
+pub extern "C" fn scm_write (x: scm_bits) -> scm_bits {
+    match scm::unpack (x) {
+        SCM::SmallInt (n) => print! ("{n}"),
+        SCM::Cons (car, cdr) => {
+            print! ("(");
+            scm_write (car);
+            print! (" . ");
+            scm_write (cdr);
+            print! (")");
+        },
+        SCM::Nil => print! ("()"),
+        SCM::False => print! ("#f"),
+        SCM::True => print! ("#t"),
+    };
     let _ = stdout ().flush ();
-    return scm_pack (0);
-}
-
-#[unsafe(no_mangle)]
-pub extern "C" fn scm_from_utf8 (s: *const u8, len: usize) -> SCM {
-    let r = scm_words (scm_tc7_string, 3);
-    return scm_pack (0);
-}
-
-pub fn add (left: u64, right: u64) -> u64 {
-    left + right
-}
-
-#[cfg(test)]
-mod tests {
-    use super::*;
-
-    #[test]
-    fn it_works () {
-        let result = add (2, 2);
-        assert_eq! (result, 4);
-    }
+    return 0;
 }

runtime/src/scm.rs

@@ -0,0 +1,77 @@
+#![allow(non_upper_case_globals)]
+#![allow(non_camel_case_types)]
+
+pub type scm_bits = u64;
+
+pub const tc2_int      : u64 = 2;
+pub const tc3_cons     : u64 = 0;
+pub const tc7_weak_set : u64 = 0x55;
+pub const tc7_symbol   : u64 = 0x05;
+pub const tc7_string   : u64 = 0x15;
+
+// pub const scm_false : SCM = pack (0b00100);
+// pub const scm_true  : SCM = pack (0b01100);
+// pub const scm_eol   : SCM = pack (0b10100);
+
+pub enum SCM {
+    SmallInt (i64), 
+    Cons (scm_bits, scm_bits),
+    Nil,
+    False,
+    True,
+}
+
+// #[inline(always)]
+// pub fn pack (x : SCM) -> scm_bits {
+// }
+
+// super duper important for this to inline. we want to eliminate the
+// SCM type at runtime as much as possible. the hope is for inlining
+// to lead to a case-of-case–esque transformation.
+#[inline(always)]
+pub fn unpack (x : scm_bits) -> SCM {
+    if is_small_int (x) {
+        SCM::SmallInt ((x >> 2) as i64)
+    } else if is_cons (x) {
+        // `car` x and `cdr` x are safe iff `is_cons` x.
+        unsafe { SCM::Cons (car (x), cdr (x)) }
+    } else {
+        // concat_panic! ("don't know how to unpack: ", x)
+        panic! ("don't know how to unpack {x:#016x}")
+    }
+}
+
+const fn is_small_int (x: scm_bits) -> bool {
+    3 & x == tc2_int
+}
+
+const fn is_immediate (x: scm_bits) -> bool {
+    6 & x != 0
+}
+
+fn is_cons (x: scm_bits) -> bool {
+    // safety of `cell_type` is mutually exclusive with
+    // `is_immediate`, so this is okay.
+    unsafe {
+        ! is_immediate (x) && (1 & cell_type (x)) == 0
+    }
+}
+
+unsafe fn cell_type (x: scm_bits) -> scm_bits {
+    unsafe { cell_word (x, 0) }
+}
+
+unsafe fn cell_word (x: scm_bits, n: usize) -> scm_bits {
+    let p = x as *mut scm_bits;
+    unsafe {
+        *(p.wrapping_add (n))
+    }
+}
+
+unsafe fn car (x: scm_bits) -> scm_bits {
+    unsafe { cell_word (x, 0) }
+}
+
+unsafe fn cdr (x: scm_bits) -> scm_bits {
+    unsafe { cell_word (x, 1) }
+}