runtime.rs

//! Doldrums runtime. This will be linked into every compiled Doldrums program.

use std::alloc::{alloc, Layout};
use std::ffi::CStr;
use std::os::raw::c_char;
use std::ptr;

//// FunctionPtrs and Values /////

/// pointer to a Doldrums function returning a Value
type FunctionPtr = unsafe extern "C" fn(*mut *mut Value) -> *mut Value;

/// a Value contains a tag (see below) followed by three (optional) u64 fields (a, b, c)
/// this is done to ensure a consistent representation, which simplifies handling
#[repr(C)]
pub struct Value {
    tag: u64,
    a: u64,
    b: u64,
    c: u64,
}

/// below is documented the meaning of each additional Value field

/// _ _ _
const TAG_UNIT: u64 = 0;
/// (int value) _ _
const TAG_INT: u64 = 1;
/// (*const c_char) _ _
const TAG_STRING: u64 = 2;
/// (constructor tag) (arity) (*const c_char name)
const TAG_CONSTRUCTOR: u64 = 3;
/// (constructor tag) (number of args already applied) (*mut *mut Value array of args)
const TAG_APP_CONSTRUCTOR: u64 = 4;
/// (FunctionPtr) (environment length) (*mut *mut Value array of environment)
const TAG_THUNK: u64 = 5;
/// (FunctionPtr) (arity | environment length [packed]) (*mut *mut Value array of environment|args)
const TAG_FUNCTION: u64 = 6;
const TAG_DOUBLE: u64 = 7;

///// type tags /////

/// type tags (globally unique identifiers for typeclass dispatch)
/// must match the order of data declarations in the prelude:
///   Bool=0, Ordering=1, Maybe=2, List=3, IO=4
const TYPE_TAG_BOOL: u64 = 100;
const TYPE_TAG_ORDERING: u64 = 101;
const TYPE_TAG_LIST: u64 = 103;
const TYPE_TAG_IO: u64 = 104;

/// return a unique type ID for a value, used for instance method dispatch.
/// Int = 0, String = 1, Double = 2, Unit = 3,
/// Constructor/AppConstructor = 100 + constructor_tag (globally unique).
#[no_mangle]
pub unsafe extern "C" fn type_id(v: *mut Value) -> *mut Value {
    let v = force(v);
    let val = &*v;
    let id: i64 = match val.tag {
        TAG_INT => 0,
        TAG_STRING => 1,
        TAG_DOUBLE => 2,
        TAG_UNIT => 3,
        TAG_CONSTRUCTOR => (val.a >> 32) as i64,
        TAG_APP_CONSTRUCTOR => (val.a >> 32) as i64,
        _ => 9999,
    };
    doldrums_int(id)
}

///// Packing and unpacking arity and env_len /////

/// use bottom bits for arity, top bits for env_len
fn pack_arity_env(arity: u64, env_len: u64) -> u64 {
    arity | (env_len << 32)
}

/// grab bottom bits for arity
fn unpack_arity(packed: u64) -> u64 {
    packed & 0xFFFFFFFF
}

/// grab top bits for env_len
fn unpack_env_len(packed: u64) -> u64 {
    packed >> 32
}

///// Allocating Doldrums values on the heap ////

/// allocate a new Value on the Doldrums heap
fn alloc_value(tag: u64, a: u64, b: u64, c: u64) -> *mut Value {
    unsafe {
        let layout = Layout::new::<Value>();
        let ptr = alloc(layout) as *mut Value;
        if ptr.is_null() {
            std::process::abort();
        }
        ptr::write(ptr, Value { tag, a, b, c });
        ptr
    }
}

/// create a Doldrums `Int` value from an i64
/// this is done by allocating a `Value` on the heap
/// each `Value` has a uniform representation
/// for `Int`, that means the `a` field is set to the value of the integer itself
#[no_mangle]
pub unsafe extern "C" fn doldrums_int(x: i64) -> *mut Value {
    alloc_value(TAG_INT, x as u64, 0, 0)
}

/// create a Doldrums `Double` value from an f64 (bits stored in a field)
#[no_mangle]
pub unsafe extern "C" fn doldrums_double(x: i64) -> *mut Value {
    alloc_value(TAG_DOUBLE, x as u64, 0, 0)
}

/// create a Doldrums `String` by copying from a pointer with a length
#[no_mangle]
pub unsafe extern "C" fn doldrums_string(s: *const u8, len: u64) -> *mut Value {
    let layout = Layout::array::<u8>(len as usize + 1).unwrap();
    let copy = alloc(layout) as *mut u8;
    if copy.is_null() {
        std::process::abort();
    }
    ptr::copy_nonoverlapping(s, copy, len as usize);
    *copy.add(len as usize) = 0;
    alloc_value(TAG_STRING, copy as u64, 0, 0)
}

/// create a Doldrums `()`
#[no_mangle]
pub unsafe extern "C" fn doldrums_unit() -> *mut Value {
    alloc_value(TAG_UNIT, 0, 0, 0)
}

/// create a Doldrums constructor (tag, arity, type_tag, name)
/// the type_tag and constructor tag are packed into the `a` field:
///   low 32 bits = constructor tag (per-data-type index)
///   high 32 bits = type tag (globally unique type identifier)
#[no_mangle]
pub unsafe extern "C" fn doldrums_constructor(
    tag: u64,
    arity: u64,
    type_tag: u64,
    name: *const c_char,
) -> *mut Value {
    let packed_a = (type_tag << 32) | (tag & 0xFFFFFFFF);
    alloc_value(TAG_CONSTRUCTOR, packed_a, arity, name as u64)
}

/// create a Doldrums thunk
/// `fun` is the function to call when the thunk is forced
/// `env_len` is the number of elements in `env`
#[no_mangle]
pub unsafe extern "C" fn doldrums_thunk(
    fun: FunctionPtr,
    env_len: u64,
    env: *mut *mut Value,
) -> *mut Value {
    alloc_value(TAG_THUNK, fun as u64, env_len, env as u64)
}

/// create a Doldrums function
/// `fun` is the function to call when all arguments are applied
/// (i.e. when the function is called with its last argument, arity == 1)
/// `arity` is the total number of arguments to the function
/// `env_len` is the number of elements in `env`
#[no_mangle]
pub unsafe extern "C" fn doldrums_function(
    fun: FunctionPtr,
    arity: u64,
    env_len: u64,
    env: *mut *mut Value,
) -> *mut Value {
    alloc_value(
        TAG_FUNCTION,
        fun as u64,
        pack_arity_env(arity, env_len),
        env as u64,
    )
}

///// Environment management /////

/// allocate a zero-initialized env array of the given size on the heap
/// the caller must ensure the allocated memory is not freed while any thunk references it
#[no_mangle]
pub unsafe extern "C" fn allocate_environment(n: u64) -> *mut *mut Value {
    let layout = Layout::array::<*mut Value>(n as usize).unwrap();
    let env = alloc(layout) as *mut *mut Value;
    if env.is_null() {
        std::process::abort();
    }
    for i in 0..n as usize {
        ptr::write(env.add(i), std::ptr::null_mut());
    }
    env
}

/// add a new pointer to Value to the env array
#[no_mangle]
pub unsafe extern "C" fn extend_environment(
    env: *mut *mut Value,
    env_len: u64,
    val: *mut Value,
) -> *mut *mut Value {
    let new_len = env_len + 1;
    let layout = Layout::array::<*mut Value>(new_len as usize).unwrap();
    let new_env = alloc(layout) as *mut *mut Value;
    if new_env.is_null() {
        std::process::abort();
    }
    if !env.is_null() {
        ptr::copy_nonoverlapping(env, new_env, env_len as usize);
    }
    *new_env.add(env_len as usize) = val;
    new_env
}

///// evaluation /////

/// force a value to WHNF
/// if the value is a thunk, evaluate it
/// return a pointer to the evaluated value
#[no_mangle]
#[inline(never)]
pub unsafe extern "C" fn force(mut v: *mut Value) -> *mut Value {
    loop {
        let val = &*v;
        if val.tag != TAG_THUNK {
            return v;
        }
        let fun: FunctionPtr = std::mem::transmute(val.a);
        let env_len = val.b;
        let env = if env_len == 0 {
            std::ptr::null_mut()
        } else {
            val.c as *mut *mut Value
        };
        let result = fun(env);
        if result != v {
            v = result;
        } else {
            return v;
        }
    }
}

/// apply a function to an argument
///
/// TAG_FUNCTION: partially apply if arity > 1, fully apply (call fn) if arity == 1
/// TAG_CONSTRUCTOR: accumulate arguments in APP_CONSTRUCTOR
/// TAG_APP_CONSTRUCTOR: extend the args array
#[no_mangle]
pub unsafe extern "C" fn apply(f: *mut Value, arg: *mut Value) -> *mut Value {
    let f = force(f);
    let val = &*f;
    match val.tag {
        TAG_FUNCTION => {
            let fun: FunctionPtr = std::mem::transmute(val.a);
            let packed = val.b;
            let arity = unpack_arity(packed);
            let env_len = unpack_env_len(packed);
            let env = val.c as *mut *mut Value;

            let res = if arity == 1 {
                let new_env = extend_environment(env, env_len, arg);
                fun(new_env)
            } else {
                let new_env = extend_environment(env, env_len, arg);
                alloc_value(
                    TAG_FUNCTION,
                    val.a,
                    pack_arity_env(arity - 1, env_len + 1),
                    new_env as u64,
                )
            };
            res
        }
        TAG_CONSTRUCTOR => {
            let name_ptr = val.c as *const c_char;
            let args_layout = Layout::array::<*mut Value>(2).unwrap();
            let args = alloc(args_layout) as *mut *mut Value;
            if args.is_null() {
                std::process::abort();
            }
            *args = name_ptr as *mut Value;
            *args.add(1) = arg;
            alloc_value(TAG_APP_CONSTRUCTOR, val.a, 1, args as u64)
        }
        TAG_APP_CONSTRUCTOR => {
            let num_args = val.b;
            let old_args = val.c as *mut *mut Value;
            let new_num = num_args + 1;
            let layout = Layout::array::<*mut Value>(new_num as usize + 1).unwrap();
            let new_args = alloc(layout) as *mut *mut Value;
            if new_args.is_null() {
                std::process::abort();
            }
            ptr::copy_nonoverlapping(old_args, new_args, (num_args as usize) + 1);
            *new_args.add((num_args as usize) + 1) = arg;
            alloc_value(TAG_APP_CONSTRUCTOR, val.a, new_num, new_args as u64)
        }
        _ => {
            std::process::abort();
        }
    }
}

///// primitive functions (to end of file) /////

/// +
#[no_mangle]
pub unsafe extern "C" fn primitive_add_num(x: *mut Value) -> *mut Value {
    let env = extend_environment(std::ptr::null_mut(), 0, x);
    doldrums_function(add_num_continuation as FunctionPtr, 1, 1, env)
}

/// each primitive function is supported by a continuation function pointer
/// for doldrums_function to use
unsafe extern "C" fn add_num_continuation(env: *mut *mut Value) -> *mut Value {
    let a = force(*env);
    let b = force(*env.add(1));
    if (*a).tag == TAG_DOUBLE || (*b).tag == TAG_DOUBLE {
        doldrums_double(f64::to_bits(to_f64(a) + to_f64(b)) as i64)
    } else {
        doldrums_int(to_i64(a).wrapping_add(to_i64(b)))
    }
}

/// -
#[no_mangle]
pub unsafe extern "C" fn primitive_subtract_num(x: *mut Value) -> *mut Value {
    let env = extend_environment(std::ptr::null_mut(), 0, x);
    doldrums_function(subtract_num_continuation as FunctionPtr, 1, 1, env)
}

unsafe extern "C" fn subtract_num_continuation(env: *mut *mut Value) -> *mut Value {
    let a = force(*env);
    let b = force(*env.add(1));
    if (*a).tag == TAG_DOUBLE || (*b).tag == TAG_DOUBLE {
        doldrums_double(f64::to_bits(to_f64(a) - to_f64(b)) as i64)
    } else {
        doldrums_int(to_i64(a).wrapping_sub(to_i64(b)))
    }
}

/// *
#[no_mangle]
pub unsafe extern "C" fn primitive_multiply_num(x: *mut Value) -> *mut Value {
    let env = extend_environment(std::ptr::null_mut(), 0, x);
    doldrums_function(multiply_num_continuation as FunctionPtr, 1, 1, env)
}

unsafe extern "C" fn multiply_num_continuation(env: *mut *mut Value) -> *mut Value {
    let a = force(*env);
    let b = force(*env.add(1));
    if (*a).tag == TAG_DOUBLE || (*b).tag == TAG_DOUBLE {
        doldrums_double(f64::to_bits(to_f64(a) * to_f64(b)) as i64)
    } else {
        doldrums_int(to_i64(a).wrapping_mul(to_i64(b)))
    }
}

/// /
#[no_mangle]
pub unsafe extern "C" fn primitive_divide_num(x: *mut Value) -> *mut Value {
    let env = extend_environment(std::ptr::null_mut(), 0, x);
    doldrums_function(divide_num_continuation as FunctionPtr, 1, 1, env)
}

unsafe extern "C" fn divide_num_continuation(env: *mut *mut Value) -> *mut Value {
    let a = force(*env);
    let b = force(*env.add(1));
    if (*a).tag == TAG_DOUBLE || (*b).tag == TAG_DOUBLE {
        doldrums_double(f64::to_bits(to_f64(a) / to_f64(b)) as i64)
    } else {
        doldrums_int(to_i64(a).wrapping_div(to_i64(b)))
    }
}

/// ==
#[no_mangle]
pub unsafe extern "C" fn primitive_eq_num(x: *mut Value) -> *mut Value {
    let env = extend_environment(std::ptr::null_mut(), 0, x);
    doldrums_function(eq_num_continuation as FunctionPtr, 1, 1, env)
}

unsafe extern "C" fn eq_num_continuation(env: *mut *mut Value) -> *mut Value {
    let a = force(*env);
    let b = force(*env.add(1));
    let eq = if (*a).tag == TAG_DOUBLE || (*b).tag == TAG_DOUBLE {
        to_f64(a) == to_f64(b)
    } else {
        to_i64(a) == to_i64(b)
    };
    let true_name = CStr::from_bytes_with_nul_unchecked(b"True\0");
    let false_name = CStr::from_bytes_with_nul_unchecked(b"False\0");
    if eq {
        doldrums_constructor(0, 0, TYPE_TAG_BOOL, true_name.as_ptr())
    } else {
        doldrums_constructor(1, 0, TYPE_TAG_BOOL, false_name.as_ptr())
    }
}

/// /=
#[no_mangle]
pub unsafe extern "C" fn primitive_neq_num(x: *mut Value) -> *mut Value {
    let env = extend_environment(std::ptr::null_mut(), 0, x);
    doldrums_function(neq_num_continuation as FunctionPtr, 1, 1, env)
}

unsafe extern "C" fn neq_num_continuation(env: *mut *mut Value) -> *mut Value {
    let a = force(*env);
    let b = force(*env.add(1));
    let neq = if (*a).tag == TAG_DOUBLE || (*b).tag == TAG_DOUBLE {
        to_f64(a) != to_f64(b)
    } else {
        to_i64(a) != to_i64(b)
    };
    let true_name = CStr::from_bytes_with_nul_unchecked(b"True\0");
    let false_name = CStr::from_bytes_with_nul_unchecked(b"False\0");
    if neq {
        doldrums_constructor(0, 0, TYPE_TAG_BOOL, true_name.as_ptr())
    } else {
        doldrums_constructor(1, 0, TYPE_TAG_BOOL, false_name.as_ptr())
    }
}

/// compare
#[no_mangle]
pub unsafe extern "C" fn primitive_compare_num(x: *mut Value) -> *mut Value {
    let env = extend_environment(std::ptr::null_mut(), 0, x);
    doldrums_function(compare_num_continuation as FunctionPtr, 1, 1, env)
}

unsafe extern "C" fn compare_num_continuation(env: *mut *mut Value) -> *mut Value {
    let a = force(*env);
    let b = force(*env.add(1));
    let lt_name = CStr::from_bytes_with_nul_unchecked(b"LT\0");
    let eq_name = CStr::from_bytes_with_nul_unchecked(b"EQ\0");
    let gt_name = CStr::from_bytes_with_nul_unchecked(b"GT\0");
    let ord = if (*a).tag == TAG_DOUBLE || (*b).tag == TAG_DOUBLE {
        to_f64(a).partial_cmp(&to_f64(b))
    } else {
        Some(to_i64(a).cmp(&to_i64(b)))
    };
    match ord {
        Some(std::cmp::Ordering::Less) => {
            doldrums_constructor(0, 0, TYPE_TAG_ORDERING, lt_name.as_ptr())
        }
        Some(std::cmp::Ordering::Equal) => {
            doldrums_constructor(1, 0, TYPE_TAG_ORDERING, eq_name.as_ptr())
        }
        Some(std::cmp::Ordering::Greater) => {
            doldrums_constructor(2, 0, TYPE_TAG_ORDERING, gt_name.as_ptr())
        }
        None => doldrums_constructor(1, 0, TYPE_TAG_ORDERING, eq_name.as_ptr()),
    }
}

/// putStrLn
#[no_mangle]
pub unsafe extern "C" fn primitive_putStrLn(s: *mut Value) -> *mut Value {
    let v = force(s);
    let val = &*v;
    if val.tag != TAG_STRING {
        std::process::abort();
    }
    let c_str = val.a as *const c_char;
    let rust_str = CStr::from_ptr(c_str).to_str().unwrap();
    println!("{}", rust_str);
    return_io_unit()
}

/// print
#[no_mangle]
pub unsafe extern "C" fn primitive_print(v: *mut Value) -> *mut Value {
    let v = force(v);
    let s = value_to_string(v);
    println!("{}", s);
    return_io_unit()
}

/// show
#[no_mangle]
pub unsafe extern "C" fn primitive_show(v: *mut Value) -> *mut Value {
    let v = force(v);
    let s = value_to_string(v);
    doldrums_string(s.as_ptr(), s.len() as u64)
}

/// <>
#[no_mangle]
pub unsafe extern "C" fn primitive_append_string(x: *mut Value) -> *mut Value {
    let env = extend_environment(std::ptr::null_mut(), 0, x);
    doldrums_function(append_string_continuation as FunctionPtr, 1, 1, env)
}

unsafe extern "C" fn append_string_continuation(env: *mut *mut Value) -> *mut Value {
    let a = force(*env);
    let b = force(*env.add(1));
    if (*a).tag != TAG_STRING || (*b).tag != TAG_STRING {
        std::process::abort();
    }
    let a_str = CStr::from_ptr((*a).a as *const c_char).to_str().unwrap();
    let b_str = CStr::from_ptr((*b).a as *const c_char).to_str().unwrap();
    let result = format!("{}{}", a_str, b_str);
    doldrums_string(result.as_ptr(), result.len() as u64)
}

/// lines
#[no_mangle]
pub unsafe extern "C" fn primitive_lines(x: *mut Value) -> *mut Value {
    string_to_list(x, |s| s.lines().collect())
}

/// words
#[no_mangle]
pub unsafe extern "C" fn primitive_words(x: *mut Value) -> *mut Value {
    string_to_list(x, |s| s.split_whitespace().collect())
}

/// floor
#[no_mangle]
pub unsafe extern "C" fn primitive_floor(x: *mut Value) -> *mut Value {
    let v = force(x);
    if (*v).tag != TAG_DOUBLE {
        std::process::abort();
    }
    let d = f64::from_bits((*v).a);
    doldrums_int(d.floor() as i64)
}

/// ceiling
#[no_mangle]
pub unsafe extern "C" fn primitive_ceiling(x: *mut Value) -> *mut Value {
    let v = force(x);
    if (*v).tag != TAG_DOUBLE {
        std::process::abort();
    }
    let d = f64::from_bits((*v).a);
    doldrums_int(d.ceil() as i64)
}

/// round
#[no_mangle]
pub unsafe extern "C" fn primitive_round(x: *mut Value) -> *mut Value {
    let v = force(x);
    if (*v).tag != TAG_DOUBLE {
        std::process::abort();
    }
    let d = f64::from_bits((*v).a);
    doldrums_int(d.round() as i64)
}

/// pure :: a -> IO a
#[no_mangle]
pub unsafe extern "C" fn primitive_pure_io(x: *mut Value) -> *mut Value {
    let io_name = CStr::from_bytes_with_nul_unchecked(b"IO\0");
    let io_cons = doldrums_constructor(1, 1, TYPE_TAG_IO, io_name.as_ptr());
    apply(io_cons, x)
}

#[no_mangle]
pub unsafe extern "C" fn primitive_unlines(x: *mut Value) -> *mut Value {
    list_to_string(x, |strings| strings.join("\n") + "\n")
}

#[no_mangle]
pub unsafe extern "C" fn primitive_unwords(x: *mut Value) -> *mut Value {
    list_to_string(x, |strings| strings.join(" "))
}

///// helpers for primitives /////

#[inline]
unsafe fn to_f64(v: *mut Value) -> f64 {
    match (*v).tag {
        TAG_DOUBLE => f64::from_bits((*v).a),
        TAG_INT => (*v).a as i64 as f64,
        _ => 0.0,
    }
}

#[inline]
unsafe fn to_i64(v: *mut Value) -> i64 {
    (*v).a as i64
}

/// return a doldrums `IO ()` Value
unsafe fn return_io_unit() -> *mut Value {
    let unit = doldrums_unit();
    let io_name = CStr::from_bytes_with_nul_unchecked(b"IO\0");
    let io_cons = doldrums_constructor(1, 1, TYPE_TAG_IO, io_name.as_ptr());
    apply(io_cons, unit)
}

/// find constructor names for applied or unapplied constructors
fn get_cons_name(v: *mut Value) -> Option<String> {
    unsafe {
        let val = &*v;
        match val.tag {
            TAG_CONSTRUCTOR => {
                let name_ptr = val.c as *const c_char;
                if name_ptr.is_null() {
                    None
                } else {
                    Some(CStr::from_ptr(name_ptr).to_str().unwrap().to_string())
                }
            }
            TAG_APP_CONSTRUCTOR => {
                let args = val.c as *mut *mut Value;
                let name_ptr = *args as *const c_char;
                if name_ptr.is_null() {
                    None
                } else {
                    Some(CStr::from_ptr(name_ptr).to_str().unwrap().to_string())
                }
            }
            _ => None,
        }
    }
}

/// detect whether a `show` on a Doldrums value needs parentheses
fn needs_parens(v: *mut Value) -> bool {
    unsafe {
        let val = &*v;
        if val.tag == TAG_APP_CONSTRUCTOR {
            if let Some(name) = get_cons_name(v) {
                if name == "Cons" {
                    return false;
                }
            }
            return true;
        }
        false
    }
}

/// `show` with [1,2,3] list syntax supported
fn show_list(v: *mut Value) -> Option<String> {
    unsafe {
        let name = get_cons_name(v)?;
        if name != "Cons" {
            return None;
        }
        let mut elements: Vec<String> = Vec::new();
        let mut current = v;
        loop {
            let cur_val = &*current;
            match cur_val.tag {
                TAG_APP_CONSTRUCTOR => {
                    let cur_args = cur_val.c as *mut *mut Value;
                    let cur_name_ptr = *cur_args as *const c_char;
                    let cur_name = CStr::from_ptr(cur_name_ptr).to_str().unwrap();
                    if cur_name != "Cons" {
                        return None;
                    }
                    let head = force(*cur_args.add(1));
                    elements.push(value_to_string(head));
                    current = force(*cur_args.add(2));
                }
                TAG_CONSTRUCTOR => {
                    let cur_name_ptr = cur_val.c as *const c_char;
                    let cur_name = CStr::from_ptr(cur_name_ptr).to_str().unwrap();
                    if cur_name == "Nil" {
                        return Some(format!("[{}]", elements.join(",")));
                    }
                    return None;
                }
                _ => return None,
            }
        }
    }
}

fn value_to_string(v: *mut Value) -> String {
    unsafe {
        let val = &*v;
        match val.tag {
            TAG_INT => format!("{}", val.a as i64),
            TAG_DOUBLE => {
                let d = f64::from_bits(val.a);
                let s = format!("{}", d);
                if s.contains('.') {
                    s
                } else {
                    format!("{}.0", d as i64)
                }
            }
            TAG_STRING => {
                let c_str = val.a as *const c_char;
                let s = CStr::from_ptr(c_str).to_str().unwrap();
                format!("\"{}\"", s.escape_default())
            }
            TAG_CONSTRUCTOR => {
                let name_ptr = val.c as *const c_char;
                if name_ptr.is_null() {
                    format!("<constructor {}>", val.a)
                } else {
                    let name = CStr::from_ptr(name_ptr).to_str().unwrap().to_string();
                    if name == "Nil" {
                        "[]".to_string()
                    } else {
                        name
                    }
                }
            }
            TAG_APP_CONSTRUCTOR => {
                if let Some(s) = show_list(v) {
                    return s;
                }
                let num_args = val.b;
                let args = val.c as *mut *mut Value;
                let name_ptr = *args as *const c_char;
                let name = if name_ptr.is_null() {
                    format!("<constructor {}>", val.a)
                } else {
                    CStr::from_ptr(name_ptr).to_str().unwrap().to_string()
                };
                if name.starts_with("Tuple") && name.len() > 5 {
                    let mut result = String::from("(");
                    for i in 0..num_args as usize {
                        if i > 0 { result.push_str(", "); }
                        let arg_val = force(*args.add(i + 1));
                        let arg_str = value_to_string(arg_val);
                        result.push_str(&arg_str);
                    }
                    result.push(')');
                    result
                } else {
                    let mut result = name;
                    for i in 0..num_args as usize {
                        result.push(' ');
                        let arg_val = force(*args.add(i + 1));
                        let arg_str = value_to_string(arg_val);
                        if needs_parens(arg_val) {
                            result.push('(');
                            result.push_str(&arg_str);
                            result.push(')');
                        } else {
                            result.push_str(&arg_str);
                        }
                    }
                    result
                }
            }
            TAG_UNIT => "()".to_string(),
            TAG_FUNCTION => "<function>".to_string(),
            TAG_THUNK => "<thunk>".to_string(),
            _ => format!("<value {}>", val.tag),
        }
    }
}

unsafe fn string_to_list(s_ptr: *mut Value, split_fn: impl Fn(&str) -> Vec<&str>) -> *mut Value {
    let s = force(s_ptr);
    if (*s).tag != TAG_STRING {
        std::process::abort();
    }
    let s_str = CStr::from_ptr((*s).a as *const c_char).to_str().unwrap();
    let items = split_fn(s_str);
    let nil_name = CStr::from_bytes_with_nul_unchecked(b"Nil\0");
    let cons_name = CStr::from_bytes_with_nul_unchecked(b"Cons\0");
    let mut result = std::ptr::null_mut::<Value>();
    for item in items.into_iter().rev() {
        let item_val = doldrums_string(item.as_ptr(), item.len() as u64);
        let cons = doldrums_constructor(1, 2, TYPE_TAG_LIST, cons_name.as_ptr());
        let applied = apply(cons, item_val);
        if result.is_null() {
            result = doldrums_constructor(0, 0, TYPE_TAG_LIST, nil_name.as_ptr());
        }
        result = apply(applied, result);
    }
    if result.is_null() {
        doldrums_constructor(0, 0, TYPE_TAG_LIST, nil_name.as_ptr())
    } else {
        result
    }
}

unsafe fn list_to_string(x: *mut Value, join_fn: impl Fn(Vec<String>) -> String) -> *mut Value {
    let list = force(x);
    let mut strings: Vec<String> = Vec::new();
    let mut current = list;
    loop {
        let val = &*current;
        if val.tag == TAG_CONSTRUCTOR && (val.a & 0xFFFFFFFF) == 0 {
            break;
        } else if val.tag == TAG_APP_CONSTRUCTOR && (val.a & 0xFFFFFFFF) == 1 {
            let args = val.c as *mut *mut Value;
            let head = force(*args.add(1));
            if (*head).tag != TAG_STRING {
                std::process::abort();
            }
            let s = CStr::from_ptr((*head).a as *const c_char).to_str().unwrap();
            strings.push(s.to_string());
            current = force(*args.add(2));
        } else {
            std::process::abort();
        }
    }
    let result = join_fn(strings);
    doldrums_string(result.as_ptr(), result.len() as u64)
}