From 7f28fcb5ee3a5bb2e6561aed82179d77f4717c0a Mon Sep 17 00:00:00 2001 From: Brennan Vincent Date: Wed, 24 Nov 2021 01:00:04 -0500 Subject: [PATCH] Add various constants and utility functions that are often necessary --- src/lib.rs | 185 +++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 173 insertions(+), 12 deletions(-) diff --git a/src/lib.rs b/src/lib.rs index f5e03c1..cebcd59 100644 --- a/src/lib.rs +++ b/src/lib.rs @@ -21,8 +21,8 @@ #![allow(non_snake_case)] #![allow(improper_ctypes)] -use std::os; -use os::raw::{c_int, c_char, c_void}; +use os::raw::{c_char, c_int, c_void}; +use std::{convert::TryInto, os}; include!("./bindings.rs"); @@ -37,27 +37,188 @@ pub fn init_scm() { // this function launches the scheme process and starts bootstrapping the runtime // any code executed after this function but before `scm_shell()' can talk to the scheme runtime unsafe { - scm_with_guile(Some(register_functions), std::ptr::null_mut()); + scm_with_guile(Some(register_functions), std::ptr::null_mut()); } } pub fn run_scm(argc: c_int, argv: *mut *mut c_char) { // spawn the scheme shell, shifting execution from Rust mode to Guile mode unsafe { - scm_shell(argc, argv); + scm_shell(argc, argv); } } #[macro_export] macro_rules! register_void_function { ($x:expr, $y:expr) => { - // first convert the function name to a (const char *) so Guile can read it - let ___fn_name: *const std::os::raw::c_char = std::ffi::CStr::from_bytes_with_nul($x).unwrap().as_ptr(); - // convert the function into a (void *) to match with Guile's execution expectations - let ___function: *mut std::os::raw::c_void = $y as *mut std::os::raw::c_void; - // register the function as a subroutine in Guile - unsafe { - scm_c_define_gsubr(___fn_name, 0, 0, 0, ___function); - } + // first convert the function name to a (const char *) so Guile can read it + let ___fn_name: *const std::os::raw::c_char = + std::ffi::CStr::from_bytes_with_nul($x).unwrap().as_ptr(); + // convert the function into a (void *) to match with Guile's execution expectations + let ___function: *mut std::os::raw::c_void = $y as *mut std::os::raw::c_void; + // register the function as a subroutine in Guile + unsafe { + scm_c_define_gsubr(___fn_name, 0, 0, 0, ___function); + } + }; +} + +/// Represents the Scheme `#f` value +pub const SCM_BOOL_F: SCM = 0x4 as SCM; +/// Represents the Scheme `#t` value +pub const SCM_BOOL_T: SCM = 0x404 as SCM; +/// According to the Guile documentation: +/// "This is a SCM value that is not the same as any legal Scheme value. It is the value that a Scheme function returns when its specification says that its return value is unspecified." +pub const SCM_UNSPECIFIED: SCM = 0x804 as SCM; +/// Represents the empty list: `'()` +pub const SCM_EOL: SCM = 0x304 as SCM; + +/// Returns whether a `SCM` value would evaluate to true +/// in Guile (which is the case for any value other than `#f`). +pub fn scm_is_truthy(scm: SCM) -> bool { + !(scm == SCM_BOOL_F) +} + +/// Represents a scheme object on the heap. +#[repr(C)] +struct ScmCell { + car: SCM, + cdr: SCM, +} + +/// Create a pair. +pub fn scm_cons(car: SCM, cdr: SCM) -> SCM { + let cell = unsafe { scm_gc_malloc(std::mem::size_of::() as u64, std::ptr::null()) } + as *mut ScmCell; + unsafe { + std::ptr::write(cell, ScmCell { car, cdr }); + } + cell as SCM +} + +/// Checks whether `scm` is a signed integer, and +/// returns its value if so. +pub fn try_scm_to_signed(scm: SCM) -> Option { + unsafe { (scm_is_signed_integer(scm, i64::MIN, i64::MAX) != 0).then(|| scm_to_int64(scm)) } +} + +/// Checks whether `scm` is an unsigned integer, and +/// returns its value if so. +pub fn try_scm_to_unsigned(scm: SCM) -> Option { + unsafe { (scm_is_unsigned_integer(scm, u64::MIN, u64::MAX) != 0).then(|| scm_to_uint64(scm)) } +} + +/// Checks whether `scm` is a real, +/// and returns its value if so. +pub fn try_scm_to_double(scm: SCM) -> Option { + unsafe { (scm_is_truthy(scm_real_p(scm))).then(|| scm_to_double(scm)) } +} + +/// Checks whether `scm` is a char, +/// and returns its value if so. +pub fn try_scm_to_char(scm: SCM) -> Option { + unsafe { + (scm_is_truthy(scm_char_p(scm))) + .then(|| scm_to_uint32(scm_integer_to_char(scm))) + .map(|ch| ch.try_into().unwrap()) } } + +/// Checks whether `scm` is an immediate object; that is, +/// not stored on the heap. Equivalent to the SCM_IMP C macro. +pub fn scm_imp(scm: SCM) -> bool { + (scm as usize) & 0x6 != 0 +} + +/// Checks whether `scm` is stored on the heap. +pub fn scm_nimp(scm: SCM) -> bool { + !scm_imp(scm) +} + +// Gets the `typ7` type bits corresponding to the heap object `scm`. +// Precondition: `scm` must be a heap object (not an immediate). +// For details on how this and other type-checking +// functions work, see "Representation of scheme objects" in scm.h +unsafe fn scm_typ7(scm: SCM) -> u8 { + (std::ptr::read(scm as *const usize) as u8) & 0x7f +} + +/// Checks whether `scm` is a string. +pub fn scm_is_string(scm: SCM) -> bool { + scm_nimp(scm) && unsafe { scm_typ7(scm) } == 0x15 +} + +/// Checks whether `scm` is a symbol, and returns its value if so. +pub fn try_scm_to_sym(scm: SCM) -> Option { + unsafe { + scm_is_truthy(scm_symbol_p(scm)).then(|| { + let mut len = std::mem::MaybeUninit::uninit(); + let data = scm_to_utf8_stringn(scm_symbol_to_string(scm), len.as_mut_ptr()); + let len = len.assume_init(); + String::from_raw_parts( + std::mem::transmute(data), + len.try_into().unwrap(), + len.try_into().unwrap(), + ) + }) + } +} + +/// Checks whether `scm` is a string or a symbol, and returns its value in either case. +pub fn try_scm_to_string_or_sym(scm: SCM) -> Option { + unsafe { + scm_is_string(scm) + .then(|| { + let mut len = std::mem::MaybeUninit::uninit(); + let data = scm_to_utf8_stringn(scm, len.as_mut_ptr()); + let len = len.assume_init(); + let len = len + .try_into() + .expect("string's length should always fit in `usize`"); + String::from_raw_parts(std::mem::transmute(data), len, len) + }) + .or_else(|| try_scm_to_sym(scm)) + } +} + +/// Checks whether `scm` is a byte vector, and returns its value if so. +pub fn try_scm_to_bytes(scm: SCM) -> Option> { + unsafe { + (scm_is_bytevector(scm) != 0).then(|| { + let len = scm_c_bytevector_length(scm); + let mut vec = Vec::with_capacity( + len.try_into() + .expect("bytevector's length should always fit in `usize`"), + ); + for i in 0..len { + vec.push(scm_c_bytevector_ref(scm, i)); // Is there really no more performant way than the loop? + } + vec + }) + } +} + +/// Gets the first element of a pair. +/// Precondition: `scm` must actually be a pair. +pub unsafe fn scm_car_unchecked(scm: SCM) -> SCM { + std::ptr::read(scm as *const SCM) +} + +/// Gets the second element of a pair. +/// Precondition: `scm` must actually be a pair. +pub unsafe fn scm_cdr_unchecked(scm: SCM) -> SCM { + std::ptr::read((scm as *const SCM).add(1)) +} + +/// Checks whether `scm` is a pair. +pub fn scm_is_pair(scm: SCM) -> bool { + unsafe { + let raw = scm as usize; + ((raw & 6) == 0) && ((std::ptr::read(scm as *const usize) & 1) == 0) + } +} + +/// Checks whether `scm` is a pair, and returns its elements if so. +pub fn try_scm_decons(scm: SCM) -> Option<(SCM, SCM)> { + unsafe { scm_is_pair(scm).then(|| (scm_car_unchecked(scm), scm_cdr_unchecked(scm))) } +}