// Stub code to access libcell from OCaml

extern "C" {
#include <stdio.h>

#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/custom.h>
#include <caml/memory.h>
#include <caml/fail.h>
#include <caml/callback.h>
}

#include "libcell.h"


#define CELL_PTR(v) ((Cell *) Data_custom_val(v))
#define CELL_VAL(v) (* CELL_PTR(v))

static void free_cell(value v)
{
    printf("(cell.cpp) free_cell called\n");
}

static int compare_cell(value v1, value v2)
{
    return CELL_VAL(v1).get() - CELL_VAL(v2).get();
}

static struct custom_operations cell_ops = {
    /* identifier */ "Cell/v0.1",
    /* finalize */ &free_cell,
    /* compare */ &compare_cell,
    /* hash */ custom_hash_default,
    /* serialize */ custom_serialize_default,
    /* deserialize */ custom_deserialize_default
};


extern "C"
value cell_create(value v)
{
    CAMLparam1(v);
    CAMLlocal1(res);
    extern struct custom_operations cell_ops;
    Cell c(Int_val(v));
    
    res = alloc_custom(&cell_ops, sizeof(Cell), sizeof(Cell), 1000);
    CELL_VAL(res) = c; /* store the object in the alloc. block.  This
			* may cause problems for some "structured"
			* objects -- if the object contains pointers,
			* when c get deleted it can also erase most of
			* the structure and so CELL_VAL(res) will only
			* contain a copy of the "top node" (access to
			* "subnodes" will cause a Segmentation
			* Fault. */
    CAMLreturn(res);
}


extern "C"
value cell_set(value v1, value v2)
{
    try {
	CELL_VAL(v1).set( Int_val(v2) );
    } catch (Exc e) {
	failwith((char *) e.msg);
    }
    return(Val_unit);
}

extern "C"
value cell_get(value v)
{
    return( Val_int(CELL_VAL(v).get()) );
}

extern "C"
value cell_global(value v)
{
    CAMLparam1(v);
    CAMLlocal1(res);
    extern struct custom_operations cell_ops;
    extern Cell global_cell;
    
    res = alloc_custom(&cell_ops, sizeof(Cell), sizeof(Cell), 1000);
    CELL_VAL(res) = global_cell; /* This is not really global since
				    only the value gets copied... */
    CAMLreturn(res); 
}




extern "C"
value cell_throw(value)
{
    throw Exc("cell_throw");
}

extern "C"
value cell_call(value v)
{
    value f = *caml_named_value(String_val(v));
    try {
	return callback(f, Val_unit);
    } catch (Exc e) {
	return copy_string((char *) e.msg);
    }
}