use std::{
ffi::{CStr, CString},
ptr::{self, NonNull},
rc::Rc,
};
use crate::{
Function, Lisp, LispError, Value, ValueRef,
clos::{Class, LispClass, MethodKind, Methods, ObjectId, ScopedObject, scoped_pointer_valid},
sys,
};
macro_rules! native_functions {
($($name:ident($arity:literal, $($arg:ident),+));+ $(;)?) => {
$(
pub fn $name(
&self,
name: &str,
callback: unsafe extern "C" fn($(native_functions!(@type $arg)),+) -> sys::cl_object,
) -> Result<(), LispError> {
if !valid_symbol(name) {
return Err(LispError::InvalidSymbol(name.to_string()));
}
let name = CString::new(name.to_ascii_uppercase()).unwrap();
let callback = unsafe {
std::mem::transmute::<
unsafe extern "C" fn($(native_functions!(@type $arg)),+) -> sys::cl_object,
unsafe extern "C" fn() -> sys::cl_object,
>(callback)
};
unsafe {
let symbol = sys::ecl_make_symbol(name.as_ptr(), c"CL-USER".as_ptr());
sys::ecl_def_c_function(symbol, Some(callback), $arity);
}
Ok(())
}
)+
};
(@type $arg:ident) => {
sys::cl_object
};
}
#[macro_export]
macro_rules! register_functions {
($ctx:expr, $($name:literal => $callback:expr),+ $(,)?) => {{
$(
$ctx.defun($name, $callback)?;
)+
Ok::<(), eclisp::LispError>(())
}};
}
#[macro_export]
macro_rules! defun_native {
($ctx:expr, $name:expr, $callback:expr; ()) => {
$ctx.defun_native_0($name, $callback)
};
($ctx:expr, $name:expr, $callback:expr; ($a:tt)) => {
$ctx.defun_native_1($name, $callback)
};
($ctx:expr, $name:expr, $callback:expr; ($a:tt, $b:tt)) => {
$ctx.defun_native_2($name, $callback)
};
($ctx:expr, $name:expr, $callback:expr; ($a:tt, $b:tt, $c:tt)) => {
$ctx.defun_native_3($name, $callback)
};
($ctx:expr, $name:expr, $callback:expr; ($a:tt, $b:tt, $c:tt, $d:tt)) => {
$ctx.defun_native_4($name, $callback)
};
($ctx:expr, $name:expr, $callback:expr; ($a:tt, $b:tt, $c:tt, $d:tt, $e:tt)) => {
$ctx.defun_native_5($name, $callback)
};
($ctx:expr, $name:expr, $callback:expr; ($a:tt, $b:tt, $c:tt, $d:tt, $e:tt, $f:tt)) => {
$ctx.defun_native_6($name, $callback)
};
($ctx:expr, $name:expr, $callback:expr; ($a:tt, $b:tt, $c:tt, $d:tt, $e:tt, $f:tt, $g:tt)) => {
$ctx.defun_native_7($name, $callback)
};
($ctx:expr, $name:expr, $callback:expr; ($a:tt, $b:tt, $c:tt, $d:tt, $e:tt, $f:tt, $g:tt, $h:tt)) => {
$ctx.defun_native_8($name, $callback)
};
}
#[derive(Clone, Copy)]
pub struct LispContext<'rt> {
pub(crate) runtime: &'rt Lisp,
}
impl<'rt> LispContext<'rt> {
pub fn load(&self, code: impl AsRef<str>) -> Result<(), LispError> {
self.eval(code).map(|_| ())
}
pub fn root(&self, value: ValueRef<'_>) -> Result<Value<'rt>, LispError> {
let mut root = std::ptr::null_mut();
let success = unsafe { sys::eclisp_root_copy(value.as_raw(), &mut root) };
if success == 0 {
return Err(LispError::RuntimeError("Failed to create Lisp root".into()));
}
let root = NonNull::new(root)
.ok_or_else(|| LispError::RuntimeError("Missing Lisp root".into()))?;
Ok(unsafe { Value::from_root(self.runtime, root) })
}
pub fn eval(&self, code: impl AsRef<str>) -> Result<Value<'rt>, LispError> {
let source =
CString::new(code.as_ref()).map_err(|e| LispError::RuntimeError(e.to_string()))?;
let mut root = ptr::null_mut();
let mut error = ptr::null_mut();
let status = unsafe { sys::eclisp_eval(source.as_ptr(), &mut root, &mut error) };
if status != 0 {
let message = if error.is_null() {
format!("ECL evaluation failed: {status}")
} else {
let message = unsafe { CStr::from_ptr(error).to_string_lossy().into_owned() };
unsafe {
sys::eclisp_string_free(error);
}
message
};
return Err(LispError::RuntimeError(message));
}
let root = NonNull::new(root)
.ok_or_else(|| LispError::RuntimeError("Missing Lisp root".into()))?;
Ok(unsafe { Value::from_root(self.runtime, root) })
}
pub fn run(&self, path: impl AsRef<std::path::Path>) -> Result<Value<'rt>, LispError> {
let path = path
.as_ref()
.to_str()
.ok_or_else(|| LispError::RuntimeError("Invalid file path".into()))?;
let source =
std::fs::read_to_string(path).map_err(|e| LispError::RuntimeError(e.to_string()))?;
self.eval(source)
}
pub fn call(&self, function: &str, args: &[&Value<'_>]) -> Result<Value<'rt>, LispError> {
let function =
CString::new(function).map_err(|e| LispError::RuntimeError(e.to_string()))?;
if args.iter().any(|value| !value.belongs_to(self.runtime)) {
return Err(LispError::RuntimeError(
"Argument belongs to another Lisp runtime".into(),
));
}
let raw_args: Vec<sys::cl_object> = args.iter().map(|value| value.as_raw()).collect();
let mut root = ptr::null_mut();
let mut error = ptr::null_mut();
let status = unsafe {
sys::eclisp_call(
function.as_ptr(),
raw_args.len(),
raw_args.as_ptr(),
&mut root,
&mut error,
)
};
if status != 0 {
let message = if !error.is_null() {
let message = unsafe { CStr::from_ptr(error).to_string_lossy().into_owned() };
unsafe { sys::eclisp_string_free(error) };
message
} else if status == 3 {
format!("Unknown function: {}", function.to_string_lossy())
} else {
format!("Lisp function call failed: {status}")
};
return Err(LispError::RuntimeError(message));
}
let root = NonNull::new(root)
.ok_or_else(|| LispError::RuntimeError("Missing Lisp root".into()))?;
Ok(unsafe { Value::from_root(self.runtime, root) })
}
pub fn fun(&self, name: &str) -> Result<Option<Function<'rt>>, LispError> {
let name = CString::new(name).map_err(|e| LispError::RuntimeError(e.to_string()))?;
let mut root = ptr::null_mut();
let mut error = ptr::null_mut();
let status = unsafe { sys::eclisp_function_get(name.as_ptr(), &mut root, &mut error) };
match status {
sys::ECLISP_NOT_FOUND => Ok(None),
sys::ECLISP_OK => {
let root = NonNull::new(root)
.ok_or_else(|| LispError::RuntimeError("Missing Lisp root".into()))?;
Ok(Some(Function {
value: Rc::new(unsafe { Value::from_root(self.runtime, root) }),
}))
}
_ => {
let message = if !error.is_null() {
let message = unsafe { CStr::from_ptr(error).to_string_lossy().into_owned() };
unsafe { sys::eclisp_string_free(error) };
message
} else {
format!("Unknown function: {}", name.to_string_lossy())
};
Err(LispError::RuntimeError(message))
}
}
}
pub fn callfun(
&self,
function: &Function<'_>,
args: &[&Value<'_>],
) -> Result<Value<'rt>, LispError> {
if !function.value.belongs_to(self.runtime)
|| args.iter().any(|v| !v.belongs_to(self.runtime))
{
return Err(LispError::RuntimeError(
"Value belongs to another Lisp runtime".into(),
));
}
let raw_args: Vec<sys::cl_object> = args.iter().map(|v| v.as_raw()).collect();
let mut root = ptr::null_mut();
let mut error = ptr::null_mut();
let status = unsafe {
sys::eclisp_function_call(
function.value.as_raw(),
raw_args.len(),
raw_args.as_ptr(),
&mut root,
&mut error,
)
};
if status != 0 {
let message = if !error.is_null() {
let message = unsafe { CStr::from_ptr(error).to_string_lossy().into_owned() };
unsafe { sys::eclisp_string_free(error) };
message
} else {
format!("Lisp function call failed: {status}")
};
return Err(LispError::RuntimeError(message));
}
let root = NonNull::new(root)
.ok_or_else(|| LispError::RuntimeError("Missing Lisp root".into()))?;
Ok(unsafe { Value::from_root(self.runtime, root) })
}
pub fn wrap_object(&self, class_name: &str, id: ObjectId) -> Result<Value<'rt>, LispError> {
if !valid_symbol(class_name) {
return Err(LispError::InvalidSymbol(class_name.into()));
}
let code = format!(
"(make-instance '{class_name} :handle '({} {}))",
id.index(),
id.generation()
);
self.eval(code)
}
pub fn int(&self, value: i64) -> Result<Value<'rt>, LispError> {
let mut root = ptr::null_mut();
let status = unsafe { sys::eclisp_int_new(value, &mut root) };
self.value_from_result(status, root)
}
pub fn float(&self, value: f64) -> Result<Value<'rt>, LispError> {
let mut root = ptr::null_mut();
let status = unsafe { sys::eclisp_float_new(value, &mut root) };
self.value_from_result(status, root)
}
pub unsafe fn foreign_data<T>(&self, data: *const T) -> Result<Value<'rt>, LispError> {
let object = unsafe {
sys::ecl_make_foreign_data(
sys::eclisp_nil_raw(),
size_of::<T>() as sys::cl_index,
data.cast_mut().cast(),
)
};
let root = unsafe { sys::eclisp_root_new(object) };
let root = NonNull::new(root)
.ok_or_else(|| LispError::RuntimeError("Missing Lisp root".into()))?;
Ok(unsafe { Value::from_root(self.runtime, root) })
}
pub fn cons(&self, car: &Value<'_>, cdr: &Value<'_>) -> Result<Value<'rt>, LispError> {
if !car.belongs_to(self.runtime) || !cdr.belongs_to(self.runtime) {
return Err(LispError::RuntimeError(
"Value belongs to another Lisp runtime".into(),
));
}
let mut root = ptr::null_mut();
let status = unsafe { sys::eclisp_cons_new(car.as_raw(), cdr.as_raw(), &mut root) };
self.value_from_result(status, root)
}
pub fn list(&self, values: &[&Value<'_>]) -> Result<Value<'rt>, LispError> {
if values.iter().any(|v| !v.belongs_to(self.runtime)) {
return Err(LispError::RuntimeError(
"Value belongs to another Lisp runtime".into(),
));
}
let objects: Vec<sys::cl_object> = values.iter().map(|v| v.as_raw()).collect();
let mut root = ptr::null_mut();
let status = unsafe { sys::eclisp_list_new(objects.len(), objects.as_ptr(), &mut root) };
self.value_from_result(status, root)
}
pub fn string(&self, contents: impl AsRef<str>) -> Result<Value<'rt>, LispError> {
let bytes = contents.as_ref().as_bytes();
let mut root = ptr::null_mut();
let status =
unsafe { sys::eclisp_string_new(bytes.as_ptr().cast(), bytes.len(), &mut root) };
self.value_from_result(status, root)
}
pub fn bool(&self, value: bool) -> Result<Value<'rt>, LispError> {
let mut root = ptr::null_mut();
let status = unsafe { sys::eclisp_bool_new(&mut root, value as i32) };
self.value_from_result(status, root)
}
pub fn nil(&self) -> Result<Value<'rt>, LispError> {
let mut root = ptr::null_mut();
let status = unsafe { sys::eclisp_nil_new(&mut root) };
self.value_from_result(status, root)
}
pub fn t(&self) -> Result<Value<'rt>, LispError> {
let mut root = ptr::null_mut();
let status = unsafe { sys::eclisp_t_new(&mut root) };
self.value_from_result(status, root)
}
fn value_from_result(
&self,
status: i32,
root: *mut sys::eclisp_root,
) -> Result<Value<'rt>, LispError> {
if status != 0 {
return Err(LispError::RuntimeError(format!(
"Failed to create Lisp value: {status}"
)));
}
let root = NonNull::new(root)
.ok_or_else(|| LispError::RuntimeError("Missing Lisp root".into()))?;
Ok(unsafe { Value::from_root(self.runtime, root) })
}
}
impl LispContext<'_> {
pub fn with<T, R>(
&self,
value: &mut T,
callback: impl FnOnce(&Value<'_>) -> Result<R, LispError>,
) -> Result<R, LispError>
where
T: LispClass,
{
if !valid_symbol(T::NAME) {
return Err(LispError::InvalidSymbol(T::NAME.to_string()));
}
let scoped = ScopedObject::new(self.runtime, value)?;
let class = self.eval(format!("'{}", T::NAME))?;
let handle = self.eval(":handle")?;
let object = self.call("make-instance", &[&class, &handle, scoped.handle()])?;
callback(&object)
}
pub fn expose<T: 'static>(&self, object: T) -> ObjectId {
self.runtime.objects.borrow_mut().insert(object)
}
pub fn with_object<T: 'static, R>(&self, id: ObjectId, f: impl FnOnce(&T) -> R) -> Option<R> {
let objects = self.runtime.objects.borrow();
let object = objects.get::<T>(id)?;
Some(f(object))
}
pub fn with_object_mut<T: 'static, R>(
&self,
id: ObjectId,
f: impl FnOnce(&mut T) -> R,
) -> Option<R> {
let mut objects = self.runtime.objects.borrow_mut();
let object = objects.get_mut::<T>(id)?;
Some(f(object))
}
pub(crate) fn register_callback<F>(&self, callback: F) -> usize
where
F: for<'rt, 'call> Fn(
LispContext<'rt>,
&[ValueRef<'call>],
) -> Result<Value<'rt>, LispError>
+ 'static,
{
self.runtime
.callbacks
.borrow_mut()
.insert(Rc::new(callback))
}
pub fn defun<F>(&self, name: &str, callback: F) -> Result<(), LispError>
where
F: for<'rt, 'call> Fn(
LispContext<'rt>,
&[ValueRef<'call>],
) -> Result<Value<'rt>, LispError>
+ 'static,
{
if !valid_symbol(name) {
return Err(LispError::InvalidSymbol(name.to_string()));
}
let id = self.register_callback(callback);
let definition = format!("(defun {name} (&rest args) (%eclisp-dispatch {id} args))");
if let Err(error) = self.eval(definition) {
self.runtime.callbacks.borrow_mut().remove(id);
return Err(error);
}
Ok(())
}
pub fn defun_native_0(
&self,
name: &str,
callback: unsafe extern "C" fn() -> sys::cl_object,
) -> Result<(), LispError> {
if !valid_symbol(name) {
return Err(LispError::InvalidSymbol(name.to_string()));
}
let name = CString::new(name.to_ascii_uppercase()).unwrap();
unsafe {
let symbol = sys::ecl_make_symbol(name.as_ptr(), c"CL-USER".as_ptr());
sys::ecl_def_c_function(symbol, Some(callback), 0);
}
Ok(())
}
native_functions! {
defun_native_1(1, a);
defun_native_2(2, a, b);
defun_native_3(3, a, b, c);
defun_native_4(4, a, b, c, d);
defun_native_5(5, a, b, c, d, e);
defun_native_6(6, a, b, c, d, e, f);
defun_native_7(7, a, b, c, d, e, f, g);
defun_native_8(8, a, b, c, d, e, f, g, h);
}
pub fn defclass<T: LispClass>(&self, class: Class<T>) -> Result<(), LispError> {
class.validate_implementations()?;
let name = class.name();
if !valid_symbol(name) {
return Err(LispError::InvalidSymbol(name.to_string()));
}
if name != T::NAME {
return Err(LispError::RuntimeError(format!(
"Class name {name} does not match {}",
T::NAME
)));
}
for property in class.properties() {
if !valid_symbol(property.name()) {
return Err(LispError::InvalidSymbol(property.name().to_string()));
}
}
let valid = format!("%{name}-valid");
self.defun_native_1(&valid, scoped_pointer_valid::<T>)?;
let mut definition = format!("(defclass {name} (eclisp-object) ())\n");
for property in class.properties() {
let property_name = property.name();
if let Some(getter) = property.native_getter() {
let native = format!("%{property_name}-get");
self.defun_native_1(&native, getter)?;
definition.push_str(&format!(
r#"
(ensure-generic-function '{property_name} :lambda-list '(obj))
(defmethod {property_name} ((obj {name}))
(%eclisp-native-result
({native} (%rust-handle obj))
"Native getter {name}.{property_name}"))
"#
));
}
if let Some(setter) = property.native_setter() {
let native = format!("%{property_name}-set");
self.defun_native_2(&native, setter)?;
definition.push_str(&format!(
r#"
(ensure-generic-function '(setf {property_name}) :lambda-list '(value obj))
(defmethod (setf {property_name}) (value (obj {name}))
(%eclisp-native-result
({native} (%rust-handle obj) value)
"Native setter {name}.{property_name}"))
"#
));
}
}
self.eval(definition)?;
for methods in class.into_implementations() {
self.defimpl(methods)?;
}
Ok(())
}
pub fn defimpl<T: LispClass>(&self, methods: Methods<T>) -> Result<(), LispError> {
for method in methods.methods() {
let name = format!("{}-{}", T::NAME, method.name());
let native = format!("%{name}");
if !valid_symbol(&name) {
return Err(LispError::InvalidSymbol(name));
}
let arity = method.native().arity();
let instance = matches!(method.kind(), MethodKind::Instance);
if instance && arity == 0 {
return Err(LispError::RuntimeError(format!(
"Instance method {name} requires a receiver"
)));
}
let arg_count = arity - usize::from(instance);
let args: Vec<String> = (0..arg_count).map(|i| format!("arg{i}")).collect();
let parameters = args.join(" ");
let call = if instance {
format!("({native} (%rust-handle obj) {parameters})")
} else {
format!("({native} {parameters})")
};
let definition = if instance {
format!(
r#"
(ensure-generic-function '{name})
(defmethod {name} ((obj {}) {parameters})
(%eclisp-native-result {call} "Native method {name}"))
"#,
T::NAME,
)
} else {
format!(
r#"
(defun {name} ({parameters})
(%eclisp-native-result {call} "Native function {name}"))
"#
)
};
method.native().register(self, &native)?;
self.eval(definition)?;
}
Ok(())
}
}
fn valid_symbol(name: &str) -> bool {
let mut bytes = name.bytes();
matches!(bytes.next(), Some(b'a'..=b'z' | b'A'..=b'Z' | b'%'))
&& bytes.all(|c| c.is_ascii_alphanumeric() || c == b'-' || c == b'_')
}
#[cfg(test)]
mod tests {
use super::*;
use crate::clos::{Method, NativeMethod};
#[allow(dead_code)]
struct Player {
health: i32,
}
#[test]
fn rejects_duplicate_methods() {
unsafe extern "C" fn callback() -> sys::cl_object {
unsafe { sys::eclisp_nil_raw() }
}
let first = Methods::new().method(Method::new(
"damage",
NativeMethod::Arity0(callback),
MethodKind::Static,
));
let second = Methods::new().method(Method::new(
"damage",
NativeMethod::Arity0(callback),
MethodKind::Static,
));
let class = Class::<Player>::new("player")
.methods(first)
.methods(second);
assert!(class.validate_implementations().is_err());
}
}