1. camlspotter
  2. opycaml

Commits

camlspotter  committed a85f7d6

first callback implementation

  • Participants
  • Parent commits 61c734b
  • Branches default

Comments (0)

Files changed (2)

File api.ml

View file
  • Ignore whitespace
 module Eval = Eval
 module Run = Run
 
+module Tuple : sig
+  include module type of Tuple
+
+  val from_list : [> _Object] t list -> _Tuple t
+  val to_list : _Tuple t -> _Object t list
+end = struct
+  include Tuple
+
+  let from_list lst =
+    let tpl = new_ (List.length lst) in
+    Utils.List.iteri (setItem tpl) lst;
+    tpl
+
+  let to_list a =
+    let len = _GET_SIZE a in
+    let rec f st = function
+      | -1 -> st
+      | n -> f (getItem a n :: st) (n-1)
+    in
+    f [](len-1)
+end
+
+module Cback : sig
+  val functions : (string, _Object t option -> _Object t list -> _Object t) Hashtbl.t
+  val initialize : unit -> unit
+end = struct
+  (** Python calls OCaml function *)
+  open Type
+  
+  let functions = Hashtbl.create 107
+  
+  type result = 
+    | Ok of _Object t
+    | Error of string
+    | Not_found of _Object t
+  
+  let callback : _Object t option -> _Tuple t -> result = fun self_option args_tuple ->
+    let args = Tuple.to_list args_tuple in
+    match args with
+    | [] -> assert false
+    | name_object::args ->
+	let f = try Some (Hashtbl.find functions (String.asString (Object.str name_object))) with _ -> None in
+	match f with
+	| None -> Not_found name_object
+	| Some f -> try Ok (f self_option args) with e -> Error (Printexc.to_string e)
+  ;;
+
+  let initialize () = Callback.register "( ゚∀゚)o彡°O'PyCaml callback" callback
+end
+
 module Base : sig
   include module type of Base
 
 
   external internal_init : unit -> unit = "opycaml_init"
   let initialize () =
-    Callback.register_exception "OPyCaml exception" (Error (poly_none (), poly_none ()));
+    Callback.register_exception "( ゚∀゚)o彡°O'PyCaml exception" (Error (poly_none (), poly_none ()));
+    Cback.initialize ();
     internal_init ();
     _internal_initialize ()
 
   let main argv = _main (List.length argv) argv
 end
 
-module Tuple = struct
-  include Tuple
-
-  let from_list lst =
-    let tpl = new_ (List.length lst) in
-    Utils.List.iteri (setItem tpl) lst;
-    tpl
-
-end
-
 module Object = struct
   include Object
 

File api_ml.c

View file
  • Ignore whitespace
 
 void opycaml_init()
 {
-    opycaml_exc = caml_named_value("OPyCaml exception");
+    opycaml_exc = caml_named_value("( ゚∀゚)o彡°O'PyCaml exception");
 }
 
 inline void opycaml_raise_error(value v, value detail)
     out = callback(*v, Val_PyObject(args, 1)); // takes only 1 argument
     return PyObject_val(out);
 }
+
+PyObject *opycaml_callback( PyObject *self, PyObject *args_tuple) {
+    value out;
+
+    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,1))); // string is copied
+        return NULL;
+    case 2: // not_found
+        PyErr_SetObject(PyExc_KeyError, PyObject_val(Field(out,1))); // incr ?
+        return NULL;
+    }
+}