summaryrefslogblamecommitdiff
path: root/src/guile/guile.rs
blob: e8e9b4d62e57e8d078efac9329be5e53b8724e6e (plain) (tree)
1
2
3
4
5
6
7
8
9
10
11
                                                            


                                          






                                
                           

                        
                                                             
                                                                
                                                                   
                                                    
                                                                                       







                                                                 








                                                                                                

                                                             




                                          
                                            
                                       

                                                                         







                                                                


                                                          




                                                                       











                                                                   























                                                                                          
                   
 






























                                                                              




                             





                                                                           
     
 
                                                                         
                                         

                                                             








                                               


                                   
 






                                                                        






                                                                      
 
 

                        


                                                                                           

     
use crate::macro_processor::macro_processor::MacroProcessor;
use std::ffi::{CStr, CString};
use std::os::raw::{c_char, c_int, c_void};

macro_rules! dprint {
    ($($x:tt)*) => {
        #[cfg(debug_assertions)]
        print!($($x)*)
    }
}

#[link(name = "guile-3.0")]
extern "C" {
    fn scm_init_guile();
    fn scm_c_eval_string(expr: *const c_char) -> *mut c_void;
    fn scm_from_utf8_string(expr: *const c_char) -> *mut c_void;
    fn scm_to_locale_string(scm_obj: *mut c_void) -> *const c_char;
    fn scm_is_string(scm_obj: *mut c_void) -> c_int;
    fn scm_object_to_string(scm_obj: *mut c_void, printer: *mut c_void) -> *mut c_void;
    fn scm_to_pointer(scm_obj: *mut c_void) -> *mut c_void;
    fn scm_c_define_gsubr(
        name: *const c_char,
        req: c_int,
        opt: c_int,
        rst: c_int,
        func: extern "C" fn(scm_obj: *mut c_void) -> *mut c_void,
    );
    fn scm_c_catch(
        tag: *mut c_void,
        body: extern "C" fn(*mut c_void) -> *mut c_void,
        body_data: *mut c_void,
        handler: extern "C" fn(*mut c_void, *mut c_void, *mut c_void) -> *mut c_void,
        handler_data: *mut c_void,
        pre_unwind_handler: extern "C" fn(*mut c_void, *mut c_void, *mut c_void) -> *mut c_void,
        pre_unwind_handler_data: *mut c_void,
    ) -> *mut c_void;
    fn scm_c_define(name: *const c_char, value: *mut c_void);
    fn scm_from_pointer(value: *mut c_void) -> *mut c_void;
}

#[link(name = "guiledefs")]
extern "C" {
    pub static scm_undefined: *mut c_void;
    pub static scm_unspecified: *mut c_void;
    pub static scm_bool_t: *mut c_void;
    fn defs_scm_is_eq(x: *mut c_void, y: *mut c_void) -> c_int;
    fn defs_scm_define_string(name: *const c_char, value: *const c_char);
}

/// Convert a scm object into a string using Guile-builtins
fn string_from_scm(scm_obj: *mut c_void) -> Result<String, ()> {
    unsafe {
        if scm_obj.is_null() {
            return Err(());
        }
        if defs_scm_is_eq(scm_obj, scm_unspecified) != 0 {
            return Ok(String::new());
        } else if scm_is_string(scm_obj) != 0 {
            let res_str = CStr::from_ptr(scm_to_locale_string(scm_obj))
                .to_string_lossy()
                .into_owned();
            return Ok(res_str);
        } else {
            let res = scm_object_to_string(scm_obj, scm_undefined);
            if res.is_null() {
                return Err(());
            }
            let res_str = CStr::from_ptr(scm_to_locale_string(res))
                .to_string_lossy()
                .into_owned();
            return Ok(res_str);
        }
    }
}

extern "C" fn scm_smp_macro(arg: *mut c_void) -> *mut c_void {
    let arg_str;
    unsafe {
        arg_str = CStr::from_ptr(scm_to_locale_string(arg))
            .to_string_lossy()
            .into_owned();
    }
    dprint!("ARG {:#?}\n", arg_str);
    let c_smp_state_ptr = CString::new("smp_state_ptr").expect("CString::new() failed");
    unsafe {
        let smp_state_scm = scm_c_eval_string(c_smp_state_ptr.as_ptr());
        let smp_state_ptr = scm_to_pointer(smp_state_scm);
        let smp: &mut MacroProcessor = &mut *(smp_state_ptr as *mut MacroProcessor);
        if let Some(macro_value) = smp.macros.get(&arg_str) {
            let r = CString::new(macro_value.to_string()).expect("CString::new() failed");
            scm_from_utf8_string(r.as_ptr())
        } else {
            let r = CString::new("Macro not found").expect("CString::new() failed");
            scm_from_utf8_string(r.as_ptr())
        }
    }
}

#[derive(Debug)]
pub struct Guile {}

extern "C" fn error_handler(
    _data: *mut c_void,
    _tag: *mut c_void,
    _args: *mut c_void,
) -> *mut c_void {
    eprintln!("Guile error occurred!");
    unsafe { scm_undefined }
}

/*
/* A "pre-unwind handler" to scm_c_catch that prints the exception
   according to "set guile print-stack".  */
static SCM scscm_printing_pre_unwind_handler (void *data, SCM key, SCM args) {
  SCM stack = scm_make_stack (SCM_BOOL_T, scm_list_1 (scm_from_int (2)));
  gdbscm_print_exception_with_stack (SCM_BOOL_F, stack, key, args);
  return SCM_UNSPECIFIED;
}
*/
extern "C" fn pre_unwind_handler(
    _data: *mut c_void,
    _tag: *mut c_void,
    _args: *mut c_void,
) -> *mut c_void {
    unsafe { scm_undefined }
}

extern "C" fn eval_body(data: *mut c_void) -> *mut c_void {
    let expr = data as *const c_char;
    unsafe { scm_c_eval_string(expr) }
}

impl Guile {
    pub fn new() -> Self {
        unsafe {
            scm_init_guile();
        }
        let guile = Guile {};
        let func_name = CString::new("smp_get").unwrap();
        unsafe {
            scm_c_define_gsubr(func_name.as_ptr(), 1, 0, 0, scm_smp_macro);
        }
        guile
    }

    pub fn evaluate_expression(&self, expr: &str) -> Result<String, ()> {
        dprint!("(eval \"{}\")\n", expr);
        unsafe {
            let c_expr = CString::new(expr).map_err(|_| ())?;
            let result = scm_c_catch(
                scm_bool_t,
                eval_body,
                c_expr.as_ptr() as *mut c_void,
                error_handler,
                scm_bool_t,
                pre_unwind_handler,
                scm_bool_t,
            );
            string_from_scm(result)
        }
    }

    pub fn define_string(&self, name: &str, value: &str) {
        let c_name = CString::new(name).expect("CString::new failed");
        let c_value = CString::new(value).expect("CString::new failed");
        unsafe {
            defs_scm_define_string(c_name.as_ptr(), c_value.as_ptr());
        }
    }

    pub fn define(&self, name: &str, value: *mut c_void) {
        let c_name = CString::new(name).expect("CString::new failed");
        unsafe {
            scm_c_define(c_name.as_ptr(), scm_from_pointer(value));
        }
    }
}

impl Drop for Guile {
    fn drop(&mut self) {
        //if let Err(e) = self.evaluate_expression("(variable-unset! \"smp_state_ptr\")") {
        //    panic!("Error while exiting {:#?}", e);
        //}
    }
}