Commits

camlspotter committed f06a2f6 Merge

merge

  • Participants
  • Parent commits 76ad439, 71287c2
  • Branches dev

Comments (0)

Files changed (9)

 
 MyOCamlPackedLibrary(opycaml, utils type autoapi api, auto_stubs api_ml, -lpython2.6 -L$(PREFIX)/lib/ocaml -lcamlidl)
 
-.DEFAULT: opycaml.cma opycaml.cmxa
+opycaml_python.o: opycaml.cmx libopycaml.a dllopycaml.so
+	$(OCamlOpt) -output-obj -o $@ opycaml.cmx -cclib -lopycaml -ccopt -L$(OCAML_WHERE) -ccopt -Wl,-rpath,$(OCAML_WHERE) -cclib -lpython2.6 -cclib -lcamlidl 
+
+.DEFAULT: opycaml.cma opycaml.cmxa opycaml_python.o
 
 OCAML_LIBS += opycaml
 
 .DEFAULT: $(OCamlProgram test_bug1, test_bug1)
 
 .PHONY: install
-install: opycaml.cma opycaml.cmxa
-	$(OCAMLFIND) install opycaml opycaml.cmi opycaml.cma opycaml.cmxa opycaml.a dllopycaml.so libopycaml.a autoapi.ml api.ml META
+install: opycaml.cma opycaml.cmxa libopycaml_python.so
+	$(OCAMLFIND) install opycaml opycaml.cmi opycaml.cma opycaml.cmxa opycaml.a dllopycaml.so libopycaml.a autoapi.ml api.ml META libopycaml_python.so
   test.ml is for an example.
 
   - api.ml provides the main Python/OCaml interface. 
-    Use "open Opycaml.Api" in your OCaml programs.
+    Use "open Opycaml.Api" in your OCaml programs. 
+    Once opened, Python/ML API functions are available by
+    Py.<Class>.<function> names. For example,
+
+       Py.Object.repr    for   PyObject_Repr
+       Py.String.check   for   PyStrnig_Check 
+
+    You can omit Py. prefix for the module names which do not collide
+    with OCaml standard library name space:
+
+       Object.repr       for   PyObject_Repr
+       (String is in OCaml standard library, so no short cut is available.)
 
   - Do not forget calling Base.initialize for initialization.
 
   - api.ml extends autoapi.ml, providing things not easily done by
     CamlIDL's code generator.
 
-  - A C function Py<Hoo>_<Bar> is found as a function <bar> 
-    (note that the first letter is lowercased) in ML submodule <Hoo>. 
+  - A C function Py<Hoo>_<Bar> is mapped into an ML function Hoo.bar, 
+    where the first letter of "Bar" is lowercased.
+
     For example:
-
-      PyString_Check => String.check
       PyObject_Repr =>  Object.repr
+      PyString_Check => String.check   
+               ( Note that String module is available by Py.String )
 
     There is one exception: If a C function has all-capital-or-underscore
     postfix name, such as PyTuple_GET_ITEM, its ML function name is not
 
 open Autoapi
 
-module String = String
+module Py = struct
+  module OCaml = struct
+    module String = String
+    module Callback = Callback
+  end
+    
+  module String = String
+  module ByteArray = ByteArray
+  module Number = Number
+  module Type = Type
+  module Mapping = Mapping
+  module Dict = Dict
+  module DictProxy = DictProxy
+  module Module = Module
+  module Index = Index
+  module Import = Import
+  module Iter = Iter
+  module Callable = Callable
+  module Sequence = Sequence
+  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 Callback : 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)
+    ;;
+  
+    external python_init : unit -> unit = "opycaml_init_callback"
+
+    let initialize () = 
+      OCaml.Callback.register "( ゚∀゚)o彡°O'PyCaml callback" callback;
+      python_init ()
+  end
+  
+  module Base : sig
+    include module type of Base
+  
+    external none : unit -> _None t = "opycaml_none"
+      (** Get Py_None object. *)
+  
+    external phys_eq : [>_Object] t -> [>_Object] t -> bool = "opycaml_physical_equal"
+      (** Checks physical equality of objects *)
+  
+    (* reference count functions: use with care *)
+    external refcnt : [>_Object] t -> int = "opycaml_refcnt"
+    external incref : [>_Object] t -> unit = "opycaml_incref"
+    external decref : [>_Object] t -> unit = "opycaml_decref"
+  
+    (* get address of objects for debugging *)
+    external address : [>_Object] t -> nativeint = "opycaml_address"
+  
+    val initialize : unit -> unit
+      (** Python api initialization with OCaml exception registeration.
+  	Any other function in OPyCaml must be called after [initialize ()].
+      *)
+  
+    val debug : string -> [>_Object] t -> unit
+      (** debug print of objects *) 
+  
+    val main : string list -> int
+      (** Call to Py_Main
+  
+  	The main program for the standard interpreter. This is made available for programs which embed Python. The argc and argv parameters should be prepared exactly as those which are passed to a C program’s main() function. It is important to note that the argument list may be modified (but the contents of the strings pointed to by the argument list are not). The return value will be the integer passed to the sys.exit() function, 1 if the interpreter exits due to an exception, or 2 if the parameter list does not represent a valid Python command line.
+  	Note that if an otherwise unhandled SystemError is raised,
+  	this function will not return 1, but exit the process, as long
+  	as Py_InspectFlag is not set.
+  
+  	Bug: Py_Main never returns to OCaml at exit(_), while CTRL+D works fine.
+      **)
+  end = struct
+    include Base
+  
+    external none : unit -> _None t = "opycaml_none"
+    external poly_none : unit -> 'a t = "opycaml_none" (* unsafe *)
+    external phys_eq : [>_Object] t -> [>_Object] t -> bool = "opycaml_physical_equal"
+    external refcnt : [>_Object] t -> int = "opycaml_refcnt"
+    external incref : [>_Object] t -> unit = "opycaml_incref"
+    external decref : [>_Object] t -> unit = "opycaml_decref"
+    external address : [>_Object] t -> nativeint = "opycaml_address"
+  
+    external internal_init : unit -> unit = "opycaml_init"
+    let initialize () =
+      OCaml.Callback.register_exception "( ゚∀゚)o彡°O'PyCaml exception" (Error (poly_none (), poly_none ()));
+      internal_init ();
+      _internal_initialize ();
+      Callback.initialize ()
+  
+    let debug name o =
+      let cnt = refcnt o in
+      let repr = String.asString (Object.repr o) in
+      let address = address o in
+      Printf.eprintf "%s : %d : %nx : %s\n%!" name cnt address repr
+  
+    external _main : int -> string list -> int = "opycaml_Py_Main"
+    let main argv = _main (List.length argv) argv
+  end
+  
+  module Object = struct
+    include Object
+  
+    let call callable ?kwd list =
+      _internal_call callable (Tuple.from_list list) kwd
+  
+    let callObject callable = function
+      | [] -> _internal_callObject callable None
+      | list -> _internal_callObject callable (Some (Tuple.from_list list))
+  end
+  
+  module Err : sig
+    include module type of Err
+  
+    external reraise : unit -> 'a = "opycaml_error"
+      (** reraise the current exception. 
+  	Err.Occured() must be return Some. Otherwise Failwith is
+      raised instead. *)
+  
+    val normalizeException : unit -> (_Object t * _Object t * _Object t) option
+  end = struct
+    include Err
+      
+    external reraise : unit -> 'a = "opycaml_error"
+  
+    let normalizeException () =
+      match occurred () with
+      | None -> None
+      | Some _ -> Some (_internal_normalizeException ())
+  end
+  
+  module Int : sig
+    include module type of Int
+  
+    val asLong : [>_Int] t -> int
+      (** raises Error at overflow *)
+  end = struct
+    include Int
+  
+    let asLong t =
+      let res = _internal_asLong t in
+      if res <> -1 then res
+      else match Err.occurred () with
+      | None -> -1
+      | Some _ -> Err.reraise ()
+  end
+end
+  
+(* Name space hack: Modules whose names do not collide with the OCaml
+   standard library are exported here too. *)
+open Py
+(* module String = String -- collides with OCaml standard library *)
+(* module Callback = -- collides with OCaml standard library *)
 module ByteArray = ByteArray
 module Number = Number
 module Type = Type
 module Sequence = Sequence
 module Eval = Eval
 module Run = Run
-
-module Base : sig
-  include module type of Base
-
-  external none : unit -> _None t = "opycaml_none"
-    (** Get Py_None object. *)
-
-  external phys_eq : [>_Object] t -> [>_Object] t -> bool = "opycaml_physical_equal"
-    (** Checks physical equality of objects *)
-
-  (* reference count functions: use with care *)
-  external refcnt : [>_Object] t -> int = "opycaml_refcnt"
-  external incref : [>_Object] t -> unit = "opycaml_incref"
-  external decref : [>_Object] t -> unit = "opycaml_decref"
-
-  (* get address of objects for debugging *)
-  external address : [>_Object] t -> nativeint = "opycaml_address"
-
-  val initialize : unit -> unit
-    (** Python api initialization with OCaml exception registeration.
-	Any other function in OPyCaml must be called after [initialize ()].
-    *)
-
-  val debug : string -> [>_Object] t -> unit
-    (** debug print of objects *) 
-
-  val main : string list -> int
-    (** Call to Py_Main
-
-	The main program for the standard interpreter. This is made available for programs which embed Python. The argc and argv parameters should be prepared exactly as those which are passed to a C program’s main() function. It is important to note that the argument list may be modified (but the contents of the strings pointed to by the argument list are not). The return value will be the integer passed to the sys.exit() function, 1 if the interpreter exits due to an exception, or 2 if the parameter list does not represent a valid Python command line.
-	Note that if an otherwise unhandled SystemError is raised,
-	this function will not return 1, but exit the process, as long
-	as Py_InspectFlag is not set.
-
-	Bug: Py_Main never returns to OCaml at exit(_), while CTRL+D works fine.
-    **)
-end = struct
-  include Base
-
-  external none : unit -> _None t = "opycaml_none"
-  external poly_none : unit -> 'a t = "opycaml_none" (* unsafe *)
-  external phys_eq : [>_Object] t -> [>_Object] t -> bool = "opycaml_physical_equal"
-  external refcnt : [>_Object] t -> int = "opycaml_refcnt"
-  external incref : [>_Object] t -> unit = "opycaml_incref"
-  external decref : [>_Object] t -> unit = "opycaml_decref"
-  external address : [>_Object] t -> nativeint = "opycaml_address"
-
-  external internal_init : unit -> unit = "opycaml_init"
-  let initialize () =
-    Callback.register_exception "OPyCaml exception" (Error (poly_none (), poly_none ()));
-    internal_init ();
-    _internal_initialize ()
-
-  let debug name o =
-    let cnt = refcnt o in
-    let repr = String.asString (Object.repr o) in
-    let address = address o in
-    Printf.eprintf "%s : %d : %nx : %s\n%!" name cnt address repr
-
-  external _main : int -> string list -> int = "opycaml_Py_Main"
-  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
-
-  let call callable ?kwd list =
-    _internal_call callable (Tuple.from_list list) kwd
-
-  let callObject callable = function
-    | [] -> _internal_callObject callable None
-    | list -> _internal_callObject callable (Some (Tuple.from_list list))
-end
-
-module Err : sig
-  include module type of Err
-
-  external reraise : unit -> 'a = "opycaml_error"
-    (** reraise the current exception. 
-	Err.Occured() must be return Some. Otherwise Failwith is
-    raised instead. *)
-
-  val normalizeException : unit -> (_Object t * _Object t * _Object t) option
-end = struct
-  include Err
-    
-  external reraise : unit -> 'a = "opycaml_error"
-
-  let normalizeException () =
-    match occurred () with
-    | None -> None
-    | Some _ -> Some (_internal_normalizeException ())
-end
-
-module Int : sig
-  include module type of Int
-
-  val asLong : [>_Int] t -> int
-    (** raises Error at overflow *)
-end = struct
-  include Int
-
-  let asLong t =
-    let res = _internal_asLong t in
-    if res <> -1 then res
-    else match Err.occurred () with
-    | None -> -1
-    | Some _ -> Err.reraise ()
-end
-
-
+module Tuple = Tuple
+module Base = Base
+module Object = Object
+module Err = Err
+module Int = Int
 
 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)
     caml_raise_with_args(*opycaml_exc, 2, vs); 
 }
 
-// custom value
-
-static void pydecref( value v ) {
-    PyObject *py = PyObject_val(v);
-    if( py ) { Py_DECREF(py); }
-}
-
-static int pycompare( 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 pyhash( value v ) {
-    PyObject *p = PyObject_val(v);
-    if(p) return PyObject_Hash(p);
-    else return 0;
-}
-
-// CR jfuruse: TODO!
-static unsigned long pydeserialize( void *dst ) {
-    return 0;
-}
-
-struct custom_operations pyops = {
-    "PythonObject",
-    pydecref,
-    pycompare,
-    pyhash,
-    custom_serialize_default,
-    pydeserialize
-};
-
-struct custom_operations fnops = {
-    "FuncPointer",
-    NULL,
-    NULL,
-    NULL,
-    NULL,
-    NULL
-};
-
 // apis for refcnts
 
 value opycaml_refcnt(value obj){
 
 void opycaml_decref(value obj){
     PyObject *o = PyObject_val(obj);
-    Py_DECREF(o);
+    if( o ) Py_DECREF(o);
     return;
 }
 
     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
+};
+
+// struct custom_operations fnops = {
+//     "FuncPointer",
+//     NULL,
+//     NULL,
+//     NULL,
+//     NULL,
+//     NULL
+// };
+
 // val <-> PyObject conversion 
 
 value Val_PyObject( PyObject *obj, int incr ) {
     CAMLreturn(Val_int(res));
 }
 
-// Callbacks from pycaml. Not investigated yet. 
+PyObject *opycaml_callback( PyObject *self, PyObject *args_tuple) {
+    value out;
 
-value funcwrap( void *obj ) {
-    CAMLparam0();
-    CAMLlocal1(v);
-    v = alloc_custom( &fnops, sizeof( void * ), 100, 100000 );
-    *((void **)Data_custom_val(v)) = obj;
-    CAMLreturn(v);
+    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;
+    }
 }
 
-static void camldestr( void *v ) {
-    value *valptr = (value *)v;
-    remove_global_root(valptr);
-    free( v );
+static PyMethodDef OPyCamlMethods[] = {
+    { "ocaml", opycaml_callback, METH_VARARGS, "Call registered OCaml functions" },
+    { NULL, NULL, 0, NULL }
+};
+
+PyMODINIT_FUNC initopycaml(void)
+{
+    (void) Py_InitModule("opycaml", OPyCamlMethods);
 }
 
-PyObject *camlwrap( value val, void *aux_str, int size ) {
-    // v stores value + aux_str
-    value *v = (value *)malloc(sizeof(value) + size);
-    *v = val;
-    memcpy((void *)v+sizeof(value),aux_str,size);
-    register_global_root(v); // Prevent val from being GCed
-    return PyCObject_FromVoidPtr(v,camldestr);
+CAMLprim void opycaml_init_callback(void)
+{
+    initopycaml();
 }
-
-// Get Caml value in Python and return its aux_str.
-void *caml_aux( PyObject *obj ) {
-    value *v = (value *)PyCObject_AsVoidPtr( obj );
-    return (void *)v+sizeof(value);
-}
-
-PyObject *pycall_callback( PyObject *obj, PyObject *args ) {
-    value out;
-    value *v;
-    
-    // If the obj is strange, returns None
-    if( !PyCObject_Check(obj) ) {
-        Py_INCREF(Py_None);
-        return Py_None;
-    }
-    // obj as caml value
-    v = (value *)PyCObject_AsVoidPtr( obj );
-    out = callback(*v, Val_PyObject(args, 1)); // takes only 1 argument
-    return PyObject_val(out);
-}
+(* open Opycaml.Api is recommended. *)
 open Opycaml.Api
 
 let _ =
 
   let res = Object.callObject (Callable.coerce capitalize) [lowercase] in
 
-  prerr_endline (String.asString (String.coerce res));
+  (* String class is not accessible by String but Py.String, in order
+     to avoid the name space collision with String in OCaml standard
+     library. *)
+  prerr_endline (Py.String.asString (Py.String.coerce res));
 
   Base.finalize ()
 ;;
+/bin/rm -rf build
+python setup.py build
+sudo python setup.py install
+

python/opycaml_ext.c

+// dummy
+from distutils.core import setup, Extension
+
+module1 = Extension('opycaml',
+                    sources = ['opycaml_ext.c'],
+                    libraries = ['asmrun', 'camlidl'],
+                    extra_objects = ['../opycaml_python.o', '../api_ml.o', '../auto_stubs.o'],
+                    library_dirs = ['/home/jfuruse/.share/prefix/lib/ocaml', '/usr/lib/ocaml'])
+
+setup ( name = 'OPyCaml',
+        version = '1.0',
+        description = 'O\'PyCaml',
+        ext_modules = [module1] )
+
+                    
     ignore (Import.importModule "hogehoge")
   with
   | Error (e, detail) ->
-      Printf.eprintf "Error: %s %s\n%!" (String.asString (Object.repr e)) (String.asString (Object.repr detail))
+      Printf.eprintf "Error: %s %s\n%!" (Py.String.asString (Object.repr e)) (Py.String.asString (Object.repr detail))
 ;;
 
 let _ =
-  let o = String.fromString "hello world" in
+  let o = Py.String.fromString "hello world" in
   Base.debug "o" o;
 
   assert (Base.phys_eq o o);
     let res = Object.callObject (Callable.coerce capitalize) [o] in
     Printf.eprintf "res : refcnt = %d\n%!" (Base.refcnt res);
     prerr_endline "function called!";
-    prerr_endline (String.asString (String.coerce res));
-    prerr_endline (String.asString o);
+    prerr_endline (Py.String.asString (Py.String.coerce res));
+    prerr_endline (Py.String.asString o);
 
     let minus_1 = Int.fromLong (-1) in
     assert (Int.asLong minus_1 = -1); 
 
   with
   | Error (e, detail) -> 
-      Printf.eprintf "Error: %s %s\n%!" (String.asString (Object.repr e)) (String.asString (Object.repr detail))
+      Printf.eprintf "Error: %s %s\n%!" (Py.String.asString (Object.repr e)) (Py.String.asString (Object.repr detail))
 ;;
 
 let _ = Base.finalize ()