opycaml / api_ml.c

#include "api_ml.h"

// initialization

// exception
static value *opycaml_exc = NULL;

void opycaml_init()
{
    opycaml_exc = caml_named_value("( ゚∀゚)o彡°O'PyCaml exception");
}

inline void opycaml_raise_error(value v, value detail)
{ 
    value vs[2] = { v, detail };
    caml_raise_with_args(*opycaml_exc, 2, vs); 
}

// apis for refcnts

value opycaml_refcnt(value obj){
    PyObject *o = PyObject_val(obj);
    return Val_int(o->ob_refcnt);
}

void opycaml_incref(value obj){
    PyObject *o = PyObject_val(obj);
    Py_INCREF(o);
    return;
}

void opycaml_decref(value obj){
    PyObject *o = PyObject_val(obj);
//    PyObject *p = PyCFunction_GetSelf(o);
//    if( PyCFunction_Check(o) ){ 
//        fprintf(stderr, "PYCFunction DECR! %d(%d) =>\n", 
//                o->ob_refcnt,
//                p->ob_refcnt
//                );
//    }
    if( o ) Py_DECREF(o);
//    if( PyCFunction_Check(o) ){ 
//        fprintf(stderr, "PYCFunction DECR! => %d(%d)\n", 
//                o->ob_refcnt,
//                p->ob_refcnt);
//    }

//     if( PyCFunction_Check(o) ){ fprintf(stderr, "PYCFunction DECR! => %d\n", 
//                                         o->ob_refcnt);
//     }
//     if( PyCObject_Check(o) ){ fprintf(stderr, "PYCFunction DECR! => %d\n", 
//                                       o->ob_refcnt);
//     }
//     return;
}

value opycaml_address(value obj){
    PyObject *o = PyObject_val(obj);
    return caml_copy_nativeint((int)o);
}

// custom value

static int opycaml_compare( value v1, value v2 ) {
    int result;
    PyObject *p1 = PyObject_val(v1);
    PyObject *p2 = PyObject_val(v2);
    if( p1 && !p2 ) return -1;
    if( p2 && !p1 ) return 1;
    if( !p1 && !p2 ) return 0;
    PyObject_Cmp(p1, p2, &result);
    return result;
}

static long opycaml_hash( value v ) {
    PyObject *p = PyObject_val(v);
    if(p) return PyObject_Hash(p);
    else return 0;
}

// CR jfuruse: TODO!
static unsigned long opycaml_deserialize( void *dst ) {
    return 0;
}

struct custom_operations pyops = {
    "PythonObject",
    opycaml_decref,
    opycaml_compare,
    opycaml_hash,
    custom_serialize_default,
    opycaml_deserialize // TODO
};

// struct custom_operations fnops = {
//     "FuncPointer",
//     NULL,
//     NULL,
//     NULL,
//     NULL,
//     NULL
// };

// val <-> PyObject conversion 

value Val_PyObject( PyObject *obj, int incr ) {
    CAMLparam0();
    CAMLlocal1(v);
    if( obj && incr ) Py_INCREF(obj);
    v = alloc_custom( &pyops, sizeof(PyObject *), 100, 100000 );
    *((PyObject **)Data_custom_val(v)) = obj;
    CAMLreturn(v);
}

value opycaml_none() {
    return Val_PyObject(Py_None, 1); // check what happens if caml gets none and gc'ed
}

void opycaml_error()
{
    value err;
    PyObject *exn = PyErr_Occurred(); // It's borrowed. Increment its refcnt!
    PyObject *ptype, *pvalue, *ptraceback;
    if( !exn ){ caml_failwith("PyErr_Occurred returned NULL!"); }
    err = Val_PyObject(exn, 1); // borrowed: need to incr
    PyErr_Fetch(&ptype, &pvalue, &ptraceback);
    value caml_value = Val_PyObject(pvalue, 1); // incr
    PyErr_Clear();
    opycaml_raise_error(err, caml_value);
}

value Val_PyObject_opt( PyObject *obj, int incr ) {
    CAMLparam0();
    CAMLlocal1(v);
    if( !obj ) { // None
        v = Val_int(0);
    } else { // Some v
        v = caml_alloc_small(1, 0);
        Field(v,0) = Val_PyObject(obj, incr);
    }
    CAMLreturn(v);
}

value Val_PyObject_exc_at_null( PyObject *obj ) {
    if( !obj ) { opycaml_error(); }
    return Val_PyObject(obj, 1); // incr
}

value Val_PyObject_noincr_exc_at_null( PyObject *obj ) {
    if( !obj ) { opycaml_error(); }
    return Val_PyObject(obj, 0); // no need to incr
}

PyObject * PyObject_opt_val(value v) {
    if( Is_block(v) ){
        return PyObject_val(Field(v, 0));
    } else {
        printf("PyObject_opt_avl: NULL\n");
        return NULL;
    }
}

value Plus_or_fail(int v)
{
    if (v == -1) opycaml_error();
    return Val_int(v); // for unit
}

value Hash_or_fail(long v)
{
    if (v == -1) opycaml_error();
    return caml_copy_nativeint(v); // for unit
}

// Other useful functions

value opycaml_physical_equal( value v1, value v2 ){
    return Val_int(getcustom(v1) == getcustom(v2));
}

value opycaml_Py_Main(value argc, value argv){
    CAMLparam2(argc, argv);
    int i;
    int cargc = Int_val(argc);
    char **cargv = malloc(sizeof(char*) * argc);
    for(i=0; i< cargc; i++ ){
        if( Is_block(argv) ){
            cargv[i] = String_val(Field(argv, 0));
            argv = Field(argv, 1);
        } else {
            caml_failwith("opycaml_Py_Main: wrong argc and argv");
        }
    }
    int res = Py_Main(cargc, cargv);
    CAMLreturn(Val_int(res));
}

PyObject *opycaml_callback( PyObject *self, PyObject *args_tuple) {
    value out;

    fprintf(stderr, "OPyCaml opycaml_callback\n");

    static value * closure_p = NULL;
    if (closure_p == NULL) {
        /* First time around, look up by name */
        closure_p = caml_named_value("( ゚∀゚)o彡°O'PyCaml callback");
    }

    out = caml_callback2( *closure_p, Val_PyObject_opt( self, 1), Val_PyObject( args_tuple, 1 ) );
    switch( Tag_val(out) ){
    case 0: // OK
        return PyObject_val(Field(out, 0));
    case 1: // exn
        PyErr_SetString(PyExc_Exception, String_val(Field(out,0))); // string is copied
        return NULL;
    case 2: // not_found
        PyErr_SetObject(PyExc_KeyError, PyObject_val(Field(out,0))); // incr ?
        return NULL;
    }
}

/* static */ PyMethodDef OPyCamlMethods[] = {
    { "ocaml", opycaml_callback, METH_VARARGS, "Call registered OCaml functions" }, // static method
    { NULL, NULL, 0, NULL }
};

PyMODINIT_FUNC initopycaml_from_ocaml(void)
{
    fprintf(stderr, "OPyCaml initopycaml_from_ocaml\n");
    (void) Py_InitModule("opycaml", OPyCamlMethods);
}

// Use for OCaml program. Not for Python uses OCaml 
CAMLprim void opycaml_init_callback(void)
{
    initopycaml_from_ocaml();
}

// Having OCaml value inside Python

void opycaml_remove_wrap(void *statvp)
{
    // startvp has value at its head
    remove_global_root((value*)statvp); // now the reachables can be GCed
    // free the area, including the attached information with the ocaml value
    free(statvp);
}

PyCObject * opycaml_create_wrap(value v)
{
    // create a static for a copy of v
    value *statvp = caml_stat_alloc(sizeof(value));
    *statvp = v;
    // register *statvp as a global, to prevent GC of the reachables from statvp
    register_global_root(statvp);
    return (PyCObject*)PyCObject_FromVoidPtr(statvp, opycaml_remove_wrap); // create a new ref
    // CR jfuruse: PyCObject is deprecated in Python 2.7
}

value opycaml_embed_ocaml_value(value v)
{
    return Val_PyObject((PyObject *)opycaml_create_wrap(v), 0);
}

value opycaml_extract_embeded_ocaml_value(value v)
{
    PyObject *o = PyObject_val(v);
    if( !PyCObject_Check(o) ){ 
        caml_failwith("opycaml_extract_embeded_ocaml_value(v): v is not a PyCObject"); 
    }
    value res = (value)PyCObject_AsVoidPtr((PyCObject*)o);
    return res;
}

typedef struct { 
    value value;
    PyMethodDef methodDef;
} WrappedClosure;

PyObject *opycaml_closure_callback( PyObject *self, PyObject *args_tuple) {
    value out;

    WrappedClosure *wrapped = PyCObject_AsVoidPtr(self);

    static value * closure_p = NULL;
    if (closure_p == NULL) {
        /* First time around, look up by name */
        closure_p = caml_named_value("( ゚∀゚)o彡°O'PyCaml closure callback");
    }

    out = caml_callback2( *closure_p, wrapped->value, Val_PyObject( args_tuple, 1 ) );
    switch( Tag_val(out) ){
    case 0: // OK
        return PyObject_val(Field(out, 0));
    case 1: // exn
        PyErr_SetString(PyExc_Exception, String_val(Field(out,0))); // string is copied
        return NULL;
    case 2: // not_found
        PyErr_SetObject(PyExc_KeyError, PyObject_val(Field(out,0))); // incr ?
        return NULL;
    }
}

value opycaml_create_closure_wrap(value v)
{
    WrappedClosure *wrapped = caml_stat_alloc(sizeof(WrappedClosure));

    // create a static for a copy of v
    wrapped->value = v;
    // register *statvp as a global, to prevent GC of the reachables from statvp
    register_global_root(&wrapped->value);
    
    wrapped->methodDef.ml_name = "ocaml closure";
    wrapped->methodDef.ml_meth = opycaml_closure_callback;
    wrapped->methodDef.ml_flags = METH_VARARGS;
    wrapped->methodDef.ml_doc = "ocaml closure";
    
    PyObject *cobject = PyCObject_FromVoidPtr(wrapped, opycaml_remove_wrap);
    PyCFunction *cfunction = PyCFunction_New(&wrapped->methodDef, cobject);
    // PyCFunction_New incrmenets cobject refcnt to 2. We here it make back to 1.  
    if( cobject->ob_refcnt == 2 /* must be always true */ ){ Py_DECREF(cobject); }
    return Val_PyObject(cfunction, 0);
}
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.