Commits

camlspotter  committed 3c5480e Merge

merge

  • Participants
  • Parent commits ddc5c28, a042a9b

Comments (0)

Files changed (4)

   	  | Some f -> try Ok (f self_option args) with e -> Error (Printexc.to_string e)
     ;;
   
+    let closure_callback : (_Tuple t -> _Object t) -> _Tuple t -> result = fun closure args_tuple ->
+      try Ok (closure args_tuple) with e -> Error (Printexc.to_string e)
+    ;;
+  
     external python_init : unit -> unit = "opycaml_init_callback"
 
     let initialize () = 
       OCaml.Callback.register "( ゚∀゚)o彡°O'PyCaml callback" callback;
+      OCaml.Callback.register "( ゚∀゚)o彡°O'PyCaml closure callback" closure_callback;
       python_init ()
   end
   
     
     	Bug: Py_Main never returns to OCaml at exit(_), while CTRL+D works fine.
         **)
+
+      external unsafe_embed : 'a -> _CObject t = "opycaml_embed_ocaml_value"
+	(** embed any OCaml value into Python's CObject. Unsafe. *)
+
+      external embed_closure : (_Tuple t -> _Object t) -> _Closure t = "opycaml_create_closure_wrap"
     end = struct
   
       external none : unit -> _None t = "opycaml_none"
     
       external _main : int -> string list -> int = "opycaml_Py_Main"
       let main argv = _main (List.length argv) argv
+
+      external unsafe_embed : 'a -> _CObject t = "opycaml_embed_ocaml_value"
+
+      external embed_closure : (_Tuple t -> _Object t) -> _Closure t = "opycaml_create_closure_wrap"
     end
 
     include X
     opycaml_compare,
     opycaml_hash,
     custom_serialize_default,
-    opycaml_deserialize
+    opycaml_deserialize // TODO
 };
 
 // struct custom_operations fnops = {
 }
 
 static PyMethodDef OPyCamlMethods[] = {
-    { "ocaml", opycaml_callback, METH_VARARGS, "Call registered OCaml functions" },
+    { "ocaml", opycaml_callback, METH_VARARGS, "Call registered OCaml functions" }, // static method
     { NULL, NULL, 0, NULL }
 };
 
 {
     initopycaml();
 }
+
+// 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);
+}
+
+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);
+    return Val_PyObject(PyCFunction_New(&wrapped->methodDef, cobject), 0);
+}
 ;;
 
 let _ =
+  prerr_endline "*** import non-existing module";
   try
     ignore (Import.importModule "hogehoge")
   with
 ;;
 
 let _ =
+  prerr_endline "*** create string";
   let o = Py.String.fromString "hello world" in
   Base.debug "o" o;
-  
+
+  prerr_endline "*** phys_equality";
   assert (Base.phys_eq o o);
+
+  prerr_endline "*** repr";
   let repr = Object.repr o in
   Base.debug "repr" repr;
+
+  prerr_endline "*** hash";
   let hash = Object.hash o in
   Printf.eprintf "hash=%nd\n%!" hash;
 
   try
+    prerr_endline "*** importing string module";
     let stringModule = Import.importModule "string" in (* from string import * *)
     Base.debug "stringModule" stringModule;
+
+    prerr_endline "*** dict of string";
     let dict = Module.getDict stringModule in
     (* Base.debug "dict" dict; *)
+
+    prerr_endline "*** get lowercase";
     let lowercase = Dict.getItemString dict "lowercase" in
     Base.debug "lowercase" lowercase;
 
+    prerr_endline "*** get capitalize";
     let capitalize = Dict.getItemString dict "capitalize" in
     Base.debug "capitalize" capitalize;
 
+    prerr_endline "*** check callable of capitalize";
     if not (Callable.check capitalize) then begin
       prerr_endline "capitalize is not a function!";
       failwith "capitalize is not a function!";
     end;
 
+    prerr_endline "*** tuple creation";
     let tpl = Tuple.new_ 1 in
     Base.debug "tpl" tpl;
 
+    prerr_endline "*** tuple setting";
+    prerr_endline "* ref count before:";
     Base.debug "o" o;
-
-    prerr_endline "tuple setting";
-    
     Tuple.setItem tpl 0 o;
-
-    prerr_endline "tuple set";
+    prerr_endline "* tuple set";
+    prerr_endline "* ref count after:";
     Base.debug "tuple" tpl;
     Base.debug "o" o; (* ref by tuple and o *)
 
-    prerr_endline "getItem";
+    prerr_endline "*** getItem";
     let x = Tuple.getItem tpl 0 in
     Base.debug "x" x; (* ref by tuple, o and x *) 
     Base.debug "o" o; (* ref by tuple, o and x *) 
 
+    prerr_endline "*** GET_ITEM";
     let xx = Tuple._GET_ITEM tpl 0 in
     Base.debug "xx" xx; (* ref by tuple, o, x and xx *)
     Base.debug "o" o;
 
-    prerr_endline "calling function";
+    prerr_endline "*** calling function";
     let res = Object.callObject (Callable.coerce capitalize) [o] in
     Printf.eprintf "res : refcnt = %d\n%!" (Base.refcnt res);
-    prerr_endline "function called!";
+    prerr_endline "* function called!";
     prerr_endline (Py.String.asString (Py.String.coerce res));
     prerr_endline (Py.String.asString o);
 
+    prerr_endline "*** fromLong (-1)";
     let minus_1 = Int.fromLong (-1) in
     assert (Int.asLong minus_1 = -1); 
 
+    prerr_endline "*** Run.simpleString";
     Run.simpleString "print 'Run.simpleString'";
     (* Run.simpleString "print(string.lowercase)"; *) (* does not work *)
     (* Run.simpleString "print(lowercase)"; *) (* does not work *)
 
+    prerr_endline "*** registering opycaml command";
     (* Register test command in python *)
     Hashtbl.add Py.Callback.functions "test" 
       (fun (self_opt : _Object t option) (args : _Object t list) ->
       (* Opycaml.Api.Py.Callback is not available as
 	 Opycaml.Api.Callback, to avoid the name collision with the original OCaml Callback module under ``open Opycaml.Api''.
       *)
-    prerr_endline "Now you can use opycaml.ocaml(\"test\", 1, 2, 3) to call the test OCaml function from Python";
+    prerr_endline "* Now you can use opycaml.ocaml(\"test\", 1, 2, 3) to call the test OCaml function from Python";
 
+    prerr_endline "*** module insertion";
+    let m = Import.importModule "opycaml" in
+    let dict = Module.getDict m in
+    Dict.setItemString dict "bar" xx;
+    prerr_endline "* check / import opycaml / opycaml.__dict__ / opycaml.bar";
+
+    prerr_endline "*** OCaml value embedding";
+    (* OCaml value => _Object t *)
+    let py_ocaml_1 = Base.unsafe_embed 1 in
+    Base.debug "py_ocaml_1" py_ocaml_1;
+
+    prerr_endline "*** OCaml closure wrapping";
+    let f (args : _Tuple t) : _Object t =
+      Format.eprintf "#Args!!@.";
+      Object.obj (Base.none ())
+    in
+    
+    let fo = Base.embed_closure f in
+    Base.debug "fo" fo;
+
+    prerr_endline "*** inserting a closure into module opycaml";
+    Dict.setItemString dict "f" fo;
+    prerr_endline "* check / import opycaml / opycaml.__dict__ / opycaml.f";
+
+    prerr_endline "*** Entering the toploop";
     ignore (Base.main []);
     prerr_endline "exited from toploop";
 
 type _Class = [_Object | `_Class]
 type _Slice = [_Object | `_Slice]
 
+type _CObject = [_Object | `_CObject]
+
+type _Closure = [_Object | `_Closure]
+
 (** the Python Object type *)
 type 'a t