eclisp 0.2.0

Bindings for Embeddable Common Lisp
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(())
}