eclisp 0.2.0

Bindings for Embeddable Common Lisp
use std::{
    any::TypeId,
    cell::{Cell, RefCell},
    collections::HashMap,
    ptr::NonNull,
    rc::Rc,
};

use crate::{Lisp, LispContext, LispError, Value, sys};

thread_local! {
    static NEXT_SCOPE: Cell<u64> = const { Cell::new(1) };
    static SCOPES: RefCell<HashMap<u64, Rc<ScopeState>>> = RefCell::new(HashMap::new());
    static CURRENT_SCOPE: Cell<Option<u64>> = const { Cell::new(None) };
}

struct ScopeState {
    borrowed: Cell<bool>,
    start: usize,
    end: usize,
}

#[repr(C)]
struct ScopedPointerCell {
    type_id: TypeId,
    pointer: Option<NonNull<()>>,
    scope_id: u64,
}

fn new_handle<'rt, T: 'static>(
    runtime: &'rt Lisp,
    value: &mut T,
    scope_id: u64,
) -> Result<Value<'rt>, LispError> {
    let mut root = std::ptr::null_mut();
    let status =
        unsafe { sys::eclisp_scoped_pointer_new(size_of::<ScopedPointerCell>(), &mut root) };

    if status != sys::ECLISP_OK {
        return Err(LispError::RuntimeError(format!(
            "Failed to create scoped pointer: {status}"
        )));
    }

    let root =
        NonNull::new(root).ok_or_else(|| LispError::RuntimeError("Missing Lisp root".into()))?;
    let handle = unsafe { Value::from_root(runtime, root) };
    let data = unsafe {
        sys::eclisp_scoped_pointer_data(handle.as_raw(), size_of::<ScopedPointerCell>())
            .cast::<ScopedPointerCell>()
    };
    let cell = NonNull::new(data)
        .ok_or_else(|| LispError::RuntimeError("Missing scoped pointer data".into()))?;

    unsafe {
        cell.as_ptr().write(ScopedPointerCell {
            type_id: TypeId::of::<T>(),
            pointer: Some(NonNull::from(value).cast()),
            scope_id,
        });
    }
    Ok(handle)
}

pub unsafe fn with_scoped_object_pointer<T: 'static, R>(
    handle: sys::cl_object,
    callback: impl FnOnce(&mut T) -> R,
) -> Option<R> {
    let data = unsafe {
        sys::eclisp_scoped_pointer_data(handle, size_of::<ScopedPointerCell>())
            .cast::<ScopedPointerCell>()
    };
    let cell = NonNull::new(data)?;
    let cell_ref = unsafe { cell.as_ref() };

    if cell_ref.type_id != TypeId::of::<T>() {
        return None;
    }

    let state = SCOPES.with(|scopes| scopes.borrow().get(&cell_ref.scope_id).cloned())?;

    if state.borrowed.replace(true) {
        return None;
    }

    struct BorrowGuard {
        state: Rc<ScopeState>,
        previous_scope: Option<u64>,
    }

    impl Drop for BorrowGuard {
        fn drop(&mut self) {
            CURRENT_SCOPE.with(|scope| scope.set(self.previous_scope));
            self.state.borrowed.set(false);
        }
    }

    let previous_scope = CURRENT_SCOPE.with(|scope| scope.replace(Some(cell_ref.scope_id)));
    let _guard = BorrowGuard {
        state,
        previous_scope,
    };

    let pointer = cell_ref.pointer?.cast::<T>();
    Some(callback(unsafe { &mut *pointer.as_ptr() }))
}

pub(crate) fn scoped_child<'rt, T: 'static>(
    ctx: &LispContext<'rt>,
    value: &mut T,
    class: &str,
) -> Result<Value<'rt>, LispError> {
    let scope_id = CURRENT_SCOPE.with(|scope| scope.get()).ok_or_else(|| {
        LispError::RuntimeError("A class reference requires an active scoped object".into())
    })?;

    let state = SCOPES
        .with(|scopes| scopes.borrow().get(&scope_id).cloned())
        .ok_or_else(|| LispError::RuntimeError("Expired scoped object".into()))?;

    let start = value as *mut T as usize;
    let end = start
        .checked_add(size_of::<T>())
        .ok_or_else(|| LispError::RuntimeError("Invalid child object size".into()))?;

    if size_of::<T>() == 0 || start < state.start || end > state.end {
        return Err(LispError::RuntimeError(
            "Class reference is not an embedded field of the active object".into(),
        ));
    }

    let handle_value = new_handle(ctx.runtime, value, scope_id)?;
    let class_value = ctx.eval(format!("'{class}"))?;
    let keyword = ctx.eval(":handle")?;

    ctx.call("make-instance", &[&class_value, &keyword, &handle_value])
}

pub(crate) unsafe extern "C" fn scoped_pointer_valid<T: 'static>(
    handle: sys::cl_object,
) -> sys::cl_object {
    if unsafe { with_scoped_object_pointer::<T, _>(handle, |_| ()) }.is_some() {
        unsafe { sys::eclisp_t_raw() }
    } else {
        unsafe { sys::eclisp_nil_raw() }
    }
}

pub(crate) unsafe extern "C" fn native_failure_p(object: sys::cl_object) -> sys::cl_object {
    if unsafe { sys::eclisp_is_native_failure(object) } != 0 {
        unsafe { sys::eclisp_t_raw() }
    } else {
        unsafe { sys::eclisp_nil_raw() }
    }
}

pub(crate) struct ScopedObject<'rt> {
    handle: Value<'rt>,
    scope_id: u64,
}

impl<'rt> ScopedObject<'rt> {
    pub(crate) fn new<T: 'static>(runtime: &'rt Lisp, value: &mut T) -> Result<Self, LispError> {
        let scope_id = NEXT_SCOPE.with(|next| {
            let id = next.get();
            next.set(id.checked_add(1).expect("Scoped object ID overflow"));
            id
        });

        let start = value as *mut T as usize;
        let end = start
            .checked_add(size_of::<T>())
            .ok_or_else(|| LispError::RuntimeError("Invalid scoped object size".into()))?;
        let handle = new_handle(runtime, value, scope_id)?;

        SCOPES.with(|scopes| {
            scopes.borrow_mut().insert(
                scope_id,
                Rc::new(ScopeState {
                    borrowed: Cell::new(false),
                    start,
                    end,
                }),
            );
        });

        Ok(Self { handle, scope_id })
    }

    pub(crate) fn handle(&self) -> &Value<'rt> {
        &self.handle
    }
}

impl Drop for ScopedObject<'_> {
    fn drop(&mut self) {
        SCOPES.with(|scopes| {
            scopes.borrow_mut().remove(&self.scope_id);
        });
    }
}