use eclisp::{
Lisp, LispClass, LispContext, LispError,
clos::{Method, MethodKind, Methods, NativeMethod, with_scoped_object_pointer},
native, sys,
};
#[derive(LispClass)]
#[lisp(name = "transform", auto)]
struct Transform {
x: f32,
y: f32,
#[lisp(ignore)]
z: i32,
}
fn test_class(ctx: &LispContext<'_>) -> Result<(), LispError> {
ctx.defclass(Transform::class())?;
ctx.eval(
r#"
(defmethod move-transform ((obj transform))
(incf (transform-x obj) 5.0)
(incf (transform-y obj) 10.0))
"#,
)?;
let mut transform = Transform {
x: 1.0,
y: 2.0,
z: 3,
};
ctx.with(&mut transform, |obj| {
ctx.call("move-transform", &[obj])?;
Ok(())
})?;
assert_eq!(transform.x, 6.0);
assert_eq!(transform.y, 12.0);
assert_eq!(transform.z, 3);
Ok(())
}
unsafe extern "C" fn native_move(
handle: sys::cl_object,
dx: sys::cl_object,
dy: sys::cl_object,
) -> sys::cl_object {
native::invoke(|ctx| {
let dx: f32 = unsafe { native::from_native(dx)? };
let dy: f32 = unsafe { native::from_native(dy)? };
unsafe {
with_scoped_object_pointer::<Transform, _>(handle, |obj| {
obj.x += dx;
obj.y += dy;
})
}
.ok_or_else(|| LispError::RuntimeError("Invalid transform".into()))?;
native::to_native(ctx, ())
})
}
unsafe extern "C" fn native_length(handle: sys::cl_object) -> sys::cl_object {
native::invoke(|ctx| {
let length = unsafe {
with_scoped_object_pointer::<Transform, _>(handle, |obj| {
(obj.x * obj.x + obj.y * obj.y).sqrt()
})
}
.ok_or_else(|| LispError::RuntimeError("Invalid transform".into()))?;
native::to_native(ctx, length)
})
}
unsafe extern "C" fn native_origin() -> sys::cl_object {
native::invoke(|ctx| native::to_native(ctx, 0_i32))
}
fn test_native_instance(ctx: &LispContext<'_>) -> Result<(), LispError> {
let methods = Methods::<Transform>::new()
.method(Method::new(
"move",
NativeMethod::Arity3(native_move),
MethodKind::Instance,
))
.method(Method::new(
"length",
NativeMethod::Arity1(native_length),
MethodKind::Instance,
));
ctx.defimpl(methods)?;
let mut transform = Transform {
x: 3.0,
y: 4.0,
z: 5,
};
ctx.with(&mut transform, |obj| {
let length = ctx.call("transform-length", &[obj])?;
assert!((length.try_as_f64()? - 5.0).abs() < 0.001);
let dx = ctx.float(2.0)?;
let dy = ctx.float(3.0)?;
ctx.call("transform-move", &[obj, &dx, &dy])?;
Ok(())
})?;
assert_eq!(transform.x, 5.0);
assert_eq!(transform.y, 7.0);
assert_eq!(transform.z, 5);
Ok(())
}
fn test_native_static(ctx: &LispContext<'_>) -> Result<(), LispError> {
let methods = Methods::<Transform>::new().method(Method::new(
"origin",
NativeMethod::Arity0(native_origin),
MethodKind::Static,
));
ctx.defimpl(methods)?;
let result = ctx.eval("(transform-origin)")?;
assert_eq!(result.try_as_i64()?, 0);
Ok(())
}
fn test_native_invalid_arguments(ctx: &LispContext<'_>) -> Result<(), LispError> {
let mut transform = Transform {
x: 1.0,
y: 2.0,
z: 3,
};
ctx.with(&mut transform, |obj| {
let invalid = ctx.string("invalid")?;
let dy = ctx.float(5.0)?;
let error = ctx
.call("transform-move", &[obj, &invalid, &dy])
.unwrap_err()
.to_string();
assert!(error.contains("Native method transform-move failed"));
assert!(error.contains("Expected real number, got other"));
Ok(())
})?;
assert_eq!(transform.x, 1.0);
assert_eq!(transform.y, 2.0);
Ok(())
}
fn run(name: &str, lisp: &LispContext<'_>, test: fn(&LispContext<'_>) -> Result<(), LispError>) {
print!("test {name} ... ");
match test(lisp) {
Ok(()) => println!("ok"),
Err(error) => panic!("{name} failed: {error}"),
}
}
fn main() -> Result<(), LispError> {
let lisp = Lisp::new()?;
lisp.enter(|ctx| {
run("class", &ctx, test_class);
run("native_instance", &ctx, test_native_instance);
run("native_static", &ctx, test_native_static);
run(
"native_invalid_arguments",
&ctx,
test_native_invalid_arguments,
);
});
Ok(())
}