(*
 * (C) arty 2002

 This library is free software; you can redistribute it and/or modify
 it under the terms of the GNU Lesser General Public License as
 published by the Free Software Foundation; either version 2.1 of the
 License, or (at your option) any later version.

 This library is distributed in the hope that it will be useful, but
 WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 Lesser General Public License for more details.

 You should have received a copy of the GNU Lesser General Public
 License along with this library; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
 USA

 * Major Modifications (C) T. Fischbacher 2005,2006
 * 
 * NOTE: have to properly document the CamlType / ocamlpill mechanism!
   
 * More modifications are by Barry Schwartz.
 * Copyright (C) 2009 Barry Schwartz.

 * Note (T.F.): Should we incorporate auto-conversion of int to float?
 * At present, we do not do this. (B.S.): Maybe we should, or maybe we
 * shouldn't. But BytesType/UnicodeType/string conversion does seem
 * called for; it's getting to be a big problem in kompostilo.
 *)

type funcptr 
type pyobject 
type funcent = (funcptr * int * int * bool)

type pymodule_func = {
  pyml_name : string ; 
  pyml_func : (pyobject -> pyobject) ;
  pyml_flags : int ;
  pyml_doc : string;
}

type pyobject_type =
  | TupleType
  | BytesType
  | UnicodeType
  | BoolType
  | IntType
  | FloatType
  | ListType
  | NoneType
  | CallableType
  | ModuleType
  | ClassType
  | TypeType
  | DictType
  | NullType
  | CamlpillType
  | OtherType
  | EitherStringType (* Signifies that either of BytesType or UnicodeType is allowed. *)
  | CamlpillSubtype of string (* Signifies that only the particular Camlpill variety is allowed. *)
  | AnyType                   (* Allow any python object. *)

type pyerror_type =
  | Pyerr_Exception
  | Pyerr_StandardError
  | Pyerr_ArithmeticError
  | Pyerr_LookupError
  | Pyerr_AssertionError
  | Pyerr_AttributeError
  | Pyerr_EOFError
  | Pyerr_EnvironmentError
  | Pyerr_FloatingPointError
  | Pyerr_IOError
  | Pyerr_ImportError
  | Pyerr_IndexError
  | Pyerr_KeyError
  | Pyerr_KeyboardInterrupt
  | Pyerr_MemoryError
  | Pyerr_NameError
  | Pyerr_NotImplementedError
  | Pyerr_OSError
  | Pyerr_OverflowError
  | Pyerr_ReferenceError
  | Pyerr_RuntimeError
  | Pyerr_SyntaxError
  | Pyerr_SystemExit
  | Pyerr_TypeError
  | Pyerr_ValueError
  | Pyerr_ZeroDivisionError

exception Pycaml_exn of (pyerror_type * string)

      
(* Function list *)
      
external pytype : pyobject -> pyobject_type = "pytype"

external pycaml_seterror : pyerror_type -> string -> unit = "pycaml_seterror"

external pynull : unit -> pyobject = "pynull"
external pynone : unit -> pyobject = "pynone"
external py_true : unit -> pyobject = "py_true"
external py_false : unit -> pyobject = "py_false"

(*-----------------------------------------------------------------------*)

(* Type1 *)
external py_initialize : unit -> unit = "Py_Initialize_wrapper"
external py_finalize : unit -> unit = "Py_Finalize_wrapper"
external pyerr_print : unit -> unit = "PyErr_Print_wrapper"
external pyerr_clear : unit -> unit = "PyErr_Clear_wrapper"
external pyimport_cleanup : unit -> unit = "PyImport_Cleanup_wrapper"

(* Type2 *)
external py_exit : int -> unit = "Py_Exit_wrapper"
external pyerr_printex : int -> unit = "PyErr_PrintEx_wrapper"

(* Type3 *)
external py_setprogramname : string -> unit = "Py_SetProgramName_wrapper"
external py_setpythonhome : string -> unit = "Py_SetPythonHome_wrapper"

(* Type4 *)
external py_isinitialized : unit -> int = "Py_IsInitialized_wrapper"
IFDEF PYMAJOR2 THEN
external pyeval_getrestricted : unit -> int = "PyEval_GetRestricted_wrapper"
END

(* Type5 *)
external pyrun_simplestring : string -> int = "PyRun_SimpleString_wrapper"
external pyimport_importfrozenmodule : string -> int = "PyImport_ImportFrozenModule_wrapper"

(* Test6 *)
external pyrun_anyfile : (int * string) -> int = "PyRun_AnyFile_wrapper"
external pyrun_simplefile : (int * string) -> int = "PyRun_SimpleFile_wrapper"
external pyrun_interactiveone : (int * string) -> int = "PyRun_InteractiveOne_wrapper"
external pyrun_interactiveloop : (int * string) -> int = "PyRun_InteractiveLoop_wrapper"
external py_fdisinteractive : (int * string) -> int = "Py_FdIsInteractive_wrapper"

(* Type7 *)
external pyrun_anyfileex : (int * string * int) -> int = "PyRun_AnyFileEx_wrapper"
external pyrun_simplefileex : (int * string * int) -> int = "PyRun_SimpleFileEx_wrapper"

(* Type8 *)
external py_getprogramname : unit -> string = "Py_GetProgramName_wrapper"
external py_getpythonhome : unit -> string = "Py_GetPythonHome_wrapper"
external py_getprogramfullpath : unit -> string = "Py_GetProgramFullPath_wrapper"
external py_getprefix : unit -> string = "Py_GetPrefix_wrapper"
external py_getexecprefix : unit -> string = "Py_GetExecPrefix_wrapper"
external py_getpath : unit -> string = "Py_GetPath_wrapper"
external py_getversion : unit -> string = "Py_GetVersion_wrapper"
external py_getplatform : unit -> string = "Py_GetPlatform_wrapper"
external py_getcopyright : unit -> string = "Py_GetCopyright_wrapper"
external py_getcompiler : unit -> string = "Py_GetCompiler_wrapper"
external py_getbuildinfo : unit -> string = "Py_GetBuildInfo_wrapper"

(* Type9 *)
external pyrun_string : (string * int * pyobject * pyobject) -> pyobject = "PyRun_String_wrapper"

(* Type10 *)
external pyrun_file : (int * string * int * pyobject * pyobject) -> pyobject = "PyRun_File_wrapper"

(* Type11 *)
external pyrun_fileex : (int * string * int * pyobject * pyobject * int) -> pyobject = "PyRun_FileEx_wrapper"

(* Type12 *)
external py_compilestring : (string * string * int) -> pyobject = "Py_CompileString_wrapper"

(* Type13 *)
external pyobject_print : (pyobject * int * int) -> int = "PyObject_Print_wrapper"
external pytuple_getslice : (pyobject * int * int) -> int = "PyTuple_GetSlice_wrapper"
external pysequence_getslice : (pyobject * int * int) -> int = "PySequence_GetSlice_wrapper"

(* Type14 *)
external pymethod_function : pyobject -> pyobject = "PyMethod_Function_wrapper"
external pymethod_self : pyobject -> pyobject = "PyMethod_Self_wrapper"
IFDEF PYMAJOR2 THEN
external pymethod_class : pyobject -> pyobject = "PyMethod_Class_wrapper"
END
external pymodule_getdict : pyobject -> pyobject = "PyModule_GetDict_wrapper"
external pyunicode_asutf8string : pyobject -> pyobject = "PyUnicode_AsUTF8String_wrapper"
external pyunicode_asutf16string : pyobject -> pyobject = "PyUnicode_AsUTF16String_wrapper"
external pyunicode_asutf32string : pyobject -> pyobject = "PyUnicode_AsUTF32String_wrapper"
external pyobject_repr : pyobject -> pyobject = "PyObject_Repr_wrapper"
external pyimport_reloadmodule : pyobject -> pyobject = "PyImport_ReloadModule_wrapper"
external pyimport_import : pyobject -> pyobject = "PyImport_Import_wrapper"
external pyobject_str : pyobject -> pyobject = "PyObject_Str_wrapper"
external pyobject_type : pyobject -> pyobject = "PyObject_Type_wrapper"
external pyobject_unicode : pyobject -> pyobject = "PyObject_Unicode_wrapper"
external pydict_keys : pyobject -> pyobject = "PyDict_Keys_wrapper"
external pydict_values : pyobject -> pyobject = "PyDict_Values_wrapper"
external pydict_items : pyobject -> pyobject = "PyDict_Items_wrapper"
external pydict_copy : pyobject -> pyobject = "PyDict_Copy_wrapper"
external pysequence_tuple : pyobject -> pyobject = "PySequence_Tuple_wrapper"
external pysequence_list : pyobject -> pyobject = "PySequence_List_wrapper"
IFDEF PYMAJOR2 THEN
external pynumber_int : pyobject -> pyobject = "PyNumber_Int_wrapper"
END
external pynumber_long : pyobject -> pyobject = "PyNumber_Long_wrapper"
external pynumber_float : pyobject -> pyobject = "PyNumber_Float_wrapper"
external pynumber_negative : pyobject -> pyobject = "PyNumber_Negative_wrapper"
external pynumber_positive : pyobject -> pyobject = "PyNumber_Positive_wrapper"
external pynumber_absolute : pyobject -> pyobject = "PyNumber_Absolute_wrapper"
external pynumber_invert : pyobject -> pyobject = "PyNumber_Invert_wrapper"
external pyiter_next : pyobject -> pyobject = "PyIter_Next_wrapper"

(* Type15 *)
external pyobject_richcompare : (pyobject * pyobject * int) -> pyobject = "PyObject_RichCompare_wrapper"

(* Type16 *)
external pydict_getitemstring : (pyobject * string) -> pyobject = "PyDict_GetItemString_wrapper"
external pyobject_getattrstring : (pyobject * string) -> pyobject = "PyObject_GetAttrString_wrapper"
external pysequence_fast : (pyobject * string) -> pyobject = "PySequence_Fast_wrapper"
external pymapping_getitemstring : (pyobject * string) -> pyobject = "PyMapping_GetItemString_wrapper"

(* Type17 *)
external pydict_getitem : pyobject * pyobject -> pyobject = "PyDict_GetItem_wrapper"
external pyeval_callobject : pyobject * pyobject -> pyobject = "PyEval_CallObject_wrapper"
external pyobject_getattr : pyobject * pyobject -> pyobject = "PyObject_GetAttr_wrapper"
external pyobject_getitem : pyobject * pyobject -> pyobject = "PyObject_GetItem_wrapper"
external pynumber_add : pyobject * pyobject -> pyobject = "PyNumber_Add_wrapper"
external pynumber_subtract : pyobject * pyobject -> pyobject = "PyNumber_Subtract_wrapper"
external pynumber_multiply : pyobject * pyobject -> pyobject = "PyNumber_Multiply_wrapper"
IFDEF PYMAJOR2 THEN
external pynumber_divide : pyobject * pyobject -> pyobject = "PyNumber_Divide_wrapper"
END
external pynumber_truedivide : pyobject * pyobject -> pyobject = "PyNumber_TrueDivide_wrapper"
external pynumber_floordivide : pyobject * pyobject -> pyobject = "PyNumber_FloorDivide_wrapper"
external pynumber_remainder : pyobject * pyobject -> pyobject = "PyNumber_Remainder_wrapper"
external pynumber_divmod : pyobject * pyobject -> pyobject = "PyNumber_Divmod_wrapper"
external pynumber_lshift : pyobject * pyobject -> pyobject = "PyNumber_Lshift_wrapper"
external pynumber_rshift : pyobject * pyobject -> pyobject = "PyNumber_Rshift_wrapper"
external pynumber_and : pyobject * pyobject -> pyobject = "PyNumber_And_wrapper"
external pynumber_xor : pyobject * pyobject -> pyobject = "PyNumber_Xor_wrapper"
external pynumber_or : pyobject * pyobject -> pyobject = "PyNumber_Or_wrapper"
external pynumber_inplaceadd : pyobject * pyobject -> pyobject = "PyNumber_InPlaceAdd_wrapper"
external pynumber_inplacesubtract : pyobject * pyobject -> pyobject = "PyNumber_InPlaceSubtract_wrapper"
external pynumber_inplacemultiply : pyobject * pyobject -> pyobject = "PyNumber_InPlaceMultiply_wrapper"
external pynumber_inplacetruedivide : pyobject * pyobject -> pyobject = "PyNumber_InPlaceTrueDivide_wrapper"
external pynumber_inplacefloordivide : pyobject * pyobject -> pyobject = "PyNumber_InPlaceFloorDivide_wrapper"
IFDEF PYMAJOR2 THEN
external pynumber_inplacedivide : pyobject * pyobject -> pyobject = "PyNumber_InPlaceDivide_wrapper"
END
external pynumber_inplaceremainder : pyobject * pyobject -> pyobject = "PyNumber_InPlaceRemainder_wrapper"
external pynumber_inplacelshift : pyobject * pyobject -> pyobject = "PyNumber_InPlaceLshift_wrapper"
external pynumber_inplacershift : pyobject * pyobject -> pyobject = "PyNumber_InPlaceRshift_wrapper"
external pynumber_inplaceand : pyobject * pyobject -> pyobject = "PyNumber_InPlaceAnd_wrapper"
external pynumber_inplacexor : pyobject * pyobject -> pyobject = "PyNumber_InPlaceXor_wrapper"
external pynumber_inplaceor : pyobject * pyobject -> pyobject = "PyNumber_InPlaceOr_wrapper"
IFDEF PYMAJOR2 THEN
external pybytes_format : pyobject * pyobject -> pyobject = "PyBytes_Format_wrapper"
external pystring_format : pyobject * pyobject -> pyobject = "PyBytes_Format_wrapper" (* Legacy support *)
external pyinstance_newraw : pyobject * pyobject -> pyobject = "PyInstance_NewRaw_wrapper"
END
external pysequence_concat : pyobject * pyobject -> pyobject = "PySequence_Concat_wrapper"
external pysequence_inplaceconcat : pyobject * pyobject -> pyobject = "PySequence_InPlaceConcat_wrapper"

(* Type18 *)
external pyobject_istrue : pyobject -> int = "PyObject_IsTrue_wrapper"
external pyobject_not : pyobject -> int = "PyObject_Not_wrapper"
external pycallable_check : pyobject -> int = "PyCallable_Check_wrapper"
external pybytes_size : pyobject -> int = "PyBytes_Size_wrapper"
external pystring_size : pyobject -> int = "PyBytes_Size_wrapper" (* Legacy support *)
external pydict_size : pyobject -> int = "PyDict_Size_wrapper"
external pytuple_size : pyobject -> int = "PyTuple_Size_wrapper"
external pyerr_exceptionmatches : pyobject -> int = "PyErr_ExceptionMatches_wrapper"
external pyobject_size : pyobject -> int = "PyObject_Size_wrapper"
external pynumber_check : pyobject -> int = "PyNumber_Check_wrapper"
external pysequence_check : pyobject -> int = "PySequence_Check_wrapper"
external pysequence_size : pyobject -> int = "PySequence_Size_wrapper"
external pysequence_length : pyobject -> int = "PySequence_Length_wrapper"
external pymapping_check : pyobject -> int = "PyMapping_Check_wrapper"
external pymapping_size : pyobject -> int = "PyMapping_Size_wrapper"
external pymapping_length : pyobject -> int = "PyMapping_Length_wrapper"
external pyiter_check : pyobject -> int = "PyIter_Check_wrapper"
external pyunicode_getsize : pyobject -> int = "PyUnicode_GetSize_wrapper"

(* Type19 *)
external pyobject_hasattr : (pyobject * pyobject) -> int = "PyObject_HasAttr_wrapper"
external pyobject_delitem : (pyobject * pyobject) -> int = "PyObject_DelItem_wrapper"
external pydict_delitem : (pyobject * pyobject) -> int = "PyDict_DelItem_wrapper"
external pyerr_givenexceptionmatches : (pyobject * pyobject) -> int = "PyErr_GivenExceptionMatches_wrapper"
external pysequence_count : (pyobject * pyobject) -> int = "PySequence_Count_wrapper"
external pysequence_contains : (pyobject * pyobject) -> int = "PySequence_Contains_wrapper"
external pysequence_in : (pyobject * pyobject) -> int = "PySequence_In_wrapper"
external pysequence_index : (pyobject * pyobject) -> int = "PySequence_Index_wrapper"
external pymapping_haskey : (pyobject * pyobject) -> int = "PyMapping_HasKey_wrapper"

IFDEF PYCAML2 THEN
external pyobject_compare : (pyobject * pyobject) -> int = "PyObject_Compare_wrapper"
END

(* Type20 *)
external pyobject_richcomparebool : (pyobject * pyobject * int) -> int = "PyObject_RichCompareBool_wrapper"

(* Type21 *)
external pyobject_setattrstring : (pyobject * string * pyobject) -> int = "PyObject_SetAttrString_wrapper"
external pydict_setitemstring : (pyobject * string * pyobject) -> int = "PyDict_SetItemString_wrapper"
external pymapping_setitemstring : (pyobject * string * pyobject) -> int = "PyMapping_SetItemString_wrapper"

(* Type22 *)
external pymapping_haskeystring : (pyobject * string) -> int = "PyMapping_HasKeyString_wrapper"
external pyobject_hasattrstring : (pyobject * string) -> int = "PyObject_HasAttrString_wrapper"
external pydict_delitemstring : (pyobject * string) -> int = "PyDict_DelItemString_wrapper"

(* Type23 -- currently not implemented.
external pynumber_coerce : (pyobject * pyobject) -> (pyobject * pyobject) option = "PyNumber_Coerce_wrapper"
external pynumber_coerceex : (pyobject * pyobject) -> (pyobject * pyobject) option = "PyNumber_CoerceEx_wrapper"
*)

(* Type24 *)
external pyobject_setattr : (pyobject * pyobject * pyobject) -> int = "PyObject_SetAttr_wrapper"
external pyobject_setitem : (pyobject * pyobject * pyobject) -> int = "PyObject_SetItem_wrapper"
external pydict_setitem : (pyobject * pyobject * pyobject) -> int = "PyDict_SetItem_wrapper"

(* Type25 *)
external pyobject_hash : pyobject -> int64 = "PyObject_Hash_wrapper"
external pyint_aslong : pyobject -> int64 = "PyInt_AsLong_wrapper"

(* Type26 *)
external pybytes_asstring : pyobject -> string = "PyBytes_AsString_wrapper"
external pystring_asstring : pyobject -> string = "PyBytes_AsString_wrapper" (* Legacy support *)
external pymodule_getfilename : pyobject -> string = "PyModule_GetFilename_wrapper"
external pymodule_getname : pyobject -> string = "PyModule_GetName_wrapper"

(* Type28 *)
external pyimport_addmodule : string -> pyobject = "PyImport_AddModule_wrapper"
external pybytes_fromstring : string -> pyobject = "PyBytes_FromString_wrapper"
external pystring_fromstring : string -> pyobject = "PyBytes_FromString_wrapper" (* Legacy support *)
external pymodule_new : string -> pyobject = "PyModule_New_wrapper"
external pyimport_importmodule : string -> pyobject = "PyImport_ImportModule_wrapper"

(* Type29 *)
external pydict_new : unit -> pyobject = "PyDict_New_wrapper"
external pyerr_occurred : unit -> pyobject = "PyErr_Occurred_wrapper"
external pyimport_getmoduledict : unit -> pyobject = "PyImport_GetModuleDict_wrapper"
external pyeval_getbuiltins : unit -> pyobject = "PyEval_GetBuiltins_wrapper"
external pyeval_getglobals : unit -> pyobject = "PyEval_GetGlobals_wrapper"
external pyeval_getlocals : unit -> pyobject = "PyEval_GetLocals_wrapper"
(* external pyeval_getframe : unit -> pyobject = "PyEval_GetFrame_wrapper"  -- FIX: see note in stubs. *)

(* Type30 *)
external pydict_clear : pyobject -> unit = "PyDict_Clear_wrapper"
external pyerr_setnone : pyobject -> unit = "PyErr_SetNone_wrapper"

(* Type31  -- currently not implemented.
external pydict_next : (pyobject * int) -> (pyobject * pyobject * int) option = "PyDict_Next_wrapper"
*)

(* Type34 *)
external pyint_fromlong : int64 -> pyobject = "PyInt_FromLong_wrapper"

(* Type35 *)
IFDEF PYMAJOR2 THEN
external pyint_getmax : unit -> int64 = "PyInt_GetMax_wrapper"
END
external pyimport_getmagicnumber : unit -> int64 = "PyImport_GetMagicNumber_wrapper"

(* Type36 *)
external pyfloat_fromdouble : float -> pyobject = "PyFloat_FromDouble_wrapper"

(* Type37 *)
external pyfloat_asdouble : pyobject -> float = "PyFloat_AsDouble_wrapper"

(* Type39 *)
external pytuple_new : int -> pyobject = "PyTuple_New_wrapper"

(* Type40 *)
external pysequence_inplacerepeat : (pyobject * int) -> pyobject = "PySequence_InPlaceRepeat_wrapper"
external pytuple_getitem : (pyobject * int) -> pyobject = "PyTuple_GetItem_wrapper"
external pysequence_repeat : (pyobject * int) -> pyobject = "PySequence_Repeat_wrapper"
external pysequence_getitem : (pyobject * int) -> pyobject = "PySequence_GetItem_wrapper"

(* Type40b *)
external pysequence_delitem : (pyobject * pyobject * int) -> int = "PySequence_DelItem_wrapper"

(* Type41 *)
external pytuple_setitem : (pyobject * int * pyobject) -> int = "PyTuple_SetItem_wrapper"
external pysequence_setitem : (pyobject * int * pyobject) -> int = "PySequence_SetItem_wrapper"

(* Type42 *)
external pyslice_new : (pyobject * pyobject * pyobject) -> pyobject = "PySlice_New_wrapper"
IFDEF PYMAJOR2 THEN
external pyclass_new : (pyobject * pyobject * pyobject) -> pyobject = "PyClass_New_wrapper"
external pyinstance_new : (pyobject * pyobject * pyobject) -> pyobject = "PyInstance_New_wrapper"
END
IFDEF PYMAJOR2 THEN
external pymethod_new : (pyobject * pyobject * pyobject) -> pyobject = "PyMethod_New_wrapper"
ELSE
external pymethod_new : (pyobject * pyobject) -> pyobject = "PyMethod_New_wrapper"
END
external pyeval_callobjectwithkeywords : (pyobject * pyobject * pyobject) -> pyobject = "PyEval_CallObjectWithKeywords_wrapper"
external pynumber_power : (pyobject * pyobject * pyobject) -> pyobject = "PyNumber_Power_wrapper"
external pynumber_inplacepower : (pyobject * pyobject * pyobject) -> pyobject = "PyNumber_InPlacePower_wrapper"

(* Type43 *)
(* external pyslice_getindices : (pyobject * int) -> (int * int * int) option = "PySlice_GetIndices_wrapper" <-- Currently not supported *)

(* Type45 *)
external pyerr_setobject : (pyobject * pyobject) -> unit = "PyErr_SetObject_wrapper"

(* Type46 *)
external pyerr_setstring : (pyobject * string) -> unit = "PyErr_SetString_wrapper"

(* Type47 *)
external pyerr_fetch : (pyobject * pyobject * pyobject) -> (pyobject * pyobject * pyobject) = "PyErr_Fetch_wrapper"
external pyerr_normalizeexception : (pyobject * pyobject * pyobject) -> (pyobject * pyobject * pyobject) = "PyErr_NormalizeException_wrapper"

(* Type48 *)
external pyerr_restore : (pyobject * pyobject * pyobject) -> unit = "PyErr_Restore_wrapper"

(* Type49 *)
external pyimport_execcodemodule : (pyobject * string) -> pyobject = "PyImport_ExecCodeModule_wrapper"

(* Type50 *)
external pyimport_execcodemoduleex : (string * pyobject * string) -> pyobject = "PyImport_ExecCodeModuleEx_wrapper"

(* Type51 *)
external pyimport_importmoduleex : (string * pyobject * pyobject * pyobject) -> pyobject = "PyImport_ImportModuleEx_wrapper"

(* Type52 *)
external pybytes_asstringandsize : pyobject -> string = "PyBytes_AsStringAndSize_wrapper"
external pystring_asstringandsize : pyobject -> string = "PyBytes_AsStringAndSize_wrapper" (* Legacy support *)
external pyobject_ascharbuffer : pyobject -> string = "PyObject_AsCharBuffer_wrapper"
external pyobject_asreadbuffer : pyobject -> string = "PyObject_AsReadBuffer_wrapper"
external pyobject_aswritebuffer : pyobject -> string = "PyObject_AsWriteBuffer_wrapper"

(* Type53 *)
external pysequence_setslice : (pyobject * int * int * pyobject) -> int = "PySequence_SetSlice_wrapper"

(* Type54 *)
external pysequence_delslice : (pyobject * int * int) -> int = "PySequence_DelSlice_wrapper"

(* TypeUTF8Decoder *)
external pyunicode_decodeutf8 : (string * string option) -> pyobject = "PyUnicode_DecodeUTF8_wrapper"

(* TypeUTF16Decoder *)
external pyunicode_decodeutf16 : (string * string option * int option) -> pyobject = "PyUnicode_DecodeUTF16_wrapper"
external pyunicode_decodeutf32 : (string * string option * int option) -> pyobject = "PyUnicode_DecodeUTF32_wrapper"

(*-----------------------------------------------------------------------*)

external pyunicode_fromunicode : (int -> int) -> int -> pyobject = "PyUnicode_FromUnicode_wrapper"
external pyunicode_asunicode   : pyobject -> int array = "PyUnicode_AsUnicode_wrapper"

(*-----------------------------------------------------------------------*)

external pytuple_fromarray : pyobject array -> pyobject = "pytuple_fromarray"
let pytuple_fromsingle elt = pytuple_fromarray [| elt |] 
let pytuple_empty = pytuple_fromarray [| |] 
external pytuple2 : (pyobject * pyobject) -> pyobject = "pytuple_fromarray"
external pytuple3 : (pyobject * pyobject * pyobject) -> pyobject = "pytuple_fromarray"
external pytuple4 : (pyobject * pyobject * pyobject * pyobject) -> pyobject = "pytuple_fromarray"
external pytuple5 : (pyobject * pyobject * pyobject * pyobject * pyobject) -> pyobject = "pytuple_fromarray"

let pyint_fromint i = pyint_fromlong (Int64.of_int i)
let pyint_asint obj = Int64.to_int (pyint_aslong obj)
    
external pytuple_toarray : pyobject -> pyobject array = "pytuple_toarray"
    
external pywrap_closure : (pyobject -> pyobject) -> pyobject = "pywrap_closure"

external pywrap_value : 'a -> pyobject = "pywrapvalue"
external pywrap_value_pill : 'a -> pyobject = "pywrapvalue_pill"

external pyunwrap_value : pyobject -> 'a = "pyunwrapvalue"
(* ^ Note: this will just unwrap and not care about pills! *)

(* -- T.F. extensions -- *)

let py_repr x = pybytes_asstring (pyobject_repr x)

external pywrap_closure_docstring :
  string -> (pyobject -> pyobject) -> pyobject = "pywrap_closure_docstring"


external pylist_fromarray : pyobject array -> pyobject = "pylist_fromarray"
external pylist_toarray : pyobject -> pyobject array = "pylist_toarray"
external pylist_set: pyobject -> int -> pyobject -> unit = "pylist_set"
external pylist_get: pyobject -> int -> pyobject = "pylist_get"

external python_prompt: unit -> unit = "pycaml_prompt"

external pyrefcount: pyobject -> int = "pyrefcount"

let _py_profile_hash = ((Hashtbl.create 100):(string, float array) Hashtbl.t)
let _py_profiling_active=ref false
(* The profiling hash and switch are strictly internal! *)

let py_activate_profiling () =
  let z = !_py_profiling_active in
  let () = _py_profiling_active:=true in
    z

let py_deactivate_profiling () =
  let z = !_py_profiling_active in
  let () = _py_profiling_active:=false in
    z


let py_profile_reset () = Hashtbl.clear _py_profile_hash

(* Needed below. Actually, we also have this in our "snippets" module,
   but pycaml should not depend on anything not in the standard ocaml
   distribution.
*)

let __hashtbl_arbitrary_element ht =
  let have_it = ref None in
  let () =
    try
      Hashtbl.iter
	(fun k v ->
	   begin
	     have_it := Some (k,v);
	     raise Not_found; (* abused as a dummy exception here *)
	   end)
	ht
    with
      | Not_found -> ()
  in
    !have_it

let __map_hashtbl_to_array ?sorter mapper ht =
  let nr_entries = Hashtbl.length ht in
    if nr_entries = 0 
    then [||]
    else
      let opt_kv = __hashtbl_arbitrary_element ht in
      let result =
	match opt_kv with
	  | None -> failwith "Impossible!"
	  | Some (k,v) -> Array.make nr_entries (mapper k v)
      in
      let ref_index = ref 0 in
      let () = Hashtbl.iter
	(fun k v ->
	   begin
	     result.(!ref_index) <- mapper k v;
	     ref_index := (1+ !ref_index);
	   end) ht
      in
	match sorter with
	  | Some s ->
	      let () = Array.sort s result in result
	  | _ -> result


let py_profile_report () =
  __map_hashtbl_to_array
    ~sorter:(fun (_,time_a,_) (_,time_b,_) -> compare time_b time_a) (* sort by time consumed *)
    (fun name time_and_calls -> (name,time_and_calls.(0),time_and_calls.(1)))
    _py_profile_hash


let pytype_name pt =
  match pt with
  | TupleType -> "Python-Tuple"
  | BytesType -> "Python-Bytes"
  | UnicodeType -> "Python-Unicode"
  | BoolType -> "Python-Bool"
  | IntType -> "Python-Int"
  | FloatType -> "Python-Float"
  | ListType -> "Python-List"
  | NoneType -> "Python-None"
  | CallableType -> "Python-Callable"
  | ModuleType -> "Python-Module"
  | ClassType -> "Python-Class"
  | NullType -> "Python-Null"
  | TypeType -> "Python-Type"
  | DictType -> "Python-Dict"
  | CamlpillType -> "Python-Camlpill"
  | OtherType -> "Python-Other"
  | EitherStringType -> "Python-EitherString"
  | CamlpillSubtype sym -> "Python-Camlpill-" ^ sym
  | AnyType -> "Python-Any"

let set_python_argv argv =
  let py_mod_sys_dict = pymodule_getdict (pyimport_importmodule "sys") in
  let _ = pydict_setitem(py_mod_sys_dict,pybytes_fromstring "argv",
			 pylist_fromarray (Array.map pybytes_fromstring argv))
  in ()

let python_eval str =
  pyrun_simplestring str

let python_load filename =
  ignore(python_eval (Printf.sprintf "execfile(\"%s\")" filename))

let python () =
  let () = python_prompt() in 0

let ipython () =
  pyrun_simplestring
(* This version starts ipython with its own name space -- one
   can't see any objects created with earlier pycaml.* commands.

   I have added a replacement below. (Delete this comment later if 
   this generally works. (HF 23/09/05)
 *)
(* "import IPython       
import sys
sys.argv=['/usr/local/bin/ipython']
IPython.Shell.start().mainloop()
";;*)
"from IPython.Shell import IPShellEmbed
ipshell = IPShellEmbed(argv=[''])
ipshell() # this call anywhere in your program will start IPython
";;


(* Note: we prepare Python in such a way that we have a module ocaml
   within which the OCaml side will publish its own functions.

   Convention: We will register some examples in ocaml.*
   These will have names that start with "example_".
*)

let _ = py_initialize () (* Note that this must happen that early... *)

let _py_sys_modules = pyimport_getmoduledict ()
let _py_mod_ocaml = pymodule_new "ocaml"
let _py_mod_ocaml_dict = pymodule_getdict _py_mod_ocaml

(* Get the last value that was computed in the interactive REPL *)
let python_last_value () =
  let main = pyimport_importmodule "__main__" in
  let main_dict = pymodule_getdict main in
  let builtins = pydict_getitem (main_dict, pybytes_fromstring "__builtins__") in
  let builtins_dict = pymodule_getdict builtins in
  let pyname_lastvalue = pybytes_fromstring "_" in
    pydict_getitem (builtins_dict, pyname_lastvalue)

let py_is_true x = pyobject_istrue x <> 0 (* pyobject_istrue has return type int - which is quite insane... *)

let register_for_python stuff =
  Array.iter
    (fun (python_name, value) ->
       ignore(pydict_setitemstring
		(_py_mod_ocaml_dict,
		 python_name, value)))
    stuff

let register_pre_functions_for_python stuff =
  Array.iter
    (fun (python_name, pre_fun) ->
       ignore(pydict_setitemstring
		(_py_mod_ocaml_dict,
		 python_name, pre_fun python_name)))
    stuff


let float_array_to_python farr =
  pylist_fromarray (Array.map pyfloat_fromdouble farr)

let int_array_to_python iarr =
  pylist_fromarray (Array.map pyint_fromint iarr)


let py_float_tensor ?(init=(fun _ -> 0.0)) index_ranges =
  let nr_indices = Array.length index_ranges in
  let v_indices = Array.make nr_indices 0 in
    if nr_indices = 0
    then (pyfloat_fromdouble (init v_indices), fun _ -> failwith "Cannot set rank-0 python float tensor!")
    else
      let rec build pos =
	let range = index_ranges.(pos) in
	  if pos = nr_indices-1
	  then
	    pylist_fromarray 
	      (Array.init range
		 (fun ix_here ->
		    let () = v_indices.(pos) <- ix_here in
		      pyfloat_fromdouble (init v_indices)))
	  else
	    pylist_fromarray
	      (Array.init range
		 (fun ix_here ->
		    let () = v_indices.(pos) <- ix_here in
		      build (1+pos)))
      in
      let structure = build 0
      in
      let setter indices value =
	let rec walk sub_structure pos =
	  if pos = nr_indices-1
	  then pylist_set sub_structure indices.(pos) value
	  else walk (pylist_get sub_structure indices.(pos)) (1+pos)
	in walk structure 0
      in (structure,setter)



let py_homogeneous_list_as_array
    ?error_label
    ?length
    type_name type_checker unwrapper
    py_obj_arr
    =
  let array_first_not_to_satisfy p arr =
    let len = Array.length arr in
    let rec walk n =
      if n = len then (-1)
      else if p (arr.(n)) then walk (n+1)
      else n
    in walk 0
  in
  let the_error_label =
    match error_label with
      | None -> ""
      | Some x -> Printf.sprintf "%s: " x
  in
    if pytype py_obj_arr <> ListType then 
      raise 
	    (Pycaml_exn
	       (Pyerr_TypeError,
	        Printf.sprintf "%sExpected list, got: %s (%s)" the_error_label
	          (pytype_name (pytype py_obj_arr))
	          (py_repr py_obj_arr)
	       ))
    else
      let obj_arr = pylist_toarray py_obj_arr in
        (* Doing the length check is slightly tricky... *)
      let () =
        match length with
	      | None -> ()
	      | Some len ->
	          if Array.length obj_arr <> len then
	            raise 
		          (Pycaml_exn
		             (Pyerr_TypeError,
		              Printf.sprintf "%sExpected list of length %d, got length: %d"
		                the_error_label
		                len (Array.length obj_arr)))
      in
      let first_bad = array_first_not_to_satisfy type_checker obj_arr in
        if first_bad <> (-1) then
	      raise 
            (Pycaml_exn
               (Pyerr_TypeError,
	            Printf.sprintf "%sExpected homogeneous list of %s. Entry %d is of type %s (%s)!"
		          the_error_label
		          type_name
		          (1 + first_bad)
		          (pytype_name (pytype obj_arr.(first_bad)))
		          (py_repr obj_arr.(first_bad))))
        else
	      Array.map unwrapper obj_arr



let py_float_list_as_array ?error_label ?length arr =
  py_homogeneous_list_as_array
    ?error_label ?length
    "float" (fun x -> pytype x = FloatType) pyfloat_asdouble arr

let py_int_list_as_array ?error_label ?length arr =
  py_homogeneous_list_as_array
    ?error_label ?length
    "int" (fun x -> pytype x = IntType) pyint_asint arr

let py_number_list_as_float_array ?error_label ?length arr =
  py_homogeneous_list_as_array
    ?error_label ?length
    "number" 
    (fun x -> let ty = pytype x in ty = FloatType || ty = IntType)
    (fun x -> if pytype x = FloatType then pyfloat_asdouble x else float_of_int (pyint_asint x))
    arr


let py_string_list_as_array ?error_label ?length arr =
  py_homogeneous_list_as_array
    ?error_label ?length
    "string" (fun x -> pytype x = BytesType) pybytes_asstring arr

let py_list_list_as_array ?error_label ?length arr =
  py_homogeneous_list_as_array
    ?error_label ?length
    "<Python List>" (fun x -> pytype x = ListType) (fun x -> x) arr

let py_list_list_as_array2 ?error_label ?length arr =
  py_homogeneous_list_as_array
    ?error_label ?length
    "<Python List>" (fun x -> pytype x = ListType) pylist_toarray arr


let py_float_list_list_as_array ?error_label ?length_outer ?length_inner arr =
  let arr_outer = py_list_list_as_array ?error_label ?length:length_outer arr in
  Array.map (py_float_list_as_array ?error_label ?length:length_inner) arr_outer

let py_number_list_list_as_float_array ?error_label ?length_outer ?length_inner arr =
  let arr_outer = py_list_list_as_array ?error_label ?length:length_outer arr in
  Array.map (py_number_list_as_float_array ?error_label ?length:length_inner) arr_outer


let py_int_list_list_as_array ?error_label ?length_outer ?length_inner arr =
  let arr_outer = py_list_list_as_array ?error_label ?length:length_outer arr in
  Array.map (py_int_list_as_array ?error_label ?length:length_inner) arr_outer

let py_string_list_list_as_array ?error_label ?length_outer ?length_inner arr =
  let arr_outer = py_list_list_as_array ?error_label ?length:length_outer arr in
  Array.map (py_string_list_as_array ?error_label ?length:length_inner) arr_outer


(* When registering an OCaml function for Python, we should include
   quite some extra run-time type checks. Rationale: Python users expect
   programming errors to produce error messages, not crash the system.

   So, not including these checks would violate the user's expectations.

   The function below helps us wrapping up an OCaml function for
   calling from python with arg conversion, typechecks, and optional
   extra checks for individual parameters. Furthermore, we make sure
   that OCaml exceptions are passed on properly to the Python level.
*)

(* Actually, this turned out to be not quite as useful as I hoped initially... *)
let _caml_debug_exceptions () =
  let ocamlrunparam =
    try
      Unix.getenv "OCAMLRUNPARAM"
    with
      | Not_found ->
          try
            Unix.getenv "CAMLRUNPARAM"
          with
            | Not_found -> ""
  in
  let pieces = Str.split (Str.regexp ",") ocamlrunparam in
    try 
      let _ = List.find (fun p -> p="b") pieces in
        true
    with
      | Not_found -> false

let type_mismatch_exception type_wanted type_here pos exn_name =
  Pycaml_exn
	(Pyerr_TypeError,
	 (Printf.sprintf "Argument %d: Type wanted: %s -- Type provided: %s%s."
		(pos + 1) (* Humans like to start counting at 1. *)
		(pytype_name type_wanted)
		(pytype_name type_here)
		exn_name))

IFDEF PYMAJOR2 THEN
let sym_match a b =
  a == b                      (* Note the == for physical equality. *)
ELSE
let sym_match a b =
  a = b
ENDIF

let pill_type_mismatch_exception ?position ?exn_name wanted gotten =
  let arg_no =
    match position with
      | None -> ""
      | Some p -> "Argument %d: "
  in
  let en =
    match exn_name with
      | None -> ""
      | Some n -> n
  in
  Pycaml_exn (Pyerr_TypeError, 
			  arg_no ^ (Printf.sprintf "Python-Ocaml Pill Type mismatch: wanted: '%s' - got: '%s'" wanted gotten) ^ en)

let ocamlpill_type_of pill =
  if pytype pill <> CamlpillType then
    (* may happen if we e.g. look at list entries *)
    raise (Pycaml_exn(Pyerr_TypeError,
			 Printf.sprintf "Expected OCaml pill - got: %s (%s)"
			   (pytype_name (pytype pill))
			   (py_repr pill)))
  else
    let (type_name, _) = pyunwrap_value pill in
      type_name

let check_pill_type ?position ?exn_name wanted pill =
  let gotten = ocamlpill_type_of pill in
    if not (sym_match gotten wanted) then
      raise (pill_type_mismatch_exception ?position:position ?exn_name:exn_name wanted gotten)

let unpythonizing_function
    ?name                        (* Will be used in error reporting *)
    ?(catch_weird_exceptions = true)
    ?extra_guards (* An array of functions mapping pyobject -> failure_string option *)
    ?(expect_tuple = false)
    wanted_types
    function_body =
  let exn_name =
    match name with
      | None -> ""
      | Some s -> Printf.sprintf " (%s)" s
  in
  let work_fun python_args =
    let body () =
      let () =
        if expect_tuple && pytype python_args <> TupleType then
		  (* ^ This should never happen! *)
          raise (Pycaml_exn(Pyerr_TypeError, Printf.sprintf "Weird situation: Non-Tuple function args encountered.%s" exn_name))
      in
      let nr_args_given =
        if expect_tuple then
          pytuple_size python_args
        else
          1
      in
      let nr_args_wanted = Array.length wanted_types in
      let () =
        if nr_args_given <> nr_args_wanted then
          raise (Pycaml_exn(Pyerr_IndexError,
				            (Printf.sprintf "Args given: %d Wanted: %d%s" nr_args_given nr_args_wanted exn_name)))
      in
      let arr_args =
        if expect_tuple then
          pytuple_toarray python_args
        else
          [| python_args |]
      in
      let rec check_types pos =
	    if pos = nr_args_given then
          function_body arr_args
	    else
	      let type_here = pytype arr_args.(pos) in
	      let type_wanted = wanted_types.(pos) in
	      let () =
            match type_wanted with
              | AnyType ->
                  ()
              | EitherStringType ->
                  if type_here <> UnicodeType && type_here <> BytesType then
                    raise (type_mismatch_exception type_wanted type_here pos exn_name)
              | CamlpillSubtype sym ->
                  check_pill_type ~position:pos ~exn_name:exn_name sym arr_args.(pos)
              | _ ->
                  if type_here <> type_wanted then
		            raise (type_mismatch_exception type_wanted type_here pos exn_name)
	      in
	        (* Okay, typecheck succeeded.  Now, if extra guards have
	           been provided, try those. *)
	        match extra_guards with
	          | None -> check_types (pos + 1)
	          | Some guards ->
		          let guard = guards.(pos) in
		          let guard_error = guard arr_args.(pos) in
		            match guard_error with
		              | None -> check_types (pos+1)
		              | Some msg ->
			              raise (Pycaml_exn
				                   (Pyerr_TypeError,
				                    (Printf.sprintf "Check for argument %d failed: %s%s"
				                       (pos + 1)
				                       msg
				                       exn_name)))
      in
	    check_types 0
    in
      body ()
  in
    work_fun

(* OCaml string encoded in UTF-8 --> Python 3 string type (= Python 2 unicode type) *)
let pythonize_string s =
  pyunicode_decodeutf8(s, None)

(* Python 3 string or bytes type --> OCaml string encoded in UTF-8 *)
let unpythonize_string =
  unpythonizing_function
    [| EitherStringType |]
    begin
      fun py_args ->
        let s = py_args.(0) in
        let t = pytype s in
          match t with
            | UnicodeType -> pybytes_asstringandsize (pyunicode_asutf8string s)
            | BytesType   -> pybytes_asstringandsize s
            | _ -> assert false
    end

(* FIX: Maybe rewrite this as an unpythonizing_function. *)
let python_interfaced_function
    ?name     (* Will be used in both profiling and error reporting *)
    ?(catch_weird_exceptions = true)
    ?doc
    ?extra_guards (* An array of functions mapping pyobject -> failure_string option *)
    wanted_types
    function_body =
  let wrapper =
    match doc with
      | None -> pywrap_closure
      | Some docstring -> (pywrap_closure_docstring docstring)
  in
  let exn_name =
    match name with
      | None -> ""
      | Some s -> Printf.sprintf " (%s)" s
  in
  let work_fun python_args =
    let body () =
      let () =
        if pytype python_args <> TupleType then
		  (* ^ This should never happen! *)
          raise (Pycaml_exn(Pyerr_TypeError, Printf.sprintf "Weird situation: Non-Tuple function args encountered.%s" exn_name))
      in
      let nr_args_given = pytuple_size python_args in
      let nr_args_wanted = Array.length wanted_types in
      let () =
        if nr_args_given <> nr_args_wanted then
          raise (Pycaml_exn(Pyerr_IndexError,
				            (Printf.sprintf "Args given: %d Wanted: %d%s" nr_args_given nr_args_wanted exn_name)))
      in
      let arr_args = pytuple_toarray python_args in
      let rec check_types pos =
	    if pos = nr_args_given then
          function_body arr_args
	    else
	      let type_here = pytype arr_args.(pos) in
	      let type_wanted = wanted_types.(pos) in
	      let () =
            match type_wanted with
              | AnyType ->
                  ()
              | EitherStringType ->
                  if type_here <> UnicodeType && type_here <> BytesType then
                    raise (type_mismatch_exception type_wanted type_here pos exn_name)
              | CamlpillSubtype sym ->
                  check_pill_type ~position:pos ~exn_name:exn_name sym arr_args.(pos)
              | _ ->
                  if type_here <> type_wanted then
		            raise (type_mismatch_exception type_wanted type_here pos exn_name)
	      in
	        (* Okay, typecheck succeeded.  Now, if extra guards have
	           been provided, try those. *)
	        match extra_guards with
	          | None -> check_types (pos + 1)
	          | Some guards ->
		          let guard = guards.(pos) in
		          let guard_error = guard arr_args.(pos) in
		            match guard_error with
		              | None -> check_types (pos+1)
		              | Some msg ->
			              raise (Pycaml_exn
				                   (Pyerr_TypeError,
				                    (Printf.sprintf "Check for argument %d failed: %s%s"
				                       (pos + 1)
				                       msg
				                       exn_name)))
      in
	    check_types 0
    in
      if _caml_debug_exceptions () then
        body () 
      else
	    try
	      body ()
	    with 
	      | Pycaml_exn (errtype, msg) ->
	          pycaml_seterror errtype (Printf.sprintf "%s%s" msg exn_name); pynull()
	      | Not_found ->
	          pycaml_seterror Pyerr_LookupError (Printf.sprintf "OCaml exception 'Not_found'%s" exn_name);
	          pynull()
	      | Division_by_zero ->
	          pycaml_seterror Pyerr_ZeroDivisionError (Printf.sprintf "OCaml exception 'Division_by_zero'%s" exn_name);
	          pynull()
	      | Failure s ->
	          pycaml_seterror Pyerr_StandardError (Printf.sprintf "OCaml exception 'Failure: %s'%s" s exn_name);
	          pynull ()
	      | Invalid_argument s ->
	          pycaml_seterror Pyerr_StandardError (Printf.sprintf "OCaml exception 'Invalid_argument: %s'%s" s exn_name);
	          pynull()
	      | Out_of_memory ->
	          pycaml_seterror Pyerr_StandardError (Printf.sprintf "OCaml exception 'Out_of_memory'%s" exn_name);
	          pynull()
	      | Stack_overflow ->
	          pycaml_seterror Pyerr_StandardError (Printf.sprintf "OCaml exception 'Stack_overflow'%s" exn_name);
	          pynull()
	      | Sys_error s ->
	          pycaml_seterror Pyerr_StandardError (Printf.sprintf "OCaml exception 'Sys_error %s'%s" s exn_name);
	          pynull()
	      | End_of_file ->
	          pycaml_seterror Pyerr_IOError (Printf.sprintf "OCaml exception 'End_of_file'%s" exn_name);
	          pynull()
	      | Match_failure (filename,line,column) ->
	          pycaml_seterror Pyerr_StandardError (Printf.sprintf "OCaml exception 'Match_failure file=%s line=%d(c. %d)'%s" filename line column exn_name);
	          pynull()
	      | Assert_failure (filename,line,column) ->
	          pycaml_seterror Pyerr_StandardError (Printf.sprintf "OCaml exception 'Assert_failure file=%s line=%d(c. %d)'%s" filename line column exn_name);
	          pynull()
		        
	      | something_else ->
	          if catch_weird_exceptions then
		        begin
		          pycaml_seterror 
		            Pyerr_StandardError 
		            (Printf.sprintf "OCaml weird low-level exception (not resolved any further)%s" exn_name);
		          pynull()
		        end
	          else raise something_else
  in
    match name with
      | None -> wrapper work_fun
      | Some pname ->
	      let profiling_work_fun args =
	        if not(!_py_profiling_active)
	        then work_fun args
	        else
	          let t0 = Unix.gettimeofday () in
	          let result = work_fun args in
	          let t1 = Unix.gettimeofday () in
	          let old_time_and_calls =
		        try Hashtbl.find _py_profile_hash pname
		        with | Not_found ->
		          let x = [|0.0;0.0|] in
		          let () = Hashtbl.add _py_profile_hash pname x in
		            x
	          in
		        begin
		          old_time_and_calls.(0) <- old_time_and_calls.(0) +.(t1-.t0);
		          old_time_and_calls.(1) <- old_time_and_calls.(1) +.1.0;
		          result
		        end
	      in
            wrapper profiling_work_fun

(* python_interfaced_function takes a name argument,
   and indeed it has to, because we want to be able to profile-register
   also anonymously generated functions.

   On the other hand, we eventually register many of these functions
   under some particular name in the "ocaml" python module. So, it
   would be nice to be able to just use the functions' name in the
   ocaml package as its profiling name. So, what we need is a way to
   "pre-register" a function, i.e.:
*)

let python_pre_interfaced_function
    ?(catch_weird_exceptions=true)
    ?doc
    ?extra_guards (* An array of functions mapping pyobject -> failure_string option *)
    wanted_types function_body =
  fun name ->
    python_interfaced_function
      ~name ?doc ?extra_guards wanted_types function_body


(* pywrap_value will wrap up OCaml values for Python in such a way
   that Python can store this in containers, pass it around, and
   eventually hand it back to OCaml.

   As python is not statically typed in an OCaml-compatible way, this
   means that Python may hand back stuff to OCaml which is not of the
   expected type, without OCaml noticing.

   Again, Python users expect to get errors - not crashes - from
   programs, so we have to guard against this. How? By implementing
   some own primitive dynamic type system for python-wrapped OCaml
   values.

   Note: the conventions here are TF's own. Pycaml users need not use
   them, but they might be well advised to do so nevertheless.

   Design decisions:

   * OCaml will only provide opaque values of a manageable small
   number of types to Python.

   * We want to be able to register new types for Python encapsulation
   at runtime.
   
   * We abuse OCaml strings as type tag symbols, which have been
   uniq'd through an identity hash map.  (B.S.: In the PyCapsule
   implementation, we use the capsule name field and don't uniq it.)

   * The only values which are wrapped up for python are of the structure
   (type_tag_string,ref value)

   The ref in the second tuple slot may be a paranoid spurious indirection,
   but will ensure that we will always have a non-immediate in the second
   slot.

   * Note: If we use this in conjunction with some other Python foreign-function
   extension, then it might well happen that a mixup of opaque objects from us
   and that other extension produces a crash. We MIGHT be able to fix this if we
   extend the Python interpreter at low level with a new type for our purposes,
   and do not use PyCObject anymore.

   * It might sound ridiculous, but I consider it a major problem that
   so far, I could not come up with a nice, catchy name for the
   concept of python values that wrap up python-opaque ocaml
   values. Evidently, it is very desirable to have one.

   After a few failed attempts, the least bad name I can come up with is "ocamlpill".

   (B.S.: Personally, I have always liked the name, and now the name
   is especially good, because an ocamlpill has become a sort of
   "capsule", PyCapsule.)

   * ocamlpill type names are unique and considered as global. It is desirable
   to provide a Python function that returns this name, so those names should not be 
   considered "for internal use only".

*)

(* Mapping name => Unique name. Type names are e.g. "Mesh.mesh". *)
let _known_ocamlpill_types = ((Hashtbl.create 10):((string, string) Hashtbl.t))

let _ocamlpill_type_sym ocamlpill_type_name =
  try 
    Hashtbl.find _known_ocamlpill_types ocamlpill_type_name
  with
    | Not_found ->
	failwith
	  (Printf.sprintf "Used ocamlpill_type '%s' without register_ocamlpill_type(\"%s\")"
	     ocamlpill_type_name ocamlpill_type_name)

let register_ocamlpill_types type_names =
  Array.iter
    (fun type_name ->
      if Hashtbl.mem _known_ocamlpill_types type_name
      then () (* -- already known *)
      else 
	Hashtbl.add _known_ocamlpill_types type_name type_name)
    type_names

let make_pill_wrapping ocamlpill_type_name prototypical_object =
  let ocamlpill_type_sym = _ocamlpill_type_sym ocamlpill_type_name in
  let wrapper x =
    pywrap_value_pill
      (ocamlpill_type_sym,
       if false then
         prototypical_object (* Type inference uses this object's type. *)
       else
         x)
  in
  let unwrapper py_value =
    let (ocamlpill_type_sym_provided, xval) = pyunwrap_value py_value in
      if not (sym_match ocamlpill_type_sym_provided ocamlpill_type_sym) then
	    raise (pill_type_mismatch_exception ocamlpill_type_sym ocamlpill_type_sym_provided)
      else
	    let _ =
	      if false then
            prototypical_object (* Type inference uses this object's type. *)
	      else
            xval
	    in
          xval
  in
    (wrapper, unwrapper)

let make_ocamlpill_wrapper_unwrapper = make_pill_wrapping

let ocamlpill_hard_unwrap pill =
  let (_, x) = pyunwrap_value pill in
    x


(* There are situations where we want to provide optional python
   arguments. For the low-level interface, we use the convention to use a
   0-element or 1-element list. In most cases, this low-level convention
   will be wrapped up at a higher level python-wise so that the user of
   a module just sees an optional argument.
   
   This is somewhat tricky: we want to treat optional string/float/int
   args on the same footing as pill args. How do we do this? By a bit
   of combinatorical magic! The proper abstraction is to use a
   continuation function which will receive the unwrapped optional value,
   and an applicator, which may be some ocamlpill_applicator_for_xyz,
   or something like (fun py_x f -> f (pyint_asint py_x)), or just
   evaluate_at.

   Problem here: pyint_asint should also do an extra python typecheck
   in the example above! Hence, we need certain special applicators
   for python types...
*)

let py_optionally unwrapper py_value =
  (* Usually, the optional thingy comes in as an argument,
     and is checked in python_interfaced_function.
     This is not necessarily so, as optional thingies may be
     part of larger data structures, so we better check the type *)
  if pytype py_value != ListType
  then
    raise
      (Pycaml_exn
	 (Pyerr_TypeError, 
	  Printf.sprintf "Expected optional argument to be provided as an empty or 1-element list. Got: %s (%s)"
	    (pytype_name (pytype py_value)) (py_repr py_value)))
  else
    let a = pylist_toarray py_value in
    if Array.length a > 1 then
      raise
	(Pycaml_exn
	   (Pyerr_TypeError, 
	    Printf.sprintf "Expected optional argument to be provided as an empty or 1-element list. Got: %d-element list (%s)."
	      (Array.length a) (py_repr py_value)))
    else
      if Array.length a = 0 then None else Some (unwrapper a.(0))

(* There are a few functions which we may want to use in conjunction with py_optionally to get
   optional integers, optional floats, etc., and not just optional pills
*)

let guarded_pyint_asint x =
  if pytype x <> IntType
  then raise
    (Pycaml_exn(Pyerr_TypeError,
		Printf.sprintf "Wanted: int, got: %s (%s)" (pytype_name (pytype x)) (py_repr x)))
  else pyint_asint x

let guarded_pyfloat_asfloat x =
  if pytype x <> FloatType
  then raise
    (Pycaml_exn(Pyerr_TypeError,
		Printf.sprintf "Wanted: float, got: %s (%s)" (pytype_name (pytype x)) (py_repr x)))
  else pyfloat_asdouble x

let guarded_pynumber_asfloat x =
  match pytype x with
    | FloatType -> pyfloat_asdouble x
    | IntType -> float_of_int (pyint_asint x)
    | _ ->
	raise
	  (Pycaml_exn(Pyerr_TypeError,
		      Printf.sprintf "Wanted: number, got: %s (%s)" (pytype_name (pytype x)) (py_repr x)))

let guarded_pybytes_asstring x =
  if pytype x <> BytesType
  then raise
    (Pycaml_exn(Pyerr_TypeError,
		Printf.sprintf "Wanted: string, got: %s (%s)" (pytype_name (pytype x)) (py_repr x)))
  else pybytes_asstring x

let guarded_pylist_toarray x =
  if pytype x <> ListType
  then raise
    (Pycaml_exn(Pyerr_TypeError,
		Printf.sprintf "Wanted: list, got: %s (%s)" (pytype_name (pytype x)) (py_repr x)))
  else pylist_toarray x

let guarded_pytuple_toarray x =
  if pytype x <> TupleType
  then raise
    (Pycaml_exn(Pyerr_TypeError,
		Printf.sprintf "Wanted: tuple, got: %s (%s)" (pytype_name (pytype x)) (py_repr x)))
  else pytuple_toarray x


let pycallable_asfun py =
  if pytype py <> CallableType 
  then
    raise
      (Pycaml_exn
	 (Pyerr_TypeError, 
	  Printf.sprintf "Expected Python Callable - Got: %s (%s)" (pytype_name (pytype py)) (py_repr py)))
  else
    fun (args:(pyobject array)) ->
      pyeval_callobject(py,pytuple_fromarray args)


(* Note: we do not subject the example/low-level python functions we provide here
   to profiling. Maybe we should.
*)

let _py_profiling =
  python_interfaced_function
    ~doc:"Control profiling of python<->ocaml functions. Usage:

ocaml.sys_profiling(\"on\") -> turn on profiling, return previous on/off status (on=true)
ocaml.sys_profiling(\"off\") -> turn off profiling, return previous on/off status (on=true)
ocaml.sys_profiling(\"clear\") -> clear internal profiling tables
ocaml.sys_profiling(\"report\") -> return profiling report

Report format: list of (name,time,nr_calls), sorted by decreasing total time. 
nr_calls is a floatingpoint number to overcome 32-bit integer limitations.
"
    [|BytesType|]
    (fun arr ->
       let s = pybytes_asstring arr.(0) in
	 match s with
	   | "on" ->
	       let z = py_activate_profiling() in
		 if z then py_true () else py_false ()
	   | "off" ->
	       let z = py_activate_profiling() in
		 if z then py_true () else py_false ()
	   | "clear" ->
	       let () = py_profile_reset() in pynone()
	   | "report" ->
	       let r = py_profile_report() in
		 pylist_fromarray
		   (Array.map 
		      (fun (name,time,calls) ->
			 pytuple3 (pybytes_fromstring name,
				   pyfloat_fromdouble time,
				   pyfloat_fromdouble calls))
		      r)
	   | _ -> pynone()
    )

(* We provide a function to python that allows to check the type
   of an opaque OCaml object.
*)

let _py_ocamlpill_type =
  python_interfaced_function [|CamlpillType|]
    (fun arr ->
       let (type_name, _) = pyunwrap_value arr.(0)
       in pybytes_fromstring type_name)

(* Note: using ocaml.sys_python() will return
   the last value computed interactively.
 *)
let _py_python =
  python_interfaced_function [||]
    (fun arr ->
      let _ = python() in
      python_last_value())

let _py_ipython =
  python_interfaced_function [||]
    (fun arr ->
      let _ = ipython() in
      python_last_value())

let _py_check_heap =
  python_interfaced_function
    [||]
    (fun arr -> let _ = Gc.full_major () in py_true ())


(* -- init -- *)

let _ =
  begin
    Callback.register_exception "ocaml_exn_pycaml" (Pycaml_exn (Pyerr_StandardError,""));
    ignore(pydict_setitemstring (_py_sys_modules, "ocaml", _py_mod_ocaml));
    ignore(python_eval "import ocaml");
    register_for_python
      [|
	("sys_profiling",_py_profiling);
	(* -- This one is very important -- *)
	("sys_ocamlpill_type",_py_ocamlpill_type);
	(* -- This may seem very strange, but actually comes in handy -- *)
	("sys_python",_py_python);
	("sys_ipython",_py_ipython);
	("sys_check_heap",_py_check_heap);
	("sys_refcount", 
	 pywrap_closure
	   (fun py_args ->
	      let args = pytuple_toarray py_args in
		pyint_fromint (pyrefcount args.(0) )));

	(* -- Examples below -- *)
	("example_test_interface", 
	 pywrap_closure
	   (fun _ ->
	      begin
		Printf.printf "This is printed by OCaml, called from Python!\n%!" ;
		pynone ()
	      end
	   ));
	("example_the_answer", pyint_fromint 42);
      |];
  end


(* --- Example Code --- *)

(* For demonstrative purposes, we include two functions
   readily wrapped up here.
*)

(* 
   Now, let's have fun with this:
 *)

let _py_make_powers =
  python_interfaced_function
    ~extra_guards:
    [|(fun py_len ->
	     let len = pyint_asint py_len in
	       if len < 0 then
             Some "Negative Length"
	       else
             None);
      (fun _ -> None); (* This check never fails *)
    |]
    [|IntType;FloatType|]
    (fun py_args ->
       let len = pyint_asint py_args.(0)
       and pow = pyfloat_asdouble py_args.(1) in
	     float_array_to_python
	       (Array.init len (fun n -> let nn = float_of_int (n+1) in nn**pow)))

let
    _py_hypotenuse_2d =
  python_interfaced_function
    [|FloatType;FloatType|]
    (fun py_args ->
       let x = pyfloat_asdouble py_args.(0)
       and y = pyfloat_asdouble py_args.(1) in
         pyfloat_fromdouble (sqrt(x*.x+.y*.y)))
in
  register_for_python
    [|("example_make_powers", _py_make_powers);
      ("example_hypotenuse", _py_hypotenuse_2d);
    |]
