forpy_mod.fypp

! Copyright (C) 2017-2020  Elias Rabel
!
! This program 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 3 of the License, or 
! (at your option) any later version.
!
! This program 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 program.  If not, see <http://www.gnu.org/licenses/>.

module forpy_mod
!! author: Elias Rabel
!!
!! Forpy: A library for Fortran-Python interoperability.
!! 
!! Forpy allows you to use Python features within Fortran ("Python in Fortran")
!! For example: Python modules, datastructures such as list, dict, tuple
!! Furthermore you can write Python (extension) modules in Fortran ("Fortran in Python")

!  Contact:
!  Let me know, if you find this library useful:
!  Mail: ylikx.0 at gmail dot com
!  Web:  https://github.com/ylikx

!  This project uses the fypp preprocessor (https://github.com/aradi/fypp)
!  to generate the code
!  Do not edit forpy_mod.F90, edit forpy_mod.fypp
! 
#! Edit THIS file, not forpy_mod.F90 !

#ifdef PYTHON2_32
#define PYTHON2
#endif

use, intrinsic :: iso_c_binding, only: C_CHAR, C_NULL_CHAR, C_INT, C_LONG, C_LONG_LONG, C_NEW_LINE, c_ptr, C_DOUBLE, &
                                       C_DOUBLE_COMPLEX, c_associated, C_NULL_PTR, c_loc, c_f_pointer, &
                                       c_funptr, c_funloc, C_NULL_FUNPTR, C_INTPTR_T

use, intrinsic :: iso_fortran_env, only: int64, int32, real32, real64

implicit none 

public :: object, type_py, list, dict, tuple, bytes, str, unicode, module_py, &
NoneType, ndarray, Sequence, MutableSequence, ImmutableSequence, Mapping, &
tuple_create, list_create, dict_create, bytes_create, str_create, &
unicode_create, NoneType_create, ndarray_create, ndarray_create_nocopy, & 
ndarray_create_empty, ndarray_create_zeros, ndarray_create_ones, &
import_py, call_py, call_py_noret, assign_py, cast, cast_nonstrict, &
PythonMethodTable, PythonModule, forpy_initialize, &
forpy_finalize, is_long, is_list, is_tuple, is_bytes, is_dict, &
is_float, is_complex, is_bool, is_unicode, is_int, is_str, is_none, &
is_null, is_ndarray, exception_matches, err_clear, err_print, have_exception, &
raise_exception, print_py, get_sys_path, run_string, unsafe_cast_from_c_ptr

! ERROR CODES
integer(kind=C_INT), public, parameter :: NO_NUMPY_ERROR = 2_C_INT
integer(kind=C_INT), public, parameter :: EXCEPTION_ERROR = -1_C_INT

! Flags used for Python extension development
integer(kind=C_INT), public, parameter :: METH_VARARGS = 1_C_INT
integer(kind=C_INT), public, parameter :: METH_KEYWORDS = 2_C_INT
integer(kind=C_INT), public, parameter :: METH_NOARGS = 4_C_INT
integer(kind=C_INT), public, parameter :: METH_O = 8_C_INT

integer, public, parameter :: PY_SSIZE_T_KIND = C_INTPTR_T

PRIVATE

! These global variables shall be set in
! forpy_initialize only and never changed afterwards!
integer, private, save :: global_forpy_initialized = 0
type(c_ptr), private, save :: global_numpy_mod = C_NULL_PTR
type(c_ptr), private, save :: global_numpy_asarray_method = C_NULL_PTR
! the location of the singleton Python Py_NoneStruct method
! initialised in forpy_initialize - if not called, working with None
! is impossible
type(c_ptr), private, save :: global_Py_NoneStruct_ptr = C_NULL_PTR

! Similar for the 2 singleton bools
type(c_ptr), private, save :: global_Py_TrueStruct_ptr = C_NULL_PTR
type(c_ptr), private, save :: global_Py_FalseStruct_ptr = C_NULL_PTR

type(c_ptr), private, save :: global_numpy_ndarray_typeobj = C_NULL_PTR

!pointers to type-objects of fundamental datatypes
!initialised in forpy_initialize
type(c_ptr), private, save :: global_pyfloat_type_ptr = C_NULL_PTR
type(c_ptr), private, save :: global_pycomplex_type_ptr = C_NULL_PTR
type(c_ptr), private, save :: global_pybool_type_ptr = C_NULL_PTR
type(c_ptr), private, save :: global_pyunicode_type_ptr = C_NULL_PTR

type, bind(c) :: Py_buffer
  type(c_ptr) :: buf
  type(c_ptr) :: obj
  integer(kind=PY_SSIZE_T_KIND) :: len
  integer(kind=PY_SSIZE_T_KIND) :: itemsize
  integer(kind=C_INT) :: readonly
  integer(kind=C_INT) :: ndim
  type(c_ptr) :: format
  type(c_ptr) :: shape
  type(c_ptr) :: strides
  type(c_ptr) :: suboffsets
#ifdef PYTHON2
  integer(kind=PY_SSIZE_T_KIND) :: smalltable(2)
#endif
  type(c_ptr) :: internal
end type

type, bind(c) :: PyObject
#ifdef Py_DEBUG
    type(c_ptr) :: ob_next
    type(c_ptr) :: ob_prev
#endif
    integer(kind=PY_SSIZE_T_KIND) :: ob_refcnt
    type(c_ptr) :: ob_type
end type

type, bind(c) :: PyTypeObject
#ifdef Py_DEBUG
    type(c_ptr) :: ob_next
    type(c_ptr) :: ob_prev
#endif
    integer(kind=PY_SSIZE_T_KIND) :: ob_refcnt
    type(c_ptr) :: ob_type
    integer(kind=PY_SSIZE_T_KIND) :: ob_size

    type(c_ptr) :: tp_name ! For printing, in format "<module>.<name>"
    integer(kind=PY_SSIZE_T_KIND) :: tp_basicsize, tp_itemsize ! For allocation

    !Methods to implement standard operations

    type(c_ptr) :: tp_dealloc
    type(c_ptr) :: tp_print
    type(c_ptr) :: tp_getattr
    type(c_ptr) :: tp_setattr
    type(c_ptr) :: tp_compare
    type(c_ptr) :: tp_repr

    !Method suites for standard classes

    type(c_ptr) :: tp_as_number
    type(c_ptr) :: tp_as_sequence
    type(c_ptr) :: tp_as_mapping

    ! More standard operations (here for binary compatibility)

    type(c_ptr) :: tp_hash
    type(c_ptr) :: tp_call
    type(c_ptr) :: tp_str
    type(c_ptr) :: tp_getattro
    type(c_ptr) :: tp_setattro

    ! Functions to access object as input/output buffer
    type(c_ptr) :: tp_as_buffer

    !Flags to define presence of optional/expanded features
    integer(kind=C_LONG) :: tp_flags  ! Python2: long, Python3: unsigned long

    type(c_ptr) :: tp_doc ! Documentation string

    !call function for all accessible objects
    type(c_ptr) :: tp_traverse

    ! delete references to contained objects
    type(c_ptr) :: tp_clear

    ! Assigned meaning in release 2.1
    ! rich comparisons
    type(c_ptr) :: tp_richcompare

    ! weak reference enabler
    integer(kind=PY_SSIZE_T_KIND) :: tp_weaklistoffset

    !Added in release 2.2
    !Iterators
    type(c_ptr) :: tp_iter
    type(c_ptr) :: tp_iternext

    ! Attribute descriptor and subclassing stuff
    type(c_ptr) :: tp_methods
    type(c_ptr) :: tp_members
    type(c_ptr) :: tp_getset
    type(c_ptr) :: tp_base
    type(c_ptr) :: tp_dict
    type(c_ptr) :: tp_descr_get
    type(c_ptr) :: tp_descr_set
    integer(kind=PY_SSIZE_T_KIND) :: tp_dictoffset
    type(c_ptr) :: tp_init
    type(c_ptr) :: tp_alloc
    type(c_ptr) :: tp_new
    type(c_ptr) :: tp_free ! Low-level free-memory routine
    type(c_ptr) :: tp_is_gc ! For PyObject_IS_GC
    type(c_ptr) :: tp_bases
    type(c_ptr) :: tp_mro ! method resolution order
    type(c_ptr) :: tp_cache
    type(c_ptr) :: tp_subclasses
    type(c_ptr) :: tp_weaklist
    type(c_ptr) :: tp_del

    ! Type attribute cache version tag. Added in version 2.6
    integer(kind=C_INT) :: tp_version_tag

    ! additionally Python3 has this field:
    ! destructor tp_finalize;
    ! we should be fine without it, since all we actually need is the offset
    ! of tp_flags and we are not using arrays of PyTypeObjects

end type

type, bind(c) :: Py_complex
  real(kind=C_DOUBLE) :: real_part
  real(kind=C_DOUBLE) :: imag_part
end type

type, bind(c) :: PyMethodDef
  type(c_ptr) :: ml_name
  type(c_funptr) :: ml_meth
  integer(kind=C_INT) :: ml_flags
  type(c_ptr) :: ml_doc
end type

type, bind(c) :: PyModuleDef_Base
  integer(kind=PY_SSIZE_T_KIND) :: ob_refcnt !PyObject_HEAD  (init to 1)
  type(c_ptr) :: ob_type ! from PyObject_HEAD (init to NULL)
    
  type(c_ptr) :: m_init
  integer(kind=PY_SSIZE_T_KIND) :: m_index
  type(c_ptr) :: m_copy
end type

type, bind(c) :: PyModuleDef
  type(PyModuleDef_Base) :: m_base
  type(c_ptr) :: m_name
  type(c_ptr) :: m_doc
  integer(kind=PY_SSIZE_T_KIND) :: m_size
  type(c_ptr) :: m_methods
  type(c_ptr) :: m_slots
  type(c_funptr) :: m_traverse
  type(c_funptr) :: m_clear
  type(c_funptr) :: m_free
end type

interface
  subroutine Py_Initialize() bind(c, name="Py_Initialize")
  end subroutine

  function Py_IsInitialized() bind(c, name="Py_IsInitialized") result(r)
    import C_INT
    integer(kind=C_INT) :: r
  end function

  subroutine Py_Finalize() bind(c, name="Py_Finalize")
  end subroutine

  function PyImport_ImportModule(a_name) bind(c, name="PyImport_ImportModule") result(m)
    import c_ptr, C_CHAR
    character(kind=C_CHAR), dimension(*) :: a_name
    type(c_ptr) :: m
  end function

  function PyRun_SimpleString(command) bind(c, name="PyRun_SimpleString") result(r)
    import C_INT, C_CHAR
    character(kind=C_CHAR), dimension(*) :: command
    integer(kind=C_INT) :: r
  end function

  function PyList_New(len) bind(c, name="PyList_New") result(r)
    import c_ptr, PY_SSIZE_T_KIND
    integer(kind=PY_SSIZE_T_KIND), value :: len
    type(c_ptr) :: r
  end function

  function PyDict_New() bind(c, name="PyDict_New") result(r)
    import c_ptr
    type(c_ptr) :: r
  end function

  !int PyList_Append(PyObject *list, PyObject *item)
  function PyList_Append(list, item) bind(c, name="PyList_Append") result(r)
    import c_ptr, C_INT
    type(c_ptr), value :: list
    type(c_ptr), value :: item
    integer(kind=C_INT) :: r
  end function
  
  function PyList_Sort(list) bind(c, name="PyList_Sort") result(r)
    import c_ptr, C_INT
    type(c_ptr), value :: list
    integer(kind=C_INT) :: r
  end function
  
  function PyList_Reverse(list) bind(c, name="PyList_Reverse") result(r)
    import c_ptr, C_INT
    type(c_ptr), value :: list
    integer(kind=C_INT) :: r
  end function
  
  !int PyList_Insert(PyObject *list, Py_ssize_t index, PyObject *item)
  function PyList_Insert(list, index, item) bind(c, name="PyList_Insert") result(r)
    import c_ptr, C_INT, PY_SSIZE_T_KIND
    type(c_ptr), value :: list
    integer(kind=PY_SSIZE_T_KIND), value :: index
    type(c_ptr), value :: item
    integer(kind=C_INT) :: r
  end function
  
  !PyObject* PyLong_FromLongLong(long long ival)
  function PyLong_FromLongLong(ival) bind(c, name="PyLong_FromLongLong") result(r)
    import c_ptr, C_LONG_LONG
    integer(kind=C_LONG_LONG), value :: ival
    type(c_ptr) :: r
  end function
  
  !PY_LONG_LONG PyLong_AsLongLongAndOverflow(PyObject *obj, int *overflow)
  function PyLong_AsLongLongAndOverflow(obj, overflow) bind(c, name="PyLong_AsLongLongAndOverflow") result(r)
    import c_ptr, C_LONG_LONG, C_INT
    type(c_ptr), value :: obj
    integer(kind=C_INT) :: overflow
    integer(kind=C_LONG_LONG) :: r
  end function

#ifdef PYTHON2
  !PyObject* PyInt_FromLong(Py_ssize_t ival)
  function PyInt_FromLong(ival) bind(c, name="PyInt_FromLong") result(r)
    import c_ptr, C_LONG
    integer(kind=C_LONG), value :: ival
    type(c_ptr) :: r
  end function
#endif

  !void Py_DecRef(PyObject *o)
  subroutine Py_DecRef(o) bind(c, name="Py_DecRef")
    import c_ptr
    type(c_ptr), value :: o
  end subroutine

  !void Py_IncRef(PyObject *o)
  subroutine Py_IncRef(o) bind(c, name="Py_IncRef")
    import c_ptr
    type(c_ptr), value :: o
  end subroutine

  !PyObject* PyObject_GetItem(PyObject *o, PyObject *key)
  function PyObject_GetItem(o, key) bind(c, name="PyObject_GetItem") result(r)
    import c_ptr
    type(c_ptr), value :: o
    type(c_ptr), value :: key
    type(c_ptr) :: r
  end function

  !int PyObject_SetItem(PyObject *o, PyObject *key, PyObject *v)
  function PyObject_SetItem(o, key, v) bind(c, name="PyObject_SetItem") result(r)
    import c_ptr, C_INT
    type(c_ptr), value :: o
    type(c_ptr), value :: key
    type(c_ptr), value :: v
    integer(kind=C_INT) :: r
  end function
  
  !Py_ssize_t PyObject_Length(PyObject *o)
  function PyObject_Length(o) bind(c, name="PyObject_Length") result(r)
    import c_ptr, PY_SSIZE_T_KIND
    type(c_ptr), value :: o
    integer(kind=PY_SSIZE_T_KIND) :: r
  end function

  !int PyObject_IsTrue(PyObject *o)
  function PyObject_IsTrue(o) bind(c, name="PyObject_IsTrue") result(r)
    import c_ptr, C_INT
    type(c_ptr), value :: o
    integer(kind=C_INT) :: r
  end function
  
  !PyObject* PyObject_Str(PyObject *o)
  function PyObject_Str(o) bind(c, name="PyObject_Str") result(r)
    import c_ptr
    type(c_ptr), value :: o
    type(c_ptr) :: r
  end function

  !int PySequence_SetItem(PyObject *o, Py_ssize_t i, PyObject *v)
  function PySequence_SetItem(o, i, v) bind(c, name="PySequence_SetItem") result(r)
    import c_ptr, C_INT, PY_SSIZE_T_KIND
    type(c_ptr), value :: o
    integer(kind=PY_SSIZE_T_KIND), value :: i
    type(c_ptr), value :: v
    integer(kind=C_INT) :: r
  end function

  !PyObject* PySequence_GetItem(PyObject *o, Py_ssize_t i)
  function PySequence_GetItem(o, i) bind(c, name="PySequence_GetItem") result(r)
    import c_ptr, C_INT, PY_SSIZE_T_KIND
    type(c_ptr), value :: o
    integer(kind=PY_SSIZE_T_KIND), value :: i
    type(c_ptr) :: r
  end function

  !int PyTuple_SetItem(PyObject *p, Py_ssize_t pos, PyObject *o)
  function PyTuple_SetItem(p, pos, o) bind(c, name="PyTuple_SetItem") result(r)
    import c_ptr, C_INT, PY_SSIZE_T_KIND
    type(c_ptr), value :: p
    integer(kind=PY_SSIZE_T_KIND), value :: pos
    type(c_ptr), value :: o
    integer(kind=C_INT) :: r
  end function

  !PyObject* PyTuple_New(Py_ssize_t len)
  function PyTuple_New(len) bind(c, name="PyTuple_New") result(r)
    import c_ptr, PY_SSIZE_T_KIND
    integer(kind=PY_SSIZE_T_KIND), value :: len
    type(c_ptr) :: r
  end function

  !long long PyLong_AsLongLong(PyObject *io)
  function PyLong_AsLongLong(io) bind(c, name="PyLong_AsLongLong") result(r)
    import c_ptr, C_LONG_LONG
    type(c_ptr), value :: io
    integer(kind=C_LONG_LONG) :: r
  end function

  !PyObject* PyFloat_FromDouble(double v)
  function PyFloat_FromDouble(v) bind(c, name="PyFloat_FromDouble") result(r)
    import c_ptr, C_DOUBLE
    real(kind=C_DOUBLE), value :: v
    type(c_ptr) :: r
  end function
  
  !double PyFloat_AsDouble(PyObject *pyfloat)
  function PyFloat_AsDouble(pyfloat) bind(c, name="PyFloat_AsDouble") result(r)
    import c_ptr, C_DOUBLE
    type(c_ptr), value :: pyfloat
    real(kind=C_DOUBLE) :: r
  end function

  function PyComplex_FromDoubles(re, im) bind(c, name="PyComplex_FromDoubles") result(r)
    import c_ptr, C_DOUBLE
    real(kind=C_DOUBLE), value :: re, im
    type(c_ptr) :: r
  end function

  function PyComplex_AsCComplex(obj) bind(c, name="PyComplex_AsCComplex") result(r)
    import c_ptr, Py_complex
    type(c_ptr), value :: obj
    type(Py_complex) :: r
  end function

  function PyErr_Occurred() bind(c, name="PyErr_Occurred") result(r)
    import c_ptr
    type(c_ptr) :: r
  end function

  !void PyErr_Print()
  subroutine PyErr_Print() bind(c, name="PyErr_Print")
  end subroutine

  !void PyErr_Clear()
  subroutine PyErr_Clear() bind(c, name="PyErr_Clear")
  end subroutine

#ifdef PYTHON2
  function PyBytes_FromStringAndSize(v, len) bind(c, name="PyString_FromStringAndSize") result(r)
#else
  function PyBytes_FromStringAndSize(v, len) bind(c, name="PyBytes_FromStringAndSize") result(r)
#endif
    import c_ptr, PY_SSIZE_T_KIND, C_CHAR
    character(kind=C_CHAR), dimension(*), intent(in) :: v
    integer(kind=PY_SSIZE_T_KIND), value :: len
    type(c_ptr) :: r
  end function

#ifdef PYTHON2
  function PyBytes_FromString(v) bind(c, name="PyString_FromString") result(r)
#else
  function PyBytes_FromString(v) bind(c, name="PyBytes_FromString") result(r)
#endif
    import c_ptr, C_CHAR
    character(kind=C_CHAR), dimension(*), intent(in) :: v
    type(c_ptr) :: r
  end function
  
  !char* PyBytes_AsString(PyObject *o)
#ifdef PYTHON2
  function PyBytes_AsString(o) bind(c, name="PyString_AsString") result(r)
#else
  function PyBytes_AsString(o) bind(c, name="PyBytes_AsString") result(r)
#endif
    import c_ptr
    type(c_ptr), value :: o
    type(c_ptr) :: r
  end function

  ! PyObject* PyObject_GetAttr(PyObject *o, PyObject *attr_name)
  function PyObject_GetAttr(o, attr_name) bind(c, name="PyObject_GetAttr") result(r)
    import c_ptr
    type(c_ptr), value :: o, attr_name
    type(c_ptr) :: r
  end function
  
  function PyObject_SetAttr(o, attr_name, v) bind(c, name="PyObject_SetAttr") result(r)
    import c_ptr, C_INT
    type(c_ptr), value :: o, attr_name, v
    integer(kind=C_INT) :: r
  end function
  
  !int PyObject_DelItem(PyObject *o, PyObject *key)
  function PyObject_DelItem(o, key) bind(c, name="PyObject_DelItem") result(r)
    import c_ptr, C_INT
    type(c_ptr), value :: o, key
    integer(kind=C_INT) :: r
  end function
  
  !int PySequence_DelItem(PyObject *o, Py_ssize_t i)
  function PySequence_DelItem(o, i) bind(c, name="PySequence_DelItem") result(r)
    import c_ptr, C_INT, PY_SSIZE_T_KIND
    type(c_ptr), value :: o
    integer(kind=PY_SSIZE_T_KIND), value :: i
    integer(kind=C_INT) :: r
  end function  

  !PyObject* PyObject_Call(PyObject *callable_object, PyObject *args, PyObject *kw)
  function PyObject_Call(callable_object, args, kw) bind(c, name="PyObject_Call") result(r)
    import c_ptr
    type(c_ptr), value :: callable_object, args, kw
    type(c_ptr) :: r
  end function

  !PyObject *PyMemoryView_FromBuffer(Py_buffer *view)
  function PyMemoryView_FromBuffer(view) bind(c, name="PyMemoryView_FromBuffer") result(r)
    import Py_buffer, c_ptr
    type(Py_buffer) :: view
    type(c_ptr) :: r
  end function

  !PyObject *PyMemoryView_FromObject(PyObject *obj)
  function PyMemoryView_FromObject(obj) bind(c, name="PyMemoryView_FromObject") result(r)
    import c_ptr
    type(c_ptr), value :: obj
    type(c_ptr) :: r
  end function

  !int PyObject_GetBuffer(PyObject *obj, Py_buffer *view, int flags)
  function PyObject_GetBuffer(obj, view, flags) bind(c, name="PyObject_GetBuffer") result(r)
    import Py_buffer, c_ptr, C_INT
    type(c_ptr), value :: obj
    type(Py_buffer) :: view
    integer(kind=C_INT), value :: flags
    integer(kind=C_INT) :: r
  end function

  !int PyBuffer_IsContiguous(Py_buffer *view, char fortran)
  function PyBuffer_IsContiguous(view, fortran) bind(c, name="PyBuffer_IsContiguous") result(r)
    import Py_buffer, C_INT, C_CHAR
    type(Py_buffer) :: view
    character(kind=C_CHAR), value :: fortran
    integer(kind=C_INT) :: r
  end function

  !void PyBuffer_Release(Py_buffer *view)
  subroutine PyBuffer_Release(view) bind(c, name="PyBuffer_Release")
    import Py_buffer
    type(Py_buffer) :: view
  end subroutine

  !int PyObject_IsInstance(PyObject *inst, PyObject *cls)
  function PyObject_IsInstance(inst, cls) bind(c, name="PyObject_IsInstance") result(r)
    import C_INT, c_ptr
    type(c_ptr), value :: inst
    type(c_ptr), value :: cls
    integer(kind=C_INT) :: r
  end function

  !int PyType_IsSubtype(PyTypeObject *a, PyTypeObject *b)
  function PyType_IsSubtype(a, b) bind(c, name="PyType_IsSubtype") result(r)
    import C_INT, c_ptr
    type(c_ptr), value :: a
    type(c_ptr), value :: b
    integer(kind=C_INT) :: r
  end function

  !PyObject* PyBool_FromLong(long v)
  function PyBool_FromLong(v) bind(c, name="PyBool_FromLong") result(r)
    import C_LONG, c_ptr
    integer(kind=C_LONG), value :: v
    type(c_ptr) :: r
  end function

  !PyObject* PyUnicode_DecodeUTF8(const char *s, Py_ssize_t size, const char *errors)
#ifndef PYTHON2
  function PyUnicode_DecodeUTF8(s, size, errors) bind(c, name="PyUnicode_DecodeUTF8") result(r)
#endif

#ifdef PYTHON2
#ifdef PYTHON_NARROW
  function PyUnicode_DecodeUTF8(s, size, errors) bind(c, name="PyUnicodeUCS2_DecodeUTF8") result(r)  
#else
  function PyUnicode_DecodeUTF8(s, size, errors) bind(c, name="PyUnicodeUCS4_DecodeUTF8") result(r)
#endif
#endif
    import c_ptr, PY_SSIZE_T_KIND, C_CHAR
    character(kind=C_CHAR), dimension(*) :: s
    integer(kind=PY_SSIZE_T_KIND), value :: size
    character(kind=C_CHAR), dimension(*) :: errors
    type(c_ptr) :: r
  end function
  
#ifndef PYTHON2
  ! Since Python 3.3 in C-API
  !char* PyUnicode_AsUTF8AndSize(PyObject *unicode, Py_ssize_t *size)
  function PyUnicode_AsUTF8AndSize(unicode, size) bind(c, name="PyUnicode_AsUTF8AndSize") result(r)
    import c_ptr, PY_SSIZE_T_KIND
    type(c_ptr), value :: unicode
    integer(kind=PY_SSIZE_T_KIND) :: size
    type(c_ptr) :: r
  end function  
#endif

  !PyObject* PyUnicode_AsUTF8String(PyObject *unicode)
#ifdef PYTHON2
#ifdef PYTHON2_NARROW
  function PyUnicode_AsUTF8String(unicode) bind(c, name="PyUnicodeUCS2_AsUTF8String") result(r)
#else
  function PyUnicode_AsUTF8String(unicode) bind(c, name="PyUnicodeUCS4_AsUTF8String") result(r)
#endif
    import c_ptr
    type(c_ptr), value :: unicode
    type(c_ptr) :: r
  end function
#endif

  function PyEval_GetBuiltins() bind(c, name="PyEval_GetBuiltins") result(r)
    import c_ptr
    type(c_ptr) :: r
  end function
  
  !PyObject* PyDict_GetItemString(PyObject *p, const char *key)
  function PyDict_GetItemString(p, key) bind(c, name="PyDict_GetItemString") result(r)
    import c_ptr, C_CHAR
    type(c_ptr), value :: p
    character(kind=C_CHAR), dimension(*) :: key
    type(c_ptr) :: r
  end function

!void PyErr_SetString(PyObject *type, const char *message)
subroutine PyErr_SetString(a_type, message) bind(c, name="PyErr_SetString")
  import c_ptr, C_CHAR
  type(c_ptr), value :: a_type
  character(kind=C_CHAR), dimension(*) :: message
end subroutine

!int PyErr_GivenExceptionMatches(PyObject *given, PyObject *exc)
function PyErr_GivenExceptionMatches(given, exc) bind(c, name="PyErr_GivenExceptionMatches") result(r)
  import c_ptr, C_INT
  type(c_ptr), value :: given, exc
  integer(kind=C_INT) :: r
end function

function PySequence_Tuple(o) bind(c, name="PySequence_Tuple") result(r)
  import c_ptr
  type(c_ptr), value :: o
  type(c_ptr) :: r
end function

function PySequence_List(o) bind(c, name="PySequence_List") result(r)
  import c_ptr
  type(c_ptr), value :: o
  type(c_ptr) :: r
end function

subroutine PyDict_Clear(p) bind(c, name="PyDict_Clear")
  import c_ptr
  type(c_ptr), value :: p
end subroutine

function PyDict_Copy(p) bind(c, name="PyDict_Copy") result(r)
  import c_ptr
  type(c_ptr), value :: p
  type(c_ptr) :: r
end function

!PyObject* PyDict_Items(PyObject *p)
function PyDict_Items(p) bind(c, name="PyDict_Items") result(r)
  import c_ptr
  type(c_ptr), value :: p
  type(c_ptr) :: r
end function

!PyObject* PyDict_Keys(PyObject *p)
function PyDict_Keys(p) bind(c, name="PyDict_Keys") result(r)
  import c_ptr
  type(c_ptr), value :: p
  type(c_ptr) :: r
end function

!PyObject* PyDict_Values(PyObject *p)
function PyDict_Values(p) bind(c, name="PyDict_Values") result(r)
  import c_ptr
  type(c_ptr), value :: p
  type(c_ptr) :: r
end function

!void PyBuffer_FillContiguousStrides(int ndim, Py_ssize_t *shape, Py_ssize_t *strides, Py_ssize_t itemsize, char order)
subroutine PyBuffer_FillContiguousStrides(ndim, shape, strides, itemsize, order) bind(c, name="PyBuffer_FillContiguousStrides")
  import c_ptr, C_INT, C_CHAR, PY_SSIZE_T_KIND
  integer(kind=C_INT), value :: ndim
  type(c_ptr), value :: shape
  type(c_ptr), value :: strides
  integer(kind=PY_SSIZE_T_KIND), value :: itemsize
  character(kind=C_CHAR), value :: order
end subroutine

function PySequence_Contains(o, a_value) bind(c, name="PySequence_Contains") result(r)
  import c_ptr, C_INT
  type(c_ptr), value :: o
  type(c_ptr), value :: a_value  
  integer(kind=C_INT) :: r
end function

function PySequence_Index(o, a_value) bind(c, name="PySequence_Index") result(r)
  import c_ptr, PY_SSIZE_T_KIND
  type(c_ptr), value :: o
  type(c_ptr), value :: a_value  
  integer(kind=PY_SSIZE_T_KIND) :: r
end function

function PySequence_Count(o, a_value) bind(c, name="PySequence_Count") result(r)
  import c_ptr, PY_SSIZE_T_KIND
  type(c_ptr), value :: o
  type(c_ptr), value :: a_value  
  integer(kind=PY_SSIZE_T_KIND) :: r
end function

function PyMapping_HasKey(o, a_value) bind(c, name="PyMapping_HasKey") result(r)
  import c_ptr, C_INT
  type(c_ptr), value :: o
  type(c_ptr), value :: a_value  
  integer(kind=C_INT) :: r
end function

function PySequence_Concat(o1, o2) bind(c, name="PySequence_Concat") result(r)
  import c_ptr
  type(c_ptr), value :: o1, o2
  type(c_ptr) :: r 
end function

!PyObject *PySys_GetObject(const char *name)
function PySys_GetObject(a_name) bind(c, name="PySys_GetObject") result(r)
  import c_ptr, C_CHAR
  character(kind=C_CHAR), dimension(*) :: a_name
  type(c_ptr) :: r
end function

#ifndef PYTHON2
#ifndef Py_DEBUG
function PyModule_Create2(def, module_api_version) bind(c, name="PyModule_Create2") result(r)
#else
function PyModule_Create2(def, module_api_version) bind(c, name="PyModule_Create2TraceRefs") result(r)
#endif
  import c_ptr, C_INT
  type(c_ptr), value :: def
  integer(kind=C_INT), value :: module_api_version
  type(c_ptr) :: r
end function
#endif

#ifdef PYTHON2
!Python 2 only
!PyObject* Py_InitModule4(char *name, PyMethodDef *methods, char *doc, PyObject *self, int apiver)
#ifndef PYTHON2_32
#ifndef Py_DEBUG
function Py_InitModule4(a_name, methods, doc, self, apiver) bind(c, name="Py_InitModule4_64") result(r)
#else
function Py_InitModule4(a_name, methods, doc, self, apiver) bind(c, name="Py_InitModule4TraceRefs_64") result(r)
#endif
#else
#ifndef Py_DEBUG
function Py_InitModule4(a_name, methods, doc, self, apiver) bind(c, name="Py_InitModule4") result(r)
#else
function Py_InitModule4(a_name, methods, doc, self, apiver) bind(c, name="Py_InitModule4TraceRefs") result(r)
#endif
#endif
  import c_ptr, C_CHAR, C_INT
  character(kind=C_CHAR), dimension(*) :: a_name
  type(c_ptr), value :: methods
  character(kind=C_CHAR), dimension(*) :: doc
  type(c_ptr), value :: self
  integer(kind=C_INT), value :: apiver
  type(c_ptr) :: r
end function
#endif

!int PyModule_AddObject(PyObject *module, const char *name, PyObject *value)
function PyModule_AddObject(a_module, a_name, a_value) bind(c, name="PyModule_AddObject") result(r)
  import c_ptr, C_CHAR, C_INT
  type(c_ptr), value :: a_module
  character(kind=C_CHAR), dimension(*) :: a_name
  type(c_ptr), value :: a_value
  integer(kind=C_INT) :: r
end function

#ifdef PYTHON2
! Old-style Python2-only buffer protocol API function
!PyObject* PyBuffer_FromReadWriteMemory(void *ptr, Py_ssize_t size)
function PyBuffer_FromReadWriteMemory(ptr, the_size) bind(c, name="PyBuffer_FromReadWriteMemory") result(r)
  import c_ptr, PY_SSIZE_T_KIND
  type(c_ptr), value :: ptr
  integer(kind=PY_SSIZE_T_KIND), value :: the_size
  type(c_ptr) :: r
end function
#endif

function strcmp(s1, s2) bind(c) result(r)
  import c_ptr, C_INT
  type(c_ptr), value :: s1, s2
  integer(kind=C_INT) :: r
end function

end interface

interface box_value
#ifdef PYTHON2
  module procedure box_value_int32
  module procedure box_value_int64
#else
  module procedure box_value_int32_as_long
  module procedure box_value_int64_as_long
#endif
  module procedure box_value_real32
  module procedure box_value_real64
  module procedure box_value_complex_real32
  module procedure box_value_complex_real64
  module procedure box_value_logical
  module procedure box_value_chars
  module procedure box_value_char_1d
end interface

interface unbox_value
  module procedure unbox_value_int32
  module procedure unbox_value_int64
  module procedure unbox_value_real32
  module procedure unbox_value_real64
  module procedure unbox_value_complex_real32
  module procedure unbox_value_complex_real64
  module procedure unbox_value_logical
#ifdef PYTHON2
  module procedure unbox_value_chars_py2
#else
  module procedure unbox_value_chars
#endif
  module procedure unbox_value_char_1d
end interface

interface tuple_from_array
  module procedure tuple_from_array_int32
  module procedure tuple_from_array_int64
end interface

!--------- High-level API to Python's datastructures -------------------

#! some variables for the fypp preprocessor
#:set INDEX_TYPE_NAMES = ("int32", "int64")
#:set ITEM_TYPE_NAMES = ("int32", "int64", "real32", "real64", "complex_real32", "complex_real64", "logical", "char_1d", "chars")
#:set ITEM_TYPES_OUTPUT = ("integer(kind=int32)", "integer(kind=int64)", "real(kind=real32)", "real(kind=real64)", "complex(kind=real32)", "complex(kind=real64)", "logical", "character(kind=C_CHAR), dimension(:), pointer", "character(kind=C_CHAR, len=:), allocatable")
#:set ITEM_TYPES_INPUT = ("integer(kind=int32)", "integer(kind=int64)", "real(kind=real32)", "real(kind=real64)", "complex(kind=real32)", "complex(kind=real64)", "logical", "character(kind=C_CHAR), dimension(:)", "character(kind=C_CHAR, len=*)")

#:set NDARRAY_MAX_DIMENSION = 4

#:set PYTHON_STANDARD_EXCEPTIONS = ['ArithmeticError', 'AssertionError', 'AttributeError', &
 & 'BaseException', 'BufferError', 'BytesWarning', 'DeprecationWarning', 'EOFError', &
 & 'EnvironmentError', 'Exception', 'FloatingPointError', 'FutureWarning', 'GeneratorExit', & 
 & 'IOError', 'ImportError', 'ImportWarning', 'IndentationError', 'IndexError', 'KeyError', &
 & 'KeyboardInterrupt', 'LookupError', 'MemoryError', 'NameError', 'NotImplementedError', &
 & 'OSError', 'OverflowError', 'PendingDeprecationWarning', 'ReferenceError', 'RuntimeError', &
 & 'RuntimeWarning', 'StandardError', 'StopIteration', 'SyntaxError', 'SyntaxWarning', &
 & 'SystemError', 'SystemExit', 'TabError', 'TypeError', 'UnboundLocalError', 'UnicodeDecodeError', &
 & 'UnicodeEncodeError', 'UnicodeError', 'UnicodeTranslateError', 'UnicodeWarning', 'UserWarning', &
 & 'ValueError', 'Warning', 'ZeroDivisionError']

#:set FORPY_TYPES = ("object", "list", "tuple", "dict", "ndarray", "type_py", "module_py", "NoneType")
#:set SCALAR_FORTRAN_TYPE_INFO = list(zip(("integer(kind=int32)", "integer(kind=int64)", "real(kind=real32)", "real(kind=real64)", "complex(kind=real32)", "complex(kind=real64)", "logical"), ("int32", "int64", "real32", "real64", "complex_real32", "complex_real64", "logical"), ("is_int", "is_int", "is_float", "is_float", "is_complex", "is_complex", "is_bool")))

#! some fypp macros to avoid code duplication
#:def exception_check()
    err_obj = PyErr_Occurred()
    if (c_associated(err_obj)) then
      ierror = EXCEPTION_ERROR
      return
    endif 
#:enddef

!> Type to represent an arbitrary Python object
type object
  private
  type(c_ptr) :: py_object = C_NULL_PTR

  contains
    !> Call to allow for freeing of resources of this object.
    procedure, public :: destroy => object_destroy
    !> Get value of an attribute of this object
    procedure, public :: getattribute => object_getattribute  ! TODO: make generic?
    !> Set value of an attribute of this object
    procedure, public :: setattr => object_setattr
    !> Delete an attribute of this object
    procedure, public :: delattr => object_delattr
    !> Get c_ptr representation of this object. For development of Python extension modules
    procedure, public :: get_c_ptr => object_get_c_ptr
end type

!> Type that represents a "class object". In Python class objects have the type 'type' which we name type_py here.
type, extends(object) :: type_py

end type

!> Abstract type that represents sequence objects. Elements of a sequence can be accessed by an index.
type, abstract, extends(object) :: Sequence
  contains
    #:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
      procedure, private :: sequence_len_${INDEX_TYPE_NAME}$
      !> Get the length of the object (number of elements).
      generic, public :: len => sequence_len_${INDEX_TYPE_NAME}$
      procedure, private :: sequence_count_${INDEX_TYPE_NAME}$
      generic, public :: count => sequence_count_${INDEX_TYPE_NAME}$
      
      !index - does not support optional start and stop indices as the Python function does
      procedure, private :: sequence_index_${INDEX_TYPE_NAME}$
      !> Get the first index of a value.
      generic, public :: index => sequence_index_${INDEX_TYPE_NAME}$
    
      procedure, private :: sequence_getitem_${INDEX_TYPE_NAME}$_object
      !> Get item at a certain index
      generic, public :: getitem => sequence_getitem_${INDEX_TYPE_NAME}$_object
      #:for ITEM_TYPE_NAME in ITEM_TYPE_NAMES
        procedure, private :: sequence_getitem_${INDEX_TYPE_NAME}$_${ITEM_TYPE_NAME}$
        !> Get item at a certain index
        generic, public :: getitem => sequence_getitem_${INDEX_TYPE_NAME}$_${ITEM_TYPE_NAME}$
      #:endfor

    #:endfor
    
    !> Checks if a given item is contained in the sequence.
    procedure, public :: contains => sequence_contains
end type

!> Abstract type that represents a sequence, whose items can be changed.
type, abstract, extends(Sequence) :: MutableSequence
  contains
#:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
    procedure, private :: mutablesequence_setitem_${INDEX_TYPE_NAME}$_object
    !> Set an item at a given index
    generic, public :: setitem => mutablesequence_setitem_${INDEX_TYPE_NAME}$_object
#:for ITEM_TYPE_NAME in ITEM_TYPE_NAMES
    procedure, private :: mutablesequence_setitem_${INDEX_TYPE_NAME}$_${ITEM_TYPE_NAME}$
    !> Set an item at a given index
    generic, public :: setitem => mutablesequence_setitem_${INDEX_TYPE_NAME}$_${ITEM_TYPE_NAME}$
#:endfor
#:endfor
end type

!> Abstract type that represents a sequence, whose items can not be changed.
type, abstract, extends(Sequence) :: ImmutableSequence

end type

!> Type that corresponds to a Python list.
type, extends(MutableSequence) :: list
  contains
    procedure, private :: list_append_object
    !> Append an item at the end of a list
    generic, public :: append => list_append_object
    
    !> Creates a copy of a list
    procedure, public :: copy => list_copy
    !> Sorts the list.
    procedure, public :: sort => list_sort
    !> Reverses a list.
    procedure, public :: reverse => list_reverse
    !> Concatenates another list at the end of a list.
    procedure, public :: add => list_add

#:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
    procedure, private :: list_insert_${INDEX_TYPE_NAME}$
    !> Inserts item at given index.
    generic, public :: insert => list_insert_${INDEX_TYPE_NAME}$
    procedure, private :: list_delitem_${INDEX_TYPE_NAME}$
    !> Deletes item at given index from list.
    generic, public :: delitem => list_delitem_${INDEX_TYPE_NAME}$
#:endfor
    
#:for ITEM_TYPE_NAME in ITEM_TYPE_NAMES
    procedure, private :: list_append_${ITEM_TYPE_NAME}$
    !> Append an item at the end of a list
    generic, public :: append => list_append_${ITEM_TYPE_NAME}$
#:endfor

end type

!> Abstract type that represents a datastructure that maps keys to values.
type, abstract, extends(object) :: Mapping
  contains
     procedure, private :: mapping_getitem_object_object
     !> Get value at a given key. KeyError if key does not exist
     generic, public :: getitem => mapping_getitem_object_object   
     procedure, private :: mapping_setitem_object_object
     !> Inserts value at given key. Sets value if key already exists.
     generic, public :: setitem => mapping_setitem_object_object
     procedure, private :: mapping_delitem_object
     !> Delete key-value pair with given key.
     generic, public :: delitem => mapping_delitem_object
     
     #:for KEY_TYPE_NAME in ("int32", "int64", "chars")
       procedure, private :: mapping_getitem_${KEY_TYPE_NAME}$_object
       !> Get value at a given key. KeyError if key does not exist
       generic, public :: getitem => mapping_getitem_${KEY_TYPE_NAME}$_object   
       procedure, private :: mapping_setitem_${KEY_TYPE_NAME}$_object
       !> Inserts value at given key. Sets value if key already exists.
       generic, public :: setitem => mapping_setitem_${KEY_TYPE_NAME}$_object
       !> Delete key-value pair with given key.
       procedure, private :: mapping_delitem_${KEY_TYPE_NAME}$
       generic, public :: delitem => mapping_delitem_${KEY_TYPE_NAME}$
       #:for ITEM_TYPE_NAME in ITEM_TYPE_NAMES
         procedure, private :: mapping_getitem_${KEY_TYPE_NAME}$_${ITEM_TYPE_NAME}$
         !> Get value at a given key. KeyError if key does not exist
         generic, public :: getitem => mapping_getitem_${KEY_TYPE_NAME}$_${ITEM_TYPE_NAME}$    
         procedure, private :: mapping_setitem_${KEY_TYPE_NAME}$_${ITEM_TYPE_NAME}$
         !> Inserts value at given key. Sets value if key already exists.
         generic, public :: setitem => mapping_setitem_${KEY_TYPE_NAME}$_${ITEM_TYPE_NAME}$
       #:endfor
     #:endfor

    #:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
      procedure, private :: mapping_len_${INDEX_TYPE_NAME}$
      !> Get number of key-value pairs.
      generic, public :: len => mapping_len_${INDEX_TYPE_NAME}$
    #:endfor

    !> Checks if key is contained in datastructure.
    procedure, public :: mapping_contains
    
end type

type, extends(Mapping) :: dict
  contains
      !> Removes all key-value pairs from dictionary.
      procedure, public :: clear => dict_clear
      !> Creates a copy of dict
      procedure, public :: copy => dict_copy
      !> Creates a list of a dict's keys 
      procedure, public :: keys => dict_keys
      !> Creates a list of a dict's key-value pairs.
      procedure, public :: items => dict_items
      !> Creates a list of a dict's values
      procedure, public :: values => dict_values

      procedure, private :: dict_get_object_object 
      !> Get value at a given key. If key does not exist, return a default value.
      generic, public :: get => dict_get_object_object    
      #:for KEY_TYPE_NAME in ("int32", "int64", "chars")
        procedure, private :: dict_get_${KEY_TYPE_NAME}$_object 
        !> Get value at a given key. If key does not exist, return a default value.
        generic, public :: get => dict_get_${KEY_TYPE_NAME}$_object
        #:for ITEM_TYPE_NAME in ITEM_TYPE_NAMES
        procedure, private :: dict_get_${KEY_TYPE_NAME}$_${ITEM_TYPE_NAME}$ 
        !> Get value at a given key. If key does not exist, return a default value.
        generic, public :: get => dict_get_${KEY_TYPE_NAME}$_${ITEM_TYPE_NAME}$        
        #:endfor      
      #:endfor

      !> Get value at a given key. If key does not exist, set value at key to default value and return default.
      procedure, public :: setdefault => dict_setdefault_object_object       
end type

!> Type that corresponds to a Python tuple. Create with tuple_create.
type, extends(ImmutableSequence) :: tuple
  contains
#:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
    procedure, private :: tuple_setitem_${INDEX_TYPE_NAME}$_object
    !> Sets item at given index. One must set all items before use of tuple.
    generic, public :: setitem => tuple_setitem_${INDEX_TYPE_NAME}$_object
#:for ITEM_TYPE_NAME in ITEM_TYPE_NAMES
    procedure, private :: tuple_setitem_${INDEX_TYPE_NAME}$_${ITEM_TYPE_NAME}$
    !> Sets item at given index. One must set all items before use of tuple.
    generic, public :: setitem => tuple_setitem_${INDEX_TYPE_NAME}$_${ITEM_TYPE_NAME}$
#:endfor
#:endfor

    !> Concatenates tuples.
    procedure, public :: add => tuple_add
end type

!> Creates a tuple with a given number of items.
interface tuple_create
  module procedure tuple_create_int32
  module procedure tuple_create_int64
  module procedure tuple_create_object
end interface

!> Creates a list. Create as empty list or from other object.
interface list_create
  module procedure list_create_empty
  module procedure list_create_object
end interface

!> Type corresponding to Python 'bytes'.
type, extends(ImmutableSequence) :: bytes

end type

!> Creates a bytes object from Fortran character string or character array.
interface bytes_create
  module procedure bytes_create_chars
  module procedure bytes_create_char_1d  
end interface

!> Type corresponding to Python 'str' - Python's string type.
type, extends(ImmutableSequence) :: str

end type

!> Creates a str object from Fortran character string or character array.
interface str_create
  module procedure str_create_chars
  module procedure str_create_char_1d
  module procedure str_create_object
end interface

!> Type corresponding to Python 2 'unicode' or Python 3 'str'.
type, extends(ImmutableSequence) :: unicode

end type

!> Creates a unicode string from Fortran character string or character array.
interface unicode_create
  module procedure unicode_create_chars
  module procedure unicode_create_char_1d  
end interface

!> Type representing a Python module 
type, extends(object) :: module_py
end type

!> Type representing Python's 'None'. Create with NoneType_create.
type, extends(object) :: NoneType
end type

!> Interface to call a Python objects (methods or other callables)
!> Arguments (optional) have to be passed as tuple.
!> Keyword arguments (optional) have to be passed as dict.
interface call_py
  module procedure call_py_attribute
  module procedure call_py_object
  module procedure call_py_object_nokwargs
  module procedure call_py_object_noargs
  module procedure call_py_object_only_kwargs
end interface

!> Interface to call a Python objects (methods or other callables), ignoring the return value.
!> Arguments (optional) have to be passed as tuple.
!> Keyword arguments (optional) have to be passed as dict.
interface call_py_noret
  module procedure call_py_noret_attribute
  module procedure call_py_noret_object
end interface

!> Creates a new reference to an object. Python equivalent: lhs = rhs
!> Do not forget to destroy lhs after use.
interface assign_py
#:for TYPE_NAME in FORPY_TYPES
  module procedure assign_py_${TYPE_NAME}$
#:endfor
end interface

! or extends MutableSequence? probably better as object since indexing is fancier than for a sequence?
!> Type that represents a Numpy array
type, extends(object) :: ndarray
  contains
#:for NDIM in range(1, NDARRAY_MAX_DIMENSION + 1)
#:for TYPE_NAME in ("int32", "int64", "real32", "real64", "complex_real32", "complex_real64")
    procedure, private :: get_data_${TYPE_NAME}$_${NDIM}$d
    !> Retrieve a Fortran pointer to the array data.
    generic, public :: get_data => get_data_${TYPE_NAME}$_${NDIM}$d
#:endfor
#:endfor
  !> Transpose the array.
  procedure, public :: transpose => ndarray_transpose
  !> Create a copy (with its own data) of the ndarray
  procedure, public :: copy => ndarray_copy
  !> Checks if the array has Fortran or C storage order (contiguous array)
  procedure, public :: is_ordered => ndarray_is_ordered
  !> Get numpy.dtype type identifier of the array. Python equivalent: self.dtype.name
  procedure, public :: get_dtype_name => ndarray_get_dtype_name
  
  procedure, private :: ndarray_ndim_int32
  procedure, private :: ndarray_ndim_int64
  !> Get dimension of array
  generic, public :: ndim => ndarray_ndim_int32
  !> Get dimension of array
  generic, public :: ndim => ndarray_ndim_int64
end type

!> Create a ndarray from a Fortran array. The ndarray will be a copy
!> of the Fortran array.
interface ndarray_create
#:for NDIM in range(1, NDARRAY_MAX_DIMENSION + 1)
#:for TYPE_NAME in ("int32", "int64", "real32", "real64", "complex_real32", "complex_real64")
  module procedure ndarray_create_${TYPE_NAME}$_${NDIM}$d
#:endfor
#:endfor
end interface

!> Create a ndarray wrapper for a Fortran array. NO copy is made, changes 
!> to the Fortran array affect the ndarray and vice versa.
!>
!> Only pass contiguous Fortran arrays to this function. This is not checked!
!>
!> The lifetime of the Fortran array must be at least as long as the
!> ndarray is in use: beware of deallocation and compiler generated
!> temporary arrays.
!>
!> Since the Fortran array is used as underlying buffer for the ndarray,
!> it can be indirectly modified by changing the ndarray. To avoid bugs
!> related to certain compiler optimizations, declare the Fortran array
!> with the 'asynchronous' attribute.
interface ndarray_create_nocopy
#:for NDIM in range(1, NDARRAY_MAX_DIMENSION + 1)
#:for TYPE_NAME in ("int32", "int64", "real32", "real64", "complex_real32", "complex_real64")
  module procedure ndarray_create_nocopy_${TYPE_NAME}$_${NDIM}$d
#:endfor
#:endfor
end interface

!> Creates an empty ndarray of given shape. Array contains uninitialised values.
interface ndarray_create_empty
  module procedure ndarray_create_empty_aint32
  module procedure ndarray_create_empty_aint64
  module procedure ndarray_create_empty_int32
  module procedure ndarray_create_empty_int64
end interface

!> Creates a ndarray of zeroes.
interface ndarray_create_zeros
  module procedure ndarray_create_zeros_aint32
  module procedure ndarray_create_zeros_aint64
  module procedure ndarray_create_zeros_int32
  module procedure ndarray_create_zeros_int64
end interface

!> Creates a ndarray of ones.
interface ndarray_create_ones
  module procedure ndarray_create_ones_aint32
  module procedure ndarray_create_ones_aint64
  module procedure ndarray_create_ones_int32
  module procedure ndarray_create_ones_int64
end interface

!> Casts/Transforms between Fortran and Python datatypes
!>
!> Result is 1st argument to cast, object/scalar to cast 2nd argument
!> Use to cast/transform a Python [[object]] into a Fortran value
!> Use to cast/transform Fortran values into a Python [[object]]
!> and to cast an unspecific Python [[object]] into more specific objects, such
!> as [[list]], [[tuple]], [[dict]]
!> Fortran values can be scalars and character strings or character arrays
!> Fortran character strings are decoded as UTF-8
!> Python strings are encoded as UTF-8
!>
!> For casting to numerical Fortran scalars, there is an optional 3rd argument "strict"
!> for cast: if strict=.false. it will try to convert numerical values to the requested
!> datatype (default: strict=.true.). This is the same as using [[cast_nonstrict]].
interface cast
  module procedure cast_to_list
  module procedure cast_to_dict
  module procedure cast_to_tuple
  module procedure cast_to_NoneType
  module procedure cast_to_ndarray
  module procedure cast_to_str
  module procedure cast_to_bytes
  module procedure cast_to_unicode
  module procedure cast_to_object
  
  module procedure cast_to_char_1d
  module procedure cast_to_chars
  module procedure cast_from_char_1d
  module procedure cast_from_chars
  
#:for _, TYPE_NAME, _ in SCALAR_FORTRAN_TYPE_INFO
  module procedure cast_to_${TYPE_NAME}$
  module procedure cast_to_${TYPE_NAME}$_flex
  module procedure cast_from_${TYPE_NAME}$  
#:endfor
end interface

!> Non-strict casts/transforms between Fortran and Python datatypes
!>
!> Result is 1st argument to cast, 2nd argument object/scalar to cast
!>
!> In contrast to [[cast]], cast_nonstrict tries to convert to the type specified
!> by the 1st argument even when there is no exact correspondence of types.
!> Non-strict cast might lead to loss of information (e. g. when casting
!> a float to an integer) or might need additional memory and time for 
!> making a copy (e. g. casting a list to a tuple) 
!>
!> Use to cast/transform a Python [[object]] into a Fortran value
!> and to cast an unspecific Python [[object]] into more specific objects, such
!> as [[list]] or [[tuple]], converting between types when necessary.
!> Fortran values can be scalars or character strings.
!> 
!> Can be used to get the string representation of a Python object
!> as a Fortran character string.
!> Python strings are encoded as UTF-8
interface cast_nonstrict
  module procedure cast_nonstrict_to_list
  module procedure cast_nonstrict_to_tuple
  module procedure cast_nonstrict_to_str
  
  ! no cast_nonstrict_to_char_1d, because one can 
  ! not always return a pointer to a character buffer
  
  module procedure cast_nonstrict_to_chars
  
#:for _, TYPE_NAME, _ in SCALAR_FORTRAN_TYPE_INFO
  module procedure cast_nonstrict_to_${TYPE_NAME}$ 
#:endfor
end interface

! Class objects that correspond to Python standard exceptions
#:for exc in PYTHON_STANDARD_EXCEPTIONS
type(type_py), public, save :: ${exc}$
#:endfor

! Types needed for writing a Python extension
! For extensions one needs exactly one of PythonMethodTable and PythonModule at Fortran module level

!> just a helper type, not public
type PythonMethodTableStrings
  character(kind=C_CHAR, len=:), pointer :: doc_string
  character(kind=C_CHAR, len=:), pointer :: method_name
end type

!> Only used for writing Python extension modules. Datastructure to hold table of methods of your Python extension module.
!> Put exactly one instance at Fortran module level.
!>
!> Python 3: initialise and configure in PyInit_*module name* function with bind(c, name="PyInit_*module_name*") 
!>           attribute and type(c_ptr) return value.
!> Python 2: initialise in init*module name* subroutine with bind(c) attribute
!>
!> Pass the configured PythonMethodTable to PythonModule%init
type PythonMethodTable
private
  type(PyMethodDef), dimension(:), pointer :: methods
  type(PythonMethodTableStrings), dimension(:), allocatable :: strings
  integer :: num_methods
  integer :: method_count
contains
  !> Initialises the method table. Call in PyInit_*module name* (Py3) / init*module name* (Py2)
  procedure, public :: init => PythonMethodTable_init
  !> Adds a method to your Python module
  procedure, public :: add_method => PythonMethodTable_add_method
  !> Used only internally. Gets type(c_ptr) to method table.
  procedure, public :: get_method_table => PythonMethodTable_get
end type

!> Only used for writing Python extension modules. Datastructure to hold information about 
!> your Python extension module. Put exactly one instance at Fortran module level.
!>
!> Python 3: initialise and configure in PyInit_<module name> function with bind(c, name="PyInit_<module_name>") 
!>           attribute and type(c_ptr) return value.
!>
!> Python 2: initialise in init<module name> subroutine with bind(c) attribute
type PythonModule
private
  type(PyModuleDef), pointer :: module_def
  character(kind=C_CHAR, len=:), pointer :: doc_string
  character(kind=C_CHAR, len=:), pointer :: module_name
  type(c_ptr) :: module_ptr
contains
  !> Initialises the PythonModule with a PythonMethod table.
  !>
  !> Python 3: the return value must be returned by PyInit_*module name*
  !>
  !> Python 2: call in init*module name*, ignore return value
  procedure, public :: init => PythonModule_init
  !> Adds a Python object to the module that can be accessed by 
  !> my_module.the_name_of_object_added
  !> Useful to add constants to a Python module
  procedure, public :: add_object => PythonModule_add_object
end type

CONTAINS

!> Initialisation of forpy module. Must be called before using forpy.
function forpy_initialize(use_numpy) result(ierror)
  !> Set to .false., if you do not need the array features of forpy powered by numpy. (Default: .true.)
  logical, optional, intent(in) :: use_numpy
  integer(kind=C_INT) :: ierror
  
  logical :: numpy_flag

  if (present(use_numpy)) then
    numpy_flag = use_numpy
  else
    numpy_flag = .true.
  endif

  ierror = 1_C_INT
  if (Py_IsInitialized() == 0_C_INT) then
    call Py_Initialize()
  endif

  ierror = 0_C_INT
  if (global_forpy_initialized == 0) then
    ierror = forpy_initialize_forpy_globals()
    if (ierror == 0_C_INT) then
      global_forpy_initialized = 1
    endif
  endif

  if (ierror == 0_C_INT .and. numpy_flag &
      .and. .not. c_associated(global_numpy_mod)) then
    ierror = forpy_initialize_numpy()
  endif
end function

function forpy_initialize_forpy_globals() result(ierror)
  integer(kind=C_INT) :: ierror
  
  ! Initialise Python's None object
  ierror = forpy_initialize_none()
  if (ierror /= 0) then
    return
  endif

  ierror = forpy_initialize_float()
  if (ierror /= 0) then
    return
  endif

  ierror = forpy_initialize_complex()
  if (ierror /= 0) then
    return
  endif

  ierror = forpy_initialize_bool()
  if (ierror /= 0) then
    return
  endif
  
  ierror = forpy_initialize_unicode()
  if (ierror /= 0) then
    return
  endif

  ierror = forpy_initialize_exceptions()
  if (ierror /= 0) then
    return
  endif

  ierror = forpy_initialize_sys_argv()
  if (ierror /= 0) then
    return
  endif
end function

!> Sets sys.argv = [''], since some 3rd party Python modules require
!> sys.argv[0] - before Python 3.8 sys.argv does not exist in embedded Python,
!> see https://bugs.python.org/issue32573
function forpy_initialize_sys_argv() result(ierror)
  integer(kind=C_INT) :: ierror
  
  ! there also exist C-API functions to set sys.argv, but they involve wchar_t
  ! which iso_c_binding does not support and that has platform dep. size
  ierror = PyRun_SimpleString("import sys" // C_NEW_LINE // &
                              "if not hasattr(sys, 'argv') or sys.argv==[]:" // C_NEW_LINE // &
                              "  sys.argv=['']" // C_NEW_LINE // C_NULL_CHAR)
end function

function forpy_initialize_numpy() result(ierror)
  integer(kind=C_INT) :: ierror

  type(c_ptr) :: asarray_str
  type(c_ptr) :: ndarray_str

  ! Initialisation of Numpy
  global_numpy_mod = PyImport_ImportModule(C_CHAR_"numpy" // C_NULL_CHAR)
  if (.not. c_associated(global_numpy_mod)) then
    ierror = NO_NUMPY_ERROR
    call err_clear
    return
  else
  
    ! TODO: exception checks?
    ierror = box_value(asarray_str, "asarray")
    
    if (.not. c_associated(asarray_str)) then
      ierror = NO_NUMPY_ERROR
      call err_clear
      return
    else
      global_numpy_asarray_method = PyObject_GetAttr(global_numpy_mod, asarray_str)
      call Py_Decref(asarray_str)

      if (.not. c_associated(global_numpy_asarray_method)) then
        ierror = NO_NUMPY_ERROR ! Something's wrong with numpy... but might use Python without numpy
        call err_clear
      endif
    endif
  endif

  ! Get the numpy.ndarray type-object
  if (ierror == 0) then
    ierror = box_value(ndarray_str, "ndarray")

    if (ierror /= 0) then
      return
    endif

    global_numpy_ndarray_typeobj = PyObject_GetAttr(global_numpy_mod, ndarray_str)
    call Py_Decref(ndarray_str)

    if (.not. c_associated(global_numpy_asarray_method)) then
      ierror = NO_NUMPY_ERROR ! No Numpy...
      call err_clear
    endif

  endif

end function

! sets up Python's None
function forpy_initialize_none() result(ierror)
  integer(kind=C_INT) :: ierror

  type(list) :: li
  type(tuple) :: args
  type(dict) :: kwargs
  type(object) :: none_obj

  ! A bit hacky: use return value of the following python expression
  ! to get pointer to the singleton None-object (_Py_NoneStruct):
  ! The expression is: [].sort()

  ierror = list_create(li)
  if (ierror /= 0) then
    return
  endif

  ierror = tuple_create(args, 0)
  if (ierror /= 0) then
    call li%destroy()
    return
  endif

  ierror = dict_create(kwargs)
  if (ierror /= 0) then
    call li%destroy()
    call args%destroy()
    return
  endif

  ierror = call_py_attribute(none_obj, li, "sort", args, kwargs)

  if (ierror == 0 .and. c_associated(none_obj%py_object)) then
    global_Py_NoneStruct_ptr = none_obj%py_object
    call none_obj%destroy()
  endif

  call li%destroy()
  call args%destroy()
  call kwargs%destroy()

  ierror = 0_C_INT
end function

! Get pointer to "float"-type object
function forpy_initialize_float() result(ierror)
  integer(kind=C_INT) :: ierror

  type(c_ptr) :: a_float
  type(PyObject), pointer :: ptr

  a_float = PyFloat_FromDouble(1.0_C_DOUBLE)

  if (.not. c_associated(a_float)) then
    ierror = EXCEPTION_ERROR
    return
  endif

  call c_f_pointer(a_float, ptr)
  global_pyfloat_type_ptr = ptr%ob_type
  call Py_DecRef(a_float)
  ierror = 0_C_INT
end function

! Get pointer to "complex"-type object
! Note: floats are not complex in Python
function forpy_initialize_complex() result(ierror)
  integer(kind=C_INT) :: ierror

  type(c_ptr) :: a_complex
  type(PyObject), pointer :: ptr

  a_complex = PyComplex_FromDoubles(1.0_C_DOUBLE, 1.0_C_DOUBLE)

  if (.not. c_associated(a_complex)) then
    ierror = EXCEPTION_ERROR
    return
  endif

  call c_f_pointer(a_complex, ptr)
  global_pycomplex_type_ptr = ptr%ob_type
  call Py_DecRef(a_complex)
  ierror = 0_C_INT
end function

! Get pointer to "unicode"-type object
function forpy_initialize_unicode() result(ierror)
  integer(kind=C_INT) :: ierror

  type(c_ptr) :: a_unicode
  type(PyObject), pointer :: ptr
  
  character(kind=C_CHAR), dimension(1) :: a
  character(kind=C_CHAR), dimension(7) :: b 
  
  a = [C_NULL_CHAR]
  b = ['s','t','r','i','c','t', C_NULL_CHAR]

  ! fix for PGI compiler: pgi does not like if a and b are 
  ! string literals in this function call
  a_unicode = PyUnicode_DecodeUTF8(a, 0_PY_SSIZE_T_KIND, b)

  if (.not. c_associated(a_unicode)) then
    ierror = EXCEPTION_ERROR
    return
  endif

  call c_f_pointer(a_unicode, ptr)
  global_pyunicode_type_ptr = ptr%ob_type
  call Py_DecRef(a_unicode)
  ierror = 0_C_INT
end function

! Get pointer to "bool"-type object and the singletons Py_True and Py_False
function forpy_initialize_bool() result(ierror)
  integer(kind=C_INT) :: ierror

  type(c_ptr) :: a_bool
  type(PyObject), pointer :: ptr

  a_bool = PyBool_FromLong(0_C_LONG)

  if (.not. c_associated(a_bool)) then
    ierror = EXCEPTION_ERROR
    return
  endif

  call c_f_pointer(a_bool, ptr)
  global_pybool_type_ptr = ptr%ob_type
  global_Py_FalseStruct_ptr = a_bool
  call Py_DecRef(a_bool)

  a_bool = PyBool_FromLong(1_C_LONG)

  if (.not. c_associated(a_bool)) then
    ierror = EXCEPTION_ERROR
    return
  endif

  global_Py_TrueStruct_ptr = a_bool
  call Py_DecRef(a_bool)

  ierror = 0_C_INT
end function

! initialise Python standard exceptions
function forpy_initialize_exceptions() result(ierror)
  integer(kind=C_INT) :: ierror
  
  type(c_ptr) :: tmp
  type(c_ptr) :: builtin_dict
  
  ierror = 0_C_INT

  builtin_dict = PyEval_GetBuiltins()
  if (.not. c_associated(builtin_dict)) then
    ierror = 1_C_INT
    return
  endif
  
#:for exc in PYTHON_STANDARD_EXCEPTIONS
  tmp = PyDict_GetItemString(builtin_dict, "${exc}$" // C_NULL_CHAR) 
  if (.not. c_associated(tmp)) then; call PyErr_Clear(); endif
  ${exc}$%py_object = tmp
#:endfor
end function

!> Frees resources used by Python interpreter. Call when finished using forpy.
subroutine forpy_finalize()
  global_forpy_initialized = 0
  call Py_Decref(global_numpy_asarray_method)
  call Py_Decref(global_numpy_mod)
  global_numpy_asarray_method = C_NULL_PTR
  global_numpy_mod = C_NULL_PTR

  call Py_Finalize()
end subroutine


!-------------------------------------------------------------------------------------
! Functions to check type
#:for TYPE, BIT in zip(("long", "list", "tuple", "bytes", "dict"), (24, 25, 26, 27, 29))
!> Checks if object is a Python ${TYPE}$.
logical function is_${TYPE}$(obj)
  !> The object to check.
  class(object), intent(in) :: obj

  is_${TYPE}$ = (check_tp_flags(obj%py_object, ishft(1_C_LONG, ${BIT}$)) /= 0)
end function

#:endfor

#:for TYPE in ("float", "complex", "bool", "unicode")
!> Checks if object is a Python ${TYPE}$.
logical function is_${TYPE}$(obj)
  !> The object to check.
  class(object), intent(in) :: obj
  type(PyObject), pointer :: obj_ptr

  if (.not. (c_associated(obj%py_object) .and. c_associated(global_py${TYPE}$_type_ptr))) then
    is_${TYPE}$ = .false.
    return
  endif

  call c_f_pointer(obj%py_object, obj_ptr)
  is_${TYPE}$ = c_associated(global_py${TYPE}$_type_ptr, obj_ptr%ob_type)
  if (.not. is_${TYPE}$) then
    is_${TYPE}$ = (PyType_IsSubtype(obj_ptr%ob_type, global_py${TYPE}$_type_ptr) /= 0) ! Check if subtype
  endif
end function

#:endfor

#ifdef PYTHON2
logical function is_short_int(obj)
  class(object), intent(in) :: obj

  is_short_int = (check_tp_flags(obj%py_object, ishft(1_C_LONG, 23)) /= 0)
end function

!> Checks if object is of integer Python type ('int' OR 'long')
logical function is_int(obj)
  !> The object to check.
  class(object), intent(in) :: obj

  is_int = is_short_int(obj)
  if (.not. is_int) then
    is_int = is_long(obj)
  endif
end function
#endif

#ifndef PYTHON2
!> Checks if object is a Python int
logical function is_int(obj)
  !> The object to check.
  class(object), intent(in) :: obj

  is_int = is_long(obj)
end function
#endif

!> Checks if object is a Python str
logical function is_str(obj)
  !> The object to check.
  class(object), intent(in) :: obj
#ifdef PYTHON2
  is_str = is_bytes(obj)
#else
  is_str = is_unicode(obj)
#endif
end function

!> Checks if object is a Python None.
logical function is_none(obj)
  !> The object to check.
  class(object), intent(in) :: obj

  is_none = c_associated(obj%py_object) .and. c_associated(global_Py_NoneStruct_ptr, obj%py_object)
end function

!> Returns true if object is a null-pointer internally. Object is not properly initialised then.
logical function is_null(obj)
  !> The object to check.
  class(object), intent(in) :: obj

  is_null = (.not. c_associated(obj%py_object))
end function

!> Checks if object is a Numpy array.
logical function is_ndarray(obj)
  !> The object to check.
  class(object), intent(in) :: obj

  integer(kind=C_INT) :: res
  type(c_ptr) :: err_obj

  if (.not. c_associated(global_numpy_ndarray_typeobj)) then
    is_ndarray = .false.
    return
  endif

  res = PyObject_IsInstance(obj%py_object, global_numpy_ndarray_typeobj)

  ! if res==-1 then exception is set by PyObject_IsInstance
  ! clear the exception and return false
  if (res == -1_C_INT) then
    is_ndarray = .false.
      err_obj = PyErr_Occurred()
      if (c_associated(err_obj)) then
        call PyErr_Clear()
      endif
    return
  endif

  is_ndarray = (res == 1)
end function

!> Helper for type checks
function check_tp_flags(py_obj, mask) result(res)
  type(c_ptr), intent(in) :: py_obj
  integer(kind=C_LONG), intent(in) :: mask
  integer(kind=C_LONG) :: res

  type(PyObject), pointer :: obj_ptr
  type(PyTypeObject), pointer :: type_ptr

  call c_f_pointer(py_obj, obj_ptr)
  call c_f_pointer(obj_ptr%ob_type, type_ptr)

  res = iand(type_ptr%tp_flags, mask)
end function

!> Creates an empty list. Python equivalent: r = []
function list_create_empty(r) result(ierror)
  !> the freshly created empty list
  type(list), intent(out) :: r
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror

  r%py_object = PyList_New(0_PY_SSIZE_T_KIND)
  ierror = 0_C_INT

  if (.not. c_associated(r%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

!> Creates a list from given object if possible. Python equivalent: r = list(obj)
function list_create_object(r, obj) result(ierror)
  !> the freshly created list
  type(list), intent(out) :: r
  !> object to create list from
  class(object), intent(in) :: obj
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror
  
  ierror = 0_C_INT
  r%py_object = PySequence_List(obj%py_object)
  
  if (.not. c_associated(r%py_object)) then 
    ierror = EXCEPTION_ERROR
  endif
end function

#:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
!> Creates a tuple with a given number of elements
function tuple_create_${INDEX_TYPE_NAME}$(r, len) result(ierror)
  !> the freshly created tuple
  type(tuple), intent(out) :: r
  !> Number of items in tuple
  integer(kind=${INDEX_TYPE_NAME}$), intent(in) :: len
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror

  integer(kind=PY_SSIZE_T_KIND) :: tmp

  tmp = int(len, PY_SSIZE_T_KIND)
  r%py_object = PyTuple_New(tmp)
  ierror = 0_C_INT

  if (.not. c_associated(r%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

#:endfor

function tuple_create_object(r, obj) result(ierror)
  !> the created tuple
  type(tuple), intent(out) :: r
  class(object), intent(in) :: obj
  integer(kind=C_INT) :: ierror
  
  ierror = 0_C_INT
  r%py_object = PySequence_Tuple(obj%py_object)
  
  if (.not. c_associated(r%py_object)) then 
    ierror = EXCEPTION_ERROR
  endif

end function

!> Creates a Python None.
function NoneType_create(r) result(ierror)
  !> The created None
  type(NoneType), intent(out) :: r
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror

  r%py_object = global_Py_NoneStruct_ptr
  call Py_IncRef(global_Py_NoneStruct_ptr)
  ierror = 0_C_INT  

end function

!> Creates an empty Python dictionary. Python: r = {}
function dict_create(r) result(ierror)
  !> The created empty dict
  type(dict), intent(out) :: r
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror
  
  r%py_object = PyDict_New()
  ierror = 0_C_INT 

  if (.not. c_associated(r%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

subroutine dict_clear(self)
  class(dict), intent(inout) :: self
  call PyDict_Clear(self%py_object)
end subroutine

function dict_copy(self, dest) result(ierror)
  class(dict), intent(in) :: self
  type(dict), intent(out) :: dest
  integer(kind=C_INT) :: ierror
  
  ierror = 0_C_INT
  dest%py_object = PyDict_Copy(self%py_object)
  if (.not. c_associated(dest%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

function dict_keys(self, keys) result(ierror)
  class(dict), intent(in) :: self
  type(list), intent(out) :: keys
  integer(kind=C_INT) :: ierror
  
  ierror = 0_C_INT
  keys%py_object = PyDict_Keys(self%py_object)
  if (.not. c_associated(keys%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

function dict_items(self, items) result(ierror)
  class(dict), intent(in) :: self
  type(list), intent(out) :: items
  integer(kind=C_INT) :: ierror
  
  ierror = 0_C_INT
  items%py_object = PyDict_Items(self%py_object)
  if (.not. c_associated(items%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

function dict_values(self, values) result(ierror)
  class(dict), intent(in) :: self
  type(list), intent(out) :: values
  integer(kind=C_INT) :: ierror
  
  ierror = 0_C_INT
  values%py_object = PyDict_Values(self%py_object)
  if (.not. c_associated(values%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

function list_append_object(self, item) result(ierror)
  class(list), intent(inout) :: self
  class(object), intent(in) :: item
  integer(kind=C_INT) :: ierror

  ierror = PyList_Append(self%py_object, item%py_object)
end function

#:for ITEM_TYPE, ITEM_TYPE_NAME in zip(ITEM_TYPES_INPUT, ITEM_TYPE_NAMES)
function list_append_${ITEM_TYPE_NAME}$(self, item) result(ierror)
  class(list), intent(inout) :: self
  ${ITEM_TYPE}$, intent(in) :: item
  integer(kind=C_INT) :: ierror

  type(c_ptr) :: item_py

  ierror = box_value(item_py, item)

  if (ierror == 0_C_INT) then
    ierror = PyList_Append(self%py_object, item_py)
    call Py_DecRef(item_py)
  endif
end function

#:endfor

function list_copy(self, dest) result(ierror)
  class(list), intent(in) :: self
  type(list), intent(out) :: dest
  integer(kind=C_INT) :: ierror
  
  ierror = list_create(dest, self)
end function

function list_sort(self) result(ierror)
  class(list), intent(inout) :: self
  integer(kind=C_INT) :: ierror
  
  ierror = PyList_Sort(self%py_object)
end function

function list_reverse(self) result(ierror)
  class(list), intent(inout) :: self
  integer(kind=C_INT) :: ierror
  
  ierror = PyList_Reverse(self%py_object)
end function

!Creates new list by concatenating 'list_to_concatenate'
function list_add(self, result_list, list_to_concatenate) result(ierror)
  class(list), intent(inout) :: self
  type(list), intent(out) :: result_list
  class(list), intent(in) :: list_to_concatenate
  integer(kind=C_INT) :: ierror
  
  ierror = 0_C_INT
  result_list%py_object = PySequence_Concat(self%py_object, list_to_concatenate%py_object)
  if (.not. c_associated(result_list%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

#:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
function list_insert_${INDEX_TYPE_NAME}$(self, ind, item) result(ierror)
  class(list), intent(inout) :: self
  integer(kind=${INDEX_TYPE_NAME}$), intent(in) :: ind
  class(object), intent(in) :: item
  integer(kind=C_INT) :: ierror
  
  integer(kind=PY_SSIZE_T_KIND) :: ind_tmp
  
  ind_tmp = int(ind, PY_SSIZE_T_KIND)
  ierror = PyList_Insert(self%py_object, ind_tmp, item%py_object) 
end function

function list_delitem_${INDEX_TYPE_NAME}$(self, ind) result(ierror)
  class(list), intent(inout) :: self
  integer(kind=${INDEX_TYPE_NAME}$), intent(in) :: ind
  integer(kind=C_INT) :: ierror
  
  integer(kind=PY_SSIZE_T_KIND) :: ind_tmp
  
  ind_tmp = int(ind, PY_SSIZE_T_KIND)
  ierror = PySequence_DelItem(self%py_object, ind_tmp) 
end function

#:endfor

#:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
function sequence_getitem_${INDEX_TYPE_NAME}$_object(self, item, ind) result(ierror)
  class(Sequence), intent(inout) :: self
  type(object), intent(out) :: item
  integer(kind=${INDEX_TYPE_NAME}$), intent(in) :: ind

  integer(kind=C_INT) :: ierror
  integer(kind=PY_SSIZE_T_KIND) :: ind_py_ssize_t

  ierror = 0_C_INT
  ind_py_ssize_t = int(ind, PY_SSIZE_T_KIND)
  item%py_object = PySequence_GetItem(self%py_object, ind_py_ssize_t)

  if (.not. c_associated(item%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

#:for ITEM_TYPE, ITEM_TYPE_NAME in zip(ITEM_TYPES_OUTPUT, ITEM_TYPE_NAMES)
function sequence_getitem_${INDEX_TYPE_NAME}$_${ITEM_TYPE_NAME}$(self, item, ind) result(ierror)
  class(Sequence), intent(in) :: self
  ${ITEM_TYPE}$, intent(out) :: item
  integer(kind=${INDEX_TYPE_NAME}$), intent(in) :: ind

  integer(kind=C_INT) :: ierror
  integer(kind=PY_SSIZE_T_KIND) :: ind_py_ssize_t

  type(c_ptr) :: item_py

  ierror = 0_C_INT
  ind_py_ssize_t = int(ind, PY_SSIZE_T_KIND)
  item_py = PySequence_GetItem(self%py_object, ind_py_ssize_t)

  if (.not. c_associated(item_py)) then
    ierror = EXCEPTION_ERROR
  else
    ierror = unbox_value(item, item_py)
    call Py_DecRef(item_py)
  endif
end function

#:endfor
#:endfor

#! Can use the same code for sequences and mappings
#:for TYPE in ("Sequence", "Mapping")
#:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
function ${TYPE}$_len_${INDEX_TYPE_NAME}$(self, length) result(ierror)
  class(${TYPE}$), intent(in) :: self
  integer(kind=${INDEX_TYPE_NAME}$), intent(out) :: length
  integer(kind=C_INT) :: ierror
  
  integer(kind=PY_SSIZE_T_KIND) :: length_tmp
  
  ierror = 0_C_INT
  length_tmp = PyObject_Length(self%py_object)
  length = int(length_tmp, ${INDEX_TYPE_NAME}$)
  
  ! TODO: overflow check
  if (length_tmp == -1_PY_SSIZE_T_KIND) then
    ierror = EXCEPTION_ERROR
  endif
  
end function

#:endfor
#:endfor

#:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
function sequence_index_${INDEX_TYPE_NAME}$(self, ind, item) result(ierror)
  class(Sequence), intent(in) :: self
  integer(kind=${INDEX_TYPE_NAME}$), intent(out) :: ind  
  class(object), intent(in) :: item
  integer(kind=C_INT) :: ierror
  
  integer(kind=PY_SSIZE_T_KIND) :: ind_tmp
  
  ierror = 0_C_INT
  ind_tmp = PySequence_Index(self%py_object, item%py_object)
  ind = int(ind_tmp, ${INDEX_TYPE_NAME}$)
  
  ! TODO: overflow check
  if (ind_tmp == -1_PY_SSIZE_T_KIND) then
    ierror = EXCEPTION_ERROR
  endif
  
end function

function sequence_count_${INDEX_TYPE_NAME}$(self, the_count, item) result(ierror)
  class(Sequence), intent(in) :: self
  integer(kind=${INDEX_TYPE_NAME}$), intent(out) :: the_count  
  class(object), intent(in) :: item
  integer(kind=C_INT) :: ierror
  
  integer(kind=PY_SSIZE_T_KIND) :: the_count_tmp
  
  ierror = 0_C_INT
  the_count_tmp = PySequence_Count(self%py_object, item%py_object)
  the_count = int(the_count_tmp, ${INDEX_TYPE_NAME}$)
  
  ! TODO: overflow check
  if (the_count_tmp == -1_PY_SSIZE_T_KIND) then
    ierror = EXCEPTION_ERROR
  endif
  
end function

#:endfor

function sequence_contains(self, contain_flag, item) result(ierror)
  class(sequence), intent(in) :: self
  logical, intent(out) :: contain_flag
  class(object), intent(in) :: item
  integer(kind=C_INT) :: ierror
  
  ! returns -1 on error, 0 if item not contained, 1 if contained
  ierror = PySequence_Contains(self%py_object, item%py_object)
  contain_flag = (ierror == 1_C_INT)
  
  if (contain_flag) then
    ierror = 0_C_INT
  endif
  
end function

#:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
function mutablesequence_setitem_${INDEX_TYPE_NAME}$_object(self, ind, item) result(ierror)
  class(MutableSequence), intent(inout) :: self
  integer(kind=${INDEX_TYPE_NAME}$), intent(in) :: ind
  class(object), intent(in) :: item
  integer(kind=C_INT):: ierror

  integer(kind=PY_SSIZE_T_KIND) :: ind_py_ssize_t

  ind_py_ssize_t = int(ind, PY_SSIZE_T_KIND)

  ierror = PySequence_SetItem(self%py_object, ind_py_ssize_t, item%py_object)

end function

#:for ITEM_TYPE, ITEM_TYPE_NAME in zip(ITEM_TYPES_INPUT, ITEM_TYPE_NAMES)
function mutablesequence_setitem_${INDEX_TYPE_NAME}$_${ITEM_TYPE_NAME}$(self, ind, item) result(ierror)
  class(MutableSequence), intent(inout) :: self
  integer(kind=${INDEX_TYPE_NAME}$), intent(in) :: ind
  ${ITEM_TYPE}$, intent(in) :: item
  integer(kind=C_INT):: ierror

  integer(kind=PY_SSIZE_T_KIND) :: ind_py_ssize_t
  type(c_ptr) :: item_py

  ierror = box_value(item_py, item)
  ind_py_ssize_t = int(ind, PY_SSIZE_T_KIND)

  if (ierror == 0) then
    ierror = PySequence_SetItem(self%py_object, ind_py_ssize_t, item_py)
    call Py_DecRef(item_py)
  endif
end function

#:endfor
#:endfor


! See also: http://stackoverflow.com/questions/6111843/limitations-of-pytuple-setitem
! Tuple ref-count must be 1 - otherwise cannot set items
#:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
#:for ITEM_TYPE, ITEM_TYPE_NAME in zip(ITEM_TYPES_INPUT, ITEM_TYPE_NAMES)
function tuple_setitem_${INDEX_TYPE_NAME}$_${ITEM_TYPE_NAME}$(self, ind, item) result(ierror)
  class(tuple), intent(inout) :: self
  integer(kind=${INDEX_TYPE_NAME}$), intent(in) :: ind
  ${ITEM_TYPE}$, intent(in) :: item
  integer(kind=C_INT):: ierror

  type(c_ptr) :: item_py
  integer(kind=PY_SSIZE_T_KIND) :: ind_py_ssize_t

  ierror = box_value(item_py, item)
  ind_py_ssize_t = int(ind, PY_SSIZE_T_KIND)

  !tuple: must use PyTuple_SetItem
  !PyTuple_SetItem steals a reference - in contrast to PyObject_SetItem
  if (ierror == 0) then
    ierror = PyTuple_SetItem(self%py_object, ind_py_ssize_t, item_py)
    ! note: no need for Py_DecRef since reference is stolen
  endif
end function

#:endfor
#:endfor

#:for INDEX_TYPE_NAME in INDEX_TYPE_NAMES
function tuple_setitem_${INDEX_TYPE_NAME}$_object(self, ind, item) result(ierror)
  class(tuple), intent(inout) :: self
  integer(kind=${INDEX_TYPE_NAME}$), intent(in) :: ind
  class(object), intent(in) :: item
  integer(kind=C_INT):: ierror

  integer(kind=PY_SSIZE_T_KIND) :: ind_py_ssize_t
  
  ind_py_ssize_t = int(ind, PY_SSIZE_T_KIND)

  !tuple: must use PyTuple_SetItem
  !PyTuple_SetItem steals a reference - in contrast to PyObject_SetItem
  ! therefore must increase ref-count of item

  call Py_IncRef(item%py_object)
  ierror = PyTuple_SetItem(self%py_object, ind_py_ssize_t, item%py_object)
  
end function

#:endfor

function tuple_add(self, result_tuple, tuple_to_concatenate) result(ierror)
  class(tuple), intent(inout) :: self
  type(tuple), intent(out) :: result_tuple
  class(tuple), intent(inout) :: tuple_to_concatenate
  integer(kind=C_INT) :: ierror
  
  ierror = 0_C_INT
  result_tuple%py_object = PySequence_Concat(self%py_object, tuple_to_concatenate%py_object)
  if (.not. c_associated(result_tuple%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

function object_getattribute(self, attr, attr_name) result(ierror)
  class(object), intent(in) :: self
  type(object), intent(out) :: attr
  character(kind=C_CHAR, len=*), intent(in) :: attr_name
  integer(kind=C_INT) :: ierror

  type(c_ptr) :: attr_name_str

  ierror = box_value(attr_name_str, attr_name)

  if (ierror == 0_C_INT) then
    attr%py_object = PyObject_GetAttr(self%py_object, attr_name_str)
  else
    return
  endif

  call Py_Decref(attr_name_str)

  if (.not. c_associated(attr%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

function object_setattr(self, attr_name, attr_value) result(ierror)
  class(object), intent(inout) :: self
  character(kind=C_CHAR, len=*), intent(in) :: attr_name
  class(object), intent(in) :: attr_value
  integer(kind=C_INT) :: ierror

  type(c_ptr) :: attr_name_str

  ierror = box_value(attr_name_str, attr_name)

  if (ierror == 0_C_INT) then
    ierror = PyObject_SetAttr(self%py_object, attr_name_str, attr_value%py_object)
    call Py_Decref(attr_name_str)
  endif
end function

function object_delattr(self, attr_name) result(ierror)
  class(object), intent(inout) :: self
  character(kind=C_CHAR, len=*), intent(in) :: attr_name
  integer(kind=C_INT) :: ierror

  type(c_ptr) :: attr_name_str
  ierror = box_value(attr_name_str, attr_name)

  if (ierror == 0_C_INT) then
    ierror = PyObject_SetAttr(self%py_object, attr_name_str, C_NULL_PTR)
    call Py_Decref(attr_name_str)
  endif
end function

!> Get C pointer to an object, needed for developing Python extensions.
function object_get_c_ptr(self) result(r)
  class(object), intent(in) :: self
  type(c_ptr) :: r
  r = self%py_object
end function

subroutine object_destroy(self)
  class(object), intent(inout) :: self
  call Py_DecRef(self%py_object)
end subroutine

function mapping_getitem_object_object(self, item, key) result(ierror)
  class(Mapping), intent(inout) :: self
  type(object), intent(out) :: item
  class(object), intent(in) :: key

  integer(kind=C_INT) :: ierror

  item%py_object = PyObject_GetItem(self%py_object, key%py_object)

  if (.not. c_associated(item%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

#:for KEY_TYPE, KEY_TYPE_NAME in zip(("integer(kind=int32)", "integer(kind=int64)", "character(kind=C_CHAR, len=*)"), ("int32", "int64", "chars"))
function mapping_getitem_${KEY_TYPE_NAME}$_object(self, item, key) result(ierror)
  class(Mapping), intent(inout) :: self
  type(object), intent(out) :: item
  ${KEY_TYPE}$, intent(in) :: key

  integer(kind=C_INT) :: ierror
  type(c_ptr) :: ind_py

  ierror = box_value(ind_py, key)

  if (ierror /= 0) then
    return
  endif

  item%py_object = PyObject_GetItem(self%py_object, ind_py)
  call Py_DecRef(ind_py) !don't need index anymore

  if (.not. c_associated(item%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

#:for ITEM_TYPE, ITEM_TYPE_NAME in zip(ITEM_TYPES_OUTPUT, ITEM_TYPE_NAMES)
function mapping_getitem_${KEY_TYPE_NAME}$_${ITEM_TYPE_NAME}$(self, item, key) result(ierror)
  class(Mapping), intent(inout) :: self
  ${ITEM_TYPE}$, intent(out) :: item
  ${KEY_TYPE}$, intent(in) :: key

  integer(kind=C_INT) :: ierror
  type(c_ptr) :: item_py, ind_py

  ierror = box_value(ind_py, key)

  if (ierror /= 0) then
    return
  endif

  item_py = PyObject_GetItem(self%py_object, ind_py)
  call Py_DecRef(ind_py) !don't need index anymore

  if (.not. c_associated(item_py)) then
    ierror = EXCEPTION_ERROR
  else
    ierror = unbox_value(item, item_py)
    call Py_DecRef(item_py)
  endif

end function

#:endfor
#:endfor

function mapping_setitem_object_object(self, key, item) result(ierror)
  class(Mapping), intent(inout) :: self
  class(object), intent(in) :: key
  class(object), intent(in) :: item
  integer(kind=C_INT):: ierror

  ierror = PyObject_SetItem(self%py_object, key%py_object, item%py_object)
  
end function

function mapping_delitem_object(self, key) result(ierror)
  class(Mapping), intent(inout) :: self
  class(object), intent(in) :: key
  integer(kind=C_INT):: ierror

  ierror = PyObject_DelItem(self%py_object, key%py_object)
  
end function

#:for KEY_TYPE, KEY_TYPE_NAME in zip(("integer(kind=int32)", "integer(kind=int64)", "character(kind=C_CHAR, len=*)"), ("int32", "int64", "chars"))
function mapping_setitem_${KEY_TYPE_NAME}$_object(self, key, item) result(ierror)
  class(Mapping), intent(inout) :: self
  ${KEY_TYPE}$, intent(in) :: key
  class(object), intent(in) :: item
  integer(kind=C_INT):: ierror

  type(c_ptr) :: ind_py

  ierror = box_value(ind_py, key)

  if (ierror /= 0) then
    return
  endif

  ierror = PyObject_SetItem(self%py_object, ind_py, item%py_object)
  call Py_DecRef(ind_py)

end function

function mapping_delitem_${KEY_TYPE_NAME}$(self, key) result(ierror)
  class(Mapping), intent(inout) :: self
  ${KEY_TYPE}$, intent(in) :: key
  integer(kind=C_INT):: ierror

  type(c_ptr) :: ind_py

  ierror = box_value(ind_py, key)

  if (ierror /= 0_C_INT) then
    return
  endif

  ierror = PyObject_DelItem(self%py_object, ind_py)
  call Py_DecRef(ind_py)

end function

#:for ITEM_TYPE, ITEM_TYPE_NAME in zip(ITEM_TYPES_INPUT, ITEM_TYPE_NAMES)
function mapping_setitem_${KEY_TYPE_NAME}$_${ITEM_TYPE_NAME}$(self, key, item) result(ierror)
  class(Mapping), intent(inout) :: self
  ${KEY_TYPE}$, intent(in) :: key
  ${ITEM_TYPE}$, intent(in) :: item
  integer(kind=C_INT):: ierror

  type(c_ptr) :: item_py, ind_py

  ierror = box_value(ind_py, key)

  if (ierror == 0_C_INT) then
    ierror = box_value(item_py, item)

    if (ierror /= 0) then
      call Py_DecRef(ind_py)
      return
    endif
  endif

  if (ierror == 0_C_INT) then
    ierror = PyObject_SetItem(self%py_object, ind_py, item_py)
    call Py_DecRef(item_py)
    call Py_DecRef(ind_py)
  endif
  
end function

#:endfor
#:endfor

function mapping_contains(self, contain_flag, item) result(ierror)
  class(Mapping), intent(in) :: self
  logical, intent(out) :: contain_flag
  class(object), intent(in) :: item
  integer(kind=C_INT) :: ierror
  
  integer(kind=C_INT) :: cont
  ierror = 0_C_INT
  ! returns 0 if item not contained, 1 if contained
  ! in contrast to PySequence_Contains this never fails
  ! we want to have the same call signature as with sequence objects
  ! therefore we have ierror=0 as return value
  cont = PyMapping_HasKey(self%py_object, item%py_object)
  contain_flag = (cont == 1_C_INT)
  
end function

function dict_get_object_object(self, item, key, default_value) result(ierror)
  class(dict), intent(inout) :: self
  type(object), intent(out) :: item  
  class(object), intent(in) :: key
  class(object), intent(in) :: default_value

  integer(kind=C_INT) :: ierror

  ierror = dict_get_helper(self, item%py_object, key%py_object, default_value%py_object, .false.)
  
end function

#:for KEY_TYPE, KEY_TYPE_NAME in zip(("integer(kind=int32)", "integer(kind=int64)", "character(kind=C_CHAR, len=*)"), ("int32", "int64", "chars"))
function dict_get_${KEY_TYPE_NAME}$_object(self, item, key, default_value) result(ierror)
  class(dict), intent(inout) :: self
  type(object), intent(out) :: item  
  ${KEY_TYPE}$, intent(in) :: key
  class(object), intent(in) :: default_value

  integer(kind=C_INT) :: ierror
  type(c_ptr) :: key_ptr

  ierror = box_value(key_ptr, key)
  if (ierror == 0_C_INT) then
    ierror = dict_get_helper(self, item%py_object, key_ptr, default_value%py_object, .false.)
    call Py_Decref(key_ptr)
  endif
end function

#:for ITEM_TYPE, ITEM_TYPE_NAME in zip(ITEM_TYPES_OUTPUT, ITEM_TYPE_NAMES)
function dict_get_${KEY_TYPE_NAME}$_${ITEM_TYPE_NAME}$(self, item, key, default_value) result(ierror)
  class(dict), intent(inout) :: self
  ${ITEM_TYPE}$, intent(out) :: item  
  ${KEY_TYPE}$, intent(in) :: key
  ${ITEM_TYPE}$, intent(in) :: default_value

  integer(kind=C_INT) :: ierror
  type(c_ptr) :: item_ptr, key_ptr

  ierror = box_value(key_ptr, key)
  if (ierror /= 0_C_INT) then
    return
  endif

  ierror = dict_get_helper2(self, item_ptr, key_ptr)
  
  if (c_associated(item_ptr) .and. ierror == 0_C_INT) then
    ierror = unbox_value(item, item_ptr)
    call Py_Decref(item_ptr)
  else
    item = default_value
  endif
  
  call Py_Decref(key_ptr)
  
end function

#:endfor
#:endfor

function dict_setdefault_object_object(self, the_value, key, default_value) result(ierror)
  class(dict), intent(inout) :: self
  !> The value retrieved from the dict.
  type(object), intent(out) :: the_value
  !> Key to retrieve value from.
  class(object), intent(in) :: key
  !> Default value that is inserted into dict and returned., if key is not present.
  class(object), intent(in) :: default_value
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror

  ierror = dict_get_helper(self, the_value%py_object, key%py_object, default_value%py_object, .true.)
  
end function

function dict_get_helper(self, item_ptr, key_ptr, default_value_ptr, setdefault) result(ierror)
  class(dict), intent(inout) :: self
  type(c_ptr), intent(out) :: item_ptr  
  type(c_ptr), intent(in) :: key_ptr
  type(c_ptr), intent(in) :: default_value_ptr
  logical, intent(in) :: setdefault
  integer(kind=C_INT) :: ierror

  ierror = 0_C_INT
  item_ptr = PyObject_GetItem(self%py_object, key_ptr)

  if (.not. c_associated(item_ptr)) then
    !always return default value, when lookup fails
    item_ptr = default_value_ptr
    call Py_IncRef(default_value_ptr)
  
    if (exception_matches(KeyError)) then
      call err_clear()
      
      if (setdefault) then
        ierror = PyObject_SetItem(self%py_object, key_ptr, default_value_ptr)  
      endif
    else
      ierror = EXCEPTION_ERROR
      return
    endif
  endif
end function

function dict_get_helper2(self, item_ptr, key_ptr) result(ierror)
  class(dict), intent(inout) :: self
  type(c_ptr), intent(out) :: item_ptr  
  type(c_ptr), intent(in) :: key_ptr
  integer(kind=C_INT) :: ierror

  ierror = 0_C_INT
  item_ptr = PyObject_GetItem(self%py_object, key_ptr)

  if (.not. c_associated(item_ptr)) then
    if (exception_matches(KeyError)) then
      call err_clear()
    else
      ierror = EXCEPTION_ERROR
      return
    endif
  endif
end function

!-----------------------------------------------------------------------------------------------------
! bytes, str and unicode

function bytes_create_chars(r, string) result(ierror)
  type(bytes), intent(out) :: r
  character(kind=C_CHAR, len=*), intent(in) :: string
  integer(kind=C_INT) :: ierror

  ierror = box_value_chars_as_bytestr(r%py_object, string)
end function

function bytes_create_char_1d(r, string) result(ierror)
  type(bytes), intent(out) :: r
  character(kind=C_CHAR), dimension(:), intent(in) :: string
  integer(kind=C_INT) :: ierror

  ierror = box_value_char_1d_as_bytestr(r%py_object, string)
end function

function unicode_create_chars(r, string) result(ierror)
  type(unicode), intent(out) :: r
  character(kind=C_CHAR, len=*), intent(in) :: string
  integer(kind=C_INT) :: ierror

  ierror = box_value_chars_as_unicodestr(r%py_object, string)
end function

function unicode_create_char_1d(r, string) result(ierror)
  type(unicode), intent(out) :: r
  character(kind=C_CHAR), dimension(:), intent(in) :: string
  integer(kind=C_INT) :: ierror

  ierror = box_value_char_1d_as_unicodestr(r%py_object, string)
end function

function str_create_chars(r, string) result(ierror)
  type(str), intent(out) :: r
  character(kind=C_CHAR, len=*), intent(in) :: string
  integer(kind=C_INT) :: ierror

#ifdef PYTHON2
  ierror = box_value_chars_as_bytestr(r%py_object, string)
#else
  ierror = box_value_chars_as_unicodestr(r%py_object, string)
#endif
end function

function str_create_char_1d(r, string) result(ierror)
  type(str), intent(out) :: r
  character(kind=C_CHAR), dimension(:), intent(in) :: string
  integer(kind=C_INT) :: ierror

#ifdef PYTHON2
  ierror = box_value_char_1d_as_bytestr(r%py_object, string)
#else
  ierror = box_value_char_1d_as_unicodestr(r%py_object, string)
#endif
end function

function str_create_object(r, obj) result(ierror)
  type(str), intent(out) :: r
  class(object), intent(in) :: obj
  integer(kind=C_INT) :: ierror

  ierror = 0_C_INT
  r%py_object = PyObject_Str(obj%py_object)
  if (.not. c_associated(r%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

!-----------------------------------------------------------------------------------------------------
!> Import a Python module.
!>
!> Module must be in Python module search path.
!> The search path can be set via the environment variable PYTHONPATH or by
!> manipulating the list of paths retrieved by using [[get_sys_path]].
function import_py(mod_py, mod_name) result(ierror)
  !> The imported module
  type(module_py), intent(out) :: mod_py
  !> Name of the module to import. Name can include dots "."
  character(kind=C_CHAR, len=*), intent(in) :: mod_name
  !> Error code, 0 on success.
  integer(kind=C_INT) :: ierror

  ierror = 0_C_INT
  mod_py%py_object = PyImport_ImportModule(trim(mod_name) // C_NULL_CHAR)

  if (.not. c_associated(mod_py%py_object)) then
    ierror = EXCEPTION_ERROR
  endif
end function

!-----------------------------------------------------------------------------------------------------
!> Calling an object (method, function...) that is a member of another Python object (module,...).
!>
!> Python equivalent: return_value = obj.attr_name(*args, **kwargs)
function call_py_attribute(return_value, obj, attr_name, args, kwargs) result(ierror)
  type(object), intent(out) :: return_value
  class(object), intent(in) :: obj
  character(kind=C_CHAR, len=*), intent(in) :: attr_name
  class(tuple), intent(in), optional :: args
  class(dict), intent(in), optional :: kwargs

  integer(kind=C_INT) :: ierror

  type(object) :: obj_to_call
  ierror = obj%getattribute(obj_to_call, attr_name)

  if (ierror == 0) then
  
    if (present(kwargs) .and. present(args)) then
      ierror = call_py_object(return_value, obj_to_call, args, kwargs)
    elseif (present(args)) then
      ierror = call_py_object_nokwargs(return_value, obj_to_call, args)
    elseif (present(kwargs)) then
      ierror = call_py_object_only_kwargs(return_value, obj_to_call, kwargs)
    else
      ierror = call_py_object_noargs(return_value, obj_to_call)
    endif
    
    call obj_to_call%destroy()
  endif
end function

!> Calling a Python object (method, function...).
!>
!> Python equivalent: return_value = obj_to_call(*args, **kwargs)
function call_py_object(return_value, obj_to_call, args, kwargs) result(ierror)
  type(object), intent(out) :: return_value
  class(object), intent(in) :: obj_to_call
  class(tuple), intent(in):: args
  class(dict), intent(in) :: kwargs

  integer(kind=C_INT) :: ierror

  type(c_ptr) :: kw, args_ptr

  ierror = 0_C_INT

  kw = kwargs%py_object
  args_ptr = args%py_object

  return_value%py_object = PyObject_Call(obj_to_call%py_object, args_ptr, kw)

  if (.not. c_associated(return_value%py_object)) then
    ierror = EXCEPTION_ERROR
  endif

end function

!> Python equivalent: return_value = obj_to_call(*args)
function call_py_object_nokwargs(return_value, obj_to_call, args) result(ierror)
  type(object), intent(out) :: return_value
  class(object), intent(in) :: obj_to_call
  class(tuple), intent(in):: args

  integer(kind=C_INT) :: ierror
  type(dict) :: kwargs

  ierror = dict_create(kwargs)
  if (ierror == 0) then
    ierror = call_py_object(return_value, obj_to_call, args, kwargs)
    call kwargs%destroy
  endif
end function

!> Python equivalent: return_value = obj_to_call()
function call_py_object_noargs(return_value, obj_to_call) result(ierror)
  type(object), intent(out) :: return_value
  class(object), intent(in) :: obj_to_call

  integer(kind=C_INT) :: ierror
  type(tuple) :: args

  ierror = tuple_create(args, 0)
  if (ierror == 0) then
    ierror = call_py_object_nokwargs(return_value, obj_to_call, args)
    call args%destroy
  endif
end function

!> Python equivalent: return_value = obj_to_call(**kwargs)
function call_py_object_only_kwargs(return_value, obj_to_call, kwargs) result(ierror)
  type(object), intent(out) :: return_value
  class(object), intent(in) :: obj_to_call
  class(dict), intent(in) :: kwargs

  integer(kind=C_INT) :: ierror
  type(tuple) :: args

  ierror = tuple_create(args, 0)
  if (ierror == 0) then
    ierror = call_py_object(return_value, obj_to_call, args, kwargs)
    call args%destroy
  endif
end function

!> Python equivalent: obj.attr_name(*args, **kwargs)
function call_py_noret_attribute(obj, attr_name, args, kwargs) result(ierror)
  class(object), intent(in) :: obj
  character(kind=C_CHAR, len=*), intent(in) :: attr_name
  class(tuple), intent(in), optional :: args
  class(dict), intent(in), optional :: kwargs

  integer(kind=C_INT) :: ierror
  type(object) :: return_value
  
  if (present(kwargs) .and. present(args)) then
    ierror = call_py(return_value, obj, attr_name, args, kwargs)
  elseif (present(args)) then
    ierror = call_py(return_value, obj, attr_name, args)
  elseif (present(kwargs)) then
    ierror = call_py(return_value, obj, attr_name, kwargs=kwargs)
  else
    ierror = call_py(return_value, obj, attr_name)
  endif

  call return_value%destroy    

end function

!> Python equivalent: obj.attr_name(*args, **kwargs)
function call_py_noret_object(obj_to_call, args, kwargs) result(ierror)
  class(object), intent(in) :: obj_to_call
  class(tuple), intent(in), optional :: args
  class(dict), intent(in), optional :: kwargs

  integer(kind=C_INT) :: ierror
  type(object) :: return_value
  
  if (present(kwargs) .and. present(args)) then
    ierror = call_py(return_value, obj_to_call, args, kwargs)
  elseif (present(args)) then
    ierror = call_py(return_value, obj_to_call, args)
  elseif (present(kwargs)) then
    ierror = call_py(return_value, obj_to_call, kwargs=kwargs)
  else
    ierror = call_py(return_value, obj_to_call)
  endif

  call return_value%destroy    
end function

!-----------------------------------------------------------------------------------------------------
! Numpy ndarray support

#:for NDIM in range(1, NDARRAY_MAX_DIMENSION + 1)
#:set DIM_SPECIFIER = ",".join((":",) * NDIM)
#:for TYPE_NAME, FORTRAN_TYPE, FORMATSTR, ITEMSIZE, DTYPE in &
  & (("int32", "integer(kind=int32)", "i", 4, "int32"), &
  &  ("int64", "integer(kind=int64)", "l", 8, "int64"), &
  &  ("real32", "real(kind=real32)", "f", 4, "float32"), &
  &  ("real64", "real(kind=real64)", "d", 8, "float64"), &
  &  ("complex_real32", "complex(kind=real32)", "Zf", 8, "complex64"), &
  &  ("complex_real64", "complex(kind=real64)", "Zd", 16, "complex128"))
function ndarray_create_nocopy_${TYPE_NAME}$_${NDIM}$d(res, array) result(ierror)
  !> The resulting ndarray (in Fortran storage order).
  type(ndarray), intent(out) :: res
  !> The Fortran array to wrap as ndarray. NO copy is made. Changes to the ndarray affect the Fortran array and
  !> vice versa. MUST be a contiguous array (this is not checked).
  ! Note: can not use the F2008 CONTIGUOUS attribute here, because a 
  ! temporary copy of array could be created with limited lifetime.
  ${FORTRAN_TYPE}$, dimension(${DIM_SPECIFIER}$), target, intent(in) :: array
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror
  
  integer, parameter :: NDIM = ${NDIM}$
  integer(kind=PY_SSIZE_T_KIND), parameter :: ITEMSIZE = ${ITEMSIZE}$_PY_SSIZE_T_KIND

#ifndef PYTHON2  
  ierror = ndarray_create_nocopy_helper(res, c_loc(array), shape(array, kind=PY_SSIZE_T_KIND), NDIM, ITEMSIZE, "${FORMATSTR}$" // C_NULL_CHAR)
#else  
  ierror = ndarray_create_nocopy_helper_py2(res, c_loc(array), shape(array, kind=PY_SSIZE_T_KIND), NDIM, ITEMSIZE, "${DTYPE}$")
#endif

end function

function ndarray_create_${TYPE_NAME}$_${NDIM}$d(res, array) result(ierror)
  !> The resulting ndarray (in Fortran storage order).
  type(ndarray), intent(out) :: res
  !> Create a new ndarray with a copy of the data given in 'array'
  ${FORTRAN_TYPE}$, dimension(${DIM_SPECIFIER}$), intent(in) :: array
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror
  
  ${FORTRAN_TYPE}$, dimension(${DIM_SPECIFIER}$), pointer :: ptr
  
  ierror = ndarray_create_empty(res, shape(array, kind=PY_SSIZE_T_KIND), "${DTYPE}$")
  if (ierror /= 0_C_INT) return
  ierror = res%get_data(ptr)
  if (ierror /= 0_C_INT) then
    call res%destroy
    res%py_object = C_NULL_PTR
    return
  endif
  ptr = array
end function

!> Get pointer to data of numpy array
!> 
!> Raises BufferError, if array is not contiguous (does not have the required Fortran or C storage order)
!> Raises TypeError, if Fortran pointer datatype is not compatible with numpy datatype.
function get_data_${TYPE_NAME}$_${NDIM}$d(self, ptr, order) result(ierror)
  class(ndarray), intent(in) :: self
  !> Pointer to the numerical data of the Fortran array.
  ${FORTRAN_TYPE}$, dimension(${DIM_SPECIFIER}$), pointer, intent(out) :: ptr
  !> Only retrieve data, when ndarray has certain order.
  !>
  !> If 'F' (default), only retrieve the data when the ndarray has Fortran storage order.
  !> If 'C', only retrieve the data when the ndarray has C storage order.
  !> ATTENTION: The data, the pointer points to, then will be the transpose of the array.
  !> If 'A' accept Fortran or C order. If C, the data will be transposed.
  character(kind=C_CHAR), optional, intent(in) :: order
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror
  
  character(kind=C_CHAR) :: the_order
  type(c_ptr) :: raw_ptr
  integer, parameter :: NDIM = ${NDIM}$
  integer(kind=PY_SSIZE_T_KIND), dimension(NDIM) :: shape_info

  if (.not. present(order)) then
    the_order = 'F'
  else
    the_order = order
  endif
  
  nullify(ptr)  
  ierror = get_data_helper(self, raw_ptr, shape_info, NDIM, "${FORMATSTR}$" // C_NULL_CHAR, the_order)

  if (ierror == 0_C_INT) then
    call c_f_pointer(raw_ptr, ptr, shape=shape_info)
    if (.not. associated(ptr)) then
      ierror = EXCEPTION_ERROR
      call raise_exception(RuntimeError, "forpy: Could not determine shape of ndarray")
    endif
  endif
end function

#:endfor
#:endfor

#ifndef PYTHON2
function ndarray_create_nocopy_helper(res, array_c_loc, array_shape, ndim, itemsize, format_c_string) result(ierror)
  type(ndarray), intent(inout) :: res
  type(c_ptr), intent(in) :: array_c_loc
  integer, intent(in) :: ndim
  integer(kind=PY_SSIZE_T_KIND), target, dimension(ndim), intent(in) :: array_shape
  integer(kind=PY_SSIZE_T_KIND) :: itemsize
  character(kind=C_CHAR, len=*), target, intent(in) :: format_c_string  
  integer(kind=C_INT) :: ierror

  type(Py_buffer) :: buffer
  integer(kind=PY_SSIZE_T_KIND), target, dimension(ndim) :: strides
  integer(kind=PY_SSIZE_T_KIND) :: length
  type(c_ptr) :: mem_view
  type(c_ptr) :: args
  integer :: ii

  !TODO: check if numpy was successfully imported

  ierror = 0_C_INT
  res%py_object = C_NULL_PTR
  
  length = 1
  do ii = 1, ndim
    length = length * array_shape(ii)
  enddo

  ! calculate the strides assuming Fortran-order
  call PyBuffer_FillContiguousStrides(int(ndim, kind=C_INT), c_loc(array_shape), c_loc(strides), itemsize, 'F')

  buffer%buf = array_c_loc
  buffer%obj = C_NULL_PTR
  buffer%len = length * ITEMSIZE
  buffer%itemsize = itemsize
  buffer%readonly = 0_C_INT
  buffer%ndim = int(ndim, C_INT)
  buffer%format = c_loc(format_c_string)
  buffer%shape = c_loc(array_shape)
  buffer%strides = c_loc(strides)
  buffer%suboffsets = C_NULL_PTR
#ifdef PYTHON2
  buffer%smalltable = 0_PY_SSIZE_T_KIND
#endif
  buffer%internal = C_NULL_PTR

  mem_view = PyMemoryView_FromBuffer(buffer)
  if (.not. c_associated(mem_view)) then
    ierror = -1_C_INT
    return
  endif

  args = PyTuple_New(1_PY_SSIZE_T_KIND)
  if (c_associated(args)) then
    ierror = PyTuple_SetItem(args, 0_PY_SSIZE_T_KIND, mem_view) ! steals reference to mem_view even if it fails

    if (ierror /= 0_C_INT) then
      call Py_Decref(args)
      return
    endif
    
    res%py_object = PyObject_Call(global_numpy_asarray_method, args, C_NULL_PTR)
    call Py_Decref(args)

    if (.not. c_associated(res%py_object)) then
      ierror = -1_C_INT
    endif
    
  else ! .not. c_associated(args)
    call Py_Decref(mem_view)
    ierror = -1_C_INT
  endif

end function
#endif

#ifdef PYTHON2
! Python 2 array wrapper creation using old-style, py2-only buffer object + np.frombuffer.
! In principle with Py 2.7 it would be possible to use the same code as 
! in the Py 3 case, but the memoryview + np.asarray
! approach is somewhat buggy in Py 2 and one reference is lost 
function ndarray_create_nocopy_helper_py2(res, array_c_loc, array_shape, ndim, itemsize, dtype) result(ierror)
  type(ndarray), intent(inout) :: res
  type(c_ptr), intent(in) :: array_c_loc
  integer, intent(in) :: ndim
  integer(kind=PY_SSIZE_T_KIND), target, dimension(ndim), intent(in) :: array_shape
  integer(kind=PY_SSIZE_T_KIND) :: itemsize
  character(kind=C_CHAR, len=*), target, intent(in) :: dtype 
  integer(kind=C_INT) :: ierror

  integer(kind=PY_SSIZE_T_KIND) :: length
  type(c_ptr) :: buffer_obj
  type(module_py) :: numpy
  type(tuple) :: args
  type(object) :: retval
  type(object) :: buffer
  type(ndarray) :: reshaped_array
  integer :: ii

  ierror = -1_C_INT
  res%py_object = C_NULL_PTR
  
  length = 1
  do ii = 1, ndim
    length = length * array_shape(ii)
  enddo

  buffer_obj = PyBuffer_FromReadWriteMemory(array_c_loc, length*itemsize)
  if (.not. c_associated(buffer_obj)) then
    return
  endif
  
  buffer%py_object = buffer_obj
  
  ierror = tuple_create(args, 2_PY_SSIZE_T_KIND)
  if (ierror /= 0_C_INT) then
    call buffer%destroy
    return
  endif
  
  ierror = args%setitem(0_PY_SSIZE_T_KIND, buffer)
  if (ierror /= 0_C_INT) then
    call args%destroy
    call buffer%destroy
    return
  endif
  
  ierror = args%setitem(1_PY_SSIZE_T_KIND, dtype)
  if (ierror /= 0_C_INT) then
    call args%destroy
    call buffer%destroy
    return
  endif 
  
  numpy%py_object = global_numpy_mod
  ierror = call_py(retval, numpy, "frombuffer", args)
  call args%destroy
  call buffer%destroy
  
  if (ierror == 0_C_INT) then
    res%py_object = retval%py_object
  else
    call retval%destroy
    return
  endif
  
  if (ndim > 1) then
    ierror = ndarray_reshape_helper(reshaped_array, res, array_shape, 'F')
    call res%destroy
    
    if (ierror == 0_C_INT) then
      res%py_object = reshaped_array%py_object
    else
      res%py_object = C_NULL_PTR
    endif
  endif
end function

function ndarray_reshape_helper(reshaped_array, array, new_shape, order) result(ierror)
  type(ndarray), intent(out) :: reshaped_array
  class(ndarray), intent(in) :: array
  integer(kind=PY_SSIZE_T_KIND), dimension(:), intent(in) :: new_shape
  character(kind=C_CHAR), intent(in) :: order
  integer(kind=C_INT) :: ierror
  
  type(tuple) :: args
  type(dict) :: kwargs
  type(tuple) :: new_shape_tuple
  type(object) :: retval
  
  reshaped_array%py_object = C_NULL_PTR
  
  ierror = tuple_from_array(new_shape_tuple, new_shape)
  if (ierror /= 0_C_INT) then
    return
  endif
  
  ierror = tuple_create(args, 1_PY_SSIZE_T_KIND)
  if (ierror /= 0_C_INT) then
    call new_shape_tuple%destroy
    return
  endif
  
  ierror = args%setitem(0_PY_SSIZE_T_KIND, new_shape_tuple)
  if (ierror /= 0_C_INT) then
    call args%destroy
    call new_shape_tuple%destroy
    return
  endif
  
  ierror = dict_create(kwargs)
  if (ierror /= 0_C_INT) then
    call args%destroy
    call new_shape_tuple%destroy
    return
  endif
  
  ierror = kwargs%setitem("order", order)
  if (ierror /= 0_C_INT) then
    call kwargs%destroy
    call args%destroy
    call new_shape_tuple%destroy
    return
  endif   
  
  ierror = call_py(retval, array, "reshape", args, kwargs)
  if (ierror == 0_C_INT) then
    ierror = cast(reshaped_array, retval)
    call retval%destroy
  endif
  
  call kwargs%destroy
  call args%destroy
  call new_shape_tuple%destroy 
end function
#endif

!> Get pointer to data of numpy array
function get_data_helper(self, raw_ptr, shape_info, ndim, format_c_string, order) result(ierror)
  class(ndarray), intent(in) :: self
  type(c_ptr), intent(out) :: raw_ptr
  integer, intent(in) :: ndim  
  integer(kind=PY_SSIZE_T_KIND), dimension(ndim), intent(out) :: shape_info
  character(kind=C_CHAR, len=*), target, intent(in) :: format_c_string
  character(kind=C_CHAR), intent(in) :: order
  
  integer(kind=C_INT) :: ierror, flag
  type(Py_buffer) :: buffer
  integer(kind=PY_SSIZE_T_KIND), dimension(:), pointer :: shape_ptr
  integer :: shape_info_shape(1)
  character(kind=C_CHAR) :: detected_order
  character(kind=C_CHAR,len=60) :: error_message

  ! order can have values 'C', 'F' or 'A'
  if (index('CFA', order) == 0) then
    ierror = EXCEPTION_ERROR
    call raise_exception(ValueError, "ndarray%get_data: order parameter must be 'F', 'C' or 'A'")
    return
  endif

  shape_info_shape(1) = ndim

  ! raises BufferError exception if array is not contiguous, Python 2: ValueError
  ierror = PyObject_GetBuffer(self%py_object, buffer, 156_C_INT) !flags (PyBUF_FORMAT | PyBUF_ANY_CONTIGUOUS) - we need the format info and PyBUF_FORMAT alone gives error
  
  if (ierror /= 0) then
    if (exception_matches(BufferError) .or. exception_matches(ValueError)) then ! make error message more informative
      call err_clear
      call raise_exception(BufferError, "forpy: ndarray with non-contiguous data. Fortran or C-order needed: try to copy array")
    endif
    return
  endif

  detected_order = 'N'
  flag = PyBuffer_IsContiguous(buffer, 'F')
  if (flag == 1_C_INT) then
    detected_order = 'F'
  else
    flag = PyBuffer_IsContiguous(buffer, 'C')
    if (flag == 1_C_INT) then
      detected_order = 'C'
    endif
  endif
  
  if ((detected_order == 'N') .or. (ndim > 1 .and. order /= 'A' .and. order /= detected_order)) then
    ierror = EXCEPTION_ERROR
    if (order=='F') then
      error_message = "forpy: expected Fortran-ordered array"
    elseif (order=='C') then
      error_message = "forpy: expected C-ordered array"
    else
      error_message = "forpy: expected contiguous array"
    endif
    call PyBuffer_Release(buffer)
    call raise_exception(BufferError, error_message)
    return
  endif

  if (buffer%ndim /= ndim) then
    ierror = EXCEPTION_ERROR
    write(error_message,fmt="('forpy: expected array of rank ',I1,', got array of rank ',I1)") ndim, buffer%ndim
    call PyBuffer_Release(buffer)
    call raise_exception(TypeError, error_message)
    return
  endif

  !get shape info
  call c_f_pointer(buffer%shape, shape_ptr, shape=SHAPE_INFO_SHAPE)

  !check if correct format
  if (associated(shape_ptr)) then
    if (get_data_helper_check_dtype(buffer%format, format_c_string) /= 0) then
      ierror = EXCEPTION_ERROR
      call PyBuffer_Release(buffer)
      call raise_exception(TypeError, "forpy: ndarray%get_data - datatype of data pointer is incompatible with ndarray")
      return
    endif
  else
    ierror = EXCEPTION_ERROR
    call PyBuffer_Release(buffer)
    call raise_exception(RuntimeError, "forpy: Could not determine shape of ndarray")
    return
  endif

  raw_ptr = buffer%buf

  call get_shape_info_helper(shape_info, shape_ptr, detected_order)
  call PyBuffer_Release(buffer)

end function

! returns 0 if dtype matches fortran type, non-zero if not
function get_data_helper_check_dtype(buffer_format, format_c_string) result(flag)
  type(c_ptr), intent(in) :: buffer_format
  character(kind=C_CHAR, len=*), target, intent(in) :: format_c_string
  
  character(kind=C_CHAR, len=2), target :: format_code
  integer(kind=C_INT) :: flag
  
  flag = 1_C_INT
      
  ! the Python buffer format codes corresponding to int32 and int64 are systems dependent... 
   
  if (format_c_string == "i" // C_NULL_CHAR) then  ! buffer type compatible with int32 requested
    if (int32 == C_INT) then
      format_code = "i" // C_NULL_CHAR
      flag = strcmp(buffer_format, c_loc(format_code))
    endif
    if (flag /= 0) then
      if (int32 == C_LONG) then
        format_code = "l" // C_NULL_CHAR
        flag = strcmp(buffer_format, c_loc(format_code))
      endif
    endif
    return
  endif
  
  if (format_c_string == "l" // C_NULL_CHAR) then  ! buffer type compatible with int64 requested
    if (int64 == C_LONG) then
      format_code = "l" // C_NULL_CHAR
      flag = strcmp(buffer_format, c_loc(format_code))
    endif
    if (flag /= 0) then
      if (int64 == C_LONG_LONG) then
        format_code = "q" // C_NULL_CHAR
        flag = strcmp(buffer_format, c_loc(format_code))
      endif
    endif
    if (flag /= 0) then
      if (int64 == C_INT) then
        format_code = "i" // C_NULL_CHAR
        flag = strcmp(buffer_format, c_loc(format_code))
      endif
    endif
    return
  endif
  
  ! this handles all the non-integer cases    
  flag = strcmp(buffer_format, c_loc(format_c_string))
end function

subroutine get_shape_info_helper(shape_info, shape_ptr, order)
  integer(kind=PY_SSIZE_T_KIND), dimension(:), intent(out) :: shape_info
  integer(kind=PY_SSIZE_T_KIND), dimension(:), intent(in) :: shape_ptr
  character(kind=C_CHAR), intent(in) :: order
  
  integer ii, length
  
  if (order == 'F') then
    shape_info = shape_ptr
  elseif (order == 'C') then ! C-order: reverse shape information ("transpose")
    length = size(shape_info)
    do ii = 1, length
      shape_info(ii) = shape_ptr(length-ii+1)
    enddo
  endif
end subroutine

!> Return transpose of a ndarray.
function ndarray_transpose(self, transposed_array) result(ierror)
  class(ndarray), intent(in) :: self
  type(ndarray), intent(out) :: transposed_array
  integer(kind=C_INT) :: ierror
  
  type(object) :: retval
  
  ierror = call_py(retval, self, "transpose")
  if (ierror == 0_C_INT) then
    ierror = cast(transposed_array, retval)
    call retval%destroy
  endif
end function

!> Returns copy of a ndarray
!>
!> order (optional) can be 'F', 'C', 'A' or 'K' 
!> (default is 'F' - in numpy it is 'C')
function ndarray_copy(self, array_copy, order) result(ierror)
  class(ndarray), intent(in) :: self
  type(ndarray), intent(out) :: array_copy
  character(kind=C_CHAR), intent(in), optional :: order
  integer(kind=C_INT) :: ierror
  
  character(kind=C_CHAR) :: the_order
  type(object) :: retval
  type(tuple) :: args
  
  if (.not. present(order)) then
    the_order = 'F'
  else
    the_order = order
  endif
  
  ierror = tuple_create(args, 1_PY_SSIZE_T_KIND)
  if (ierror /= 0_C_INT) then
    return
  endif
    
  ierror = args%setitem(0_PY_SSIZE_T_KIND, the_order)
  if (ierror == 0_C_INT) then
    ierror = call_py(retval, self, "copy", args)
  endif

  call args%destroy
  
  if (ierror == 0_C_INT) then
    ierror = cast(array_copy, retval)
    call retval%destroy
  endif
end function

!> Checks if data of ndarray has a specific storage-order.
!>
!> order can be 'F' (Fortran-order), 'C' (C-order), 'A' (Fortran- or C-order)
function ndarray_is_ordered(self, order) result(is_ordered)
  class(ndarray), intent(in) :: self
  character(kind=C_CHAR), intent(in) :: order
  logical :: is_ordered
  
  type(object) :: retval, flags
  integer(kind=C_INT) :: ierror
  logical :: c_ordered, fortran_ordered, check_c, check_f
  
  is_ordered = .false.
  c_ordered = .false.
  fortran_ordered = .false.
  
  if (have_exception()) return
  
  ierror = self%getattribute(flags, "flags")
  if (ierror /= 0_C_INT) then
    call err_clear
    return
  endif
 
  check_f = (order == 'F') .or. (order == 'A') 

  if (check_f) then
    ierror = flags%getattribute(retval, "f_contiguous")
    if (ierror /= 0_C_INT) then
      call flags%destroy
      call err_clear
      return
    endif
    ierror = cast(fortran_ordered, retval)
    call retval%destroy
    if (ierror /= 0_C_INT) then
      call flags%destroy
      call err_clear
      return
    endif
  endif
  
  check_c = (order == 'C') .or. (order == 'A' .and. .not. fortran_ordered)
  
  if (check_c) then
    ierror = flags%getattribute(retval, "c_contiguous")
    if (ierror /= 0_C_INT) then
      call flags%destroy
      call err_clear
      return
    endif
    ierror = cast(c_ordered, retval)
    call retval%destroy
    if (ierror /= 0_C_INT) then
      call flags%destroy
      call err_clear
      return
    endif
  endif
  
  call flags%destroy
  is_ordered = fortran_ordered .or. c_ordered
  
end function

!> Returns type string of ndarray.
!>
!> corresponds to Python's ndarray.dtype.name property
function ndarray_get_dtype_name(self, dtype_name) result(ierror)
  class(ndarray), intent(in) :: self
  character(kind=C_CHAR, len=:), allocatable, intent(out) :: dtype_name
  integer(kind=C_INT) :: ierror
  
  type(object) :: dtype, dname
  
  ierror = self%getattribute(dtype, "dtype")
  if (ierror /= 0_C_INT) then
    return
  endif
  
  ierror = dtype%getattribute(dname, "name")
  if (ierror /= 0_C_INT) then
    call dtype%destroy
    return
  endif
  
  ierror = cast(dtype_name, dname)
  call dtype%destroy
  call dname%destroy
end function

#:for TYPE in ("int32", "int64")
!> Returns dimensionality of ndarray (ndarray.ndim)
function ndarray_ndim_${TYPE}$(self, ndim) result(ierror)
  class(ndarray), intent(in) :: self
  !> Output: dimensionality of array.
  integer(kind=${TYPE}$), intent(out) :: ndim
  integer(kind=C_INT) :: ierror
  
  type(object) :: ndim_obj
  
  ierror = self%getattribute(ndim_obj, "ndim")
  if (ierror /= 0_C_INT) then
    return
  endif
  
  ierror = cast(ndim, ndim_obj)
  call ndim_obj%destroy
end function

#:endfor

!---Routines for creating ndarrays with Python managed storage ---------
!   numpy.empty, numpy.ones, numpy.zeros

#:for CREATOR_FUNCTION in ("empty", "zeros", "ones")
#:for TYPE in ("int32", "int64")
function ndarray_create_${CREATOR_FUNCTION}$_a${TYPE}$(array, a_shape, dtype, order) result(ierror)
  !> The resulting ndarray.
  type(ndarray), intent(out) :: array
  !> Shape of ndarray to create.
  integer(kind=${TYPE}$), dimension(:), intent(in) :: a_shape
  !> numpy.dtype of ndarray (default: 'float')
  character(kind=C_CHAR, len=*), intent(in), optional :: dtype
  !> Storage order: 'F' (Fortran) or 'C' (default: 'F')
  character(kind=C_CHAR), intent(in), optional :: order
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror
  
  if (present(dtype)) then
    if (present(order)) then
      ierror = ndarray_create_special_impl_${TYPE}$(array, "${CREATOR_FUNCTION}$", a_shape, dtype, order)
    else
      ! Fortran order as default, in contrast to numpy
      ierror = ndarray_create_special_impl_${TYPE}$(array, "${CREATOR_FUNCTION}$", a_shape, dtype, "F") 
    endif
  else
    if (present(order)) then
      ierror = ndarray_create_special_impl_${TYPE}$(array, "${CREATOR_FUNCTION}$", a_shape, "", order)
    else
      ierror = ndarray_create_special_impl_${TYPE}$(array, "${CREATOR_FUNCTION}$", a_shape, "", "F") 
    endif    
  endif
end function

#:endfor

#:for TYPE in ("int32", "int64")
function ndarray_create_${CREATOR_FUNCTION}$_${TYPE}$(array, length, dtype, order) result(ierror)
  !> The resulting one dimensional ndarray.
  type(ndarray), intent(out) :: array
  !> Number of elements in ndarray
  integer(kind=${TYPE}$), intent(in) :: length
  !> numpy.dtype of ndarray (default: 'float')
  character(kind=C_CHAR, len=*), intent(in), optional :: dtype
  !> Storage order: 'F' (Fortran) or 'C' (default: 'F'). In case of 1D array not relevant.
  character(kind=C_CHAR), intent(in), optional :: order
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror
  
  integer(kind=${TYPE}$) :: a_shape(1)
  a_shape(1) = length
  
  if (present(dtype)) then
    if (present(order)) then
      ierror = ndarray_create_special_impl_${TYPE}$(array, "${CREATOR_FUNCTION}$", a_shape, dtype, order)
    else
      ! Fortran order as default, in contrast to numpy
      ierror = ndarray_create_special_impl_${TYPE}$(array, "${CREATOR_FUNCTION}$", a_shape, dtype, "F") 
    endif
  else
    if (present(order)) then
      ierror = ndarray_create_special_impl_${TYPE}$(array, "${CREATOR_FUNCTION}$", a_shape, "", order)
    else
      ierror = ndarray_create_special_impl_${TYPE}$(array, "${CREATOR_FUNCTION}$", a_shape, "", "F") 
    endif    
  endif
end function

#:endfor
#:endfor

#:for TYPE in ("int32", "int64")
function ndarray_create_special_impl_${TYPE}$(array, creator_function, a_shape, dtype, order) result(ierror)
  type(ndarray), intent(out) :: array
  character(kind=C_CHAR, len=*), intent(in) :: creator_function
  integer(kind=${TYPE}$), dimension(:), intent(in) :: a_shape
  character(kind=C_CHAR, len=*), intent(in) :: dtype
  character(kind=C_CHAR), intent(in) :: order
  integer(kind=C_INT) :: ierror
  
  type(dict) :: kwargs
  
  ierror = dict_create(kwargs)
  if (ierror /= 0_C_INT) return
  
  if (len(dtype) > 0) then
    ierror = kwargs%setitem("dtype", dtype)
    if (ierror /= 0_C_INT) then
      call kwargs%destroy
      return
    endif
  endif
  
  ierror = kwargs%setitem("order", order)
 
  if (ierror == 0_C_INT) then
    ierror = ndarray_create_special_helper_${TYPE}$(array, creator_function, a_shape, kwargs)
  endif
  
  call kwargs%destroy
end function

function ndarray_create_special_getargs_${TYPE}$(args, a_shape) result(ierror)
  type(tuple), intent(out) :: args
  integer(kind=${TYPE}$), dimension(:), intent(in) :: a_shape
  integer(kind=C_INT) :: ierror
  
  type(tuple) :: shape_tuple
  
  ierror = tuple_from_array_${TYPE}$(shape_tuple, a_shape)
  if (ierror /= 0_C_INT) return
  
  ierror = tuple_create(args, 1_PY_SSIZE_T_KIND)
  if (ierror /= 0_C_INT) then
    call shape_tuple%destroy
    return
  endif
  
  ierror = args%setitem(0_PY_SSIZE_T_KIND, shape_tuple)
  call shape_tuple%destroy
end function

function ndarray_create_special_helper_${TYPE}$(array, creator_function, a_shape, kwargs) result(ierror)
  type(ndarray), intent(out) :: array
  character(kind=C_CHAR, len=*), intent(in) :: creator_function
  integer(kind=${TYPE}$), dimension(:), intent(in) :: a_shape
  type(dict), intent(in) :: kwargs
  integer(kind=C_INT) :: ierror
  
  type(tuple) :: args
  type(object) :: retval
  type(module_py) :: numpy_mod
  
  ierror = ndarray_create_special_getargs_${TYPE}$(args, a_shape)
  if (ierror /= 0_C_INT) return

  numpy_mod%py_object = global_numpy_mod 
  ierror = call_py(retval, numpy_mod, creator_function, args, kwargs)
  
  if (ierror == 0_C_INT) then  
    ierror = cast(array, retval)
    call retval%destroy
  endif
  
  call args%destroy

end function

!> Helper function: create tuple from integer array
function tuple_from_array_${TYPE}$(tu, arr) result(ierror)
  type(tuple), intent(out) :: tu
  integer(kind=${TYPE}$), dimension(:), intent(in) :: arr
  integer(kind=C_INT) :: ierror
  
  integer(kind=PY_SSIZE_T_KIND) :: ii, ndim
  ndim = size(arr, kind=PY_SSIZE_T_KIND)
  
  ierror = tuple_create(tu, ndim)
  if (ierror /= 0_C_INT) return
  
  do ii = 1, ndim
    ierror = tu%setitem(ii-1, arr(ii))
    if (ierror /= 0_C_INT) then
      call tu%destroy
      return
    endif
  enddo
end function

#:endfor

!------------------ Routines for wrapping values into Python objects ("boxing") ----------------------
#ifndef PYTHON2
function box_value_int32_as_long(obj, the_value) result(ierror)
  type(c_ptr), intent(out) :: obj
  integer(kind=int32), intent(in) :: the_value
  integer(kind=C_INT) :: ierror

  integer(kind=C_LONG_LONG) :: tmp
  ierror = 0_C_INT

  tmp = int(the_value, C_LONG_LONG)

  obj = PyLong_FromLongLong(tmp)

  if (.not. c_associated(obj)) then
    ierror = EXCEPTION_ERROR
  endif

end function
#endif

function box_value_int64_as_long(obj, the_value) result(ierror)
  type(c_ptr), intent(out) :: obj
  integer(kind=int64), intent(in) :: the_value
  integer(kind=C_INT) :: ierror

  integer(kind=C_LONG_LONG) :: tmp
  ierror = 0_C_INT

  tmp = int(the_value, C_LONG_LONG)

  obj = PyLong_FromLongLong(tmp)

  if (.not. c_associated(obj)) then
    ierror = EXCEPTION_ERROR
  endif

end function

#ifdef PYTHON2
function box_value_int32(obj, the_value) result(ierror)
  type(c_ptr), intent(out) :: obj
  integer(kind=int32), intent(in) :: the_value
  integer(kind=C_INT) :: ierror

  integer(kind=C_LONG) :: tmp
  ierror = 0_C_INT

  tmp = int(the_value, C_LONG)

  obj = PyInt_FromLong(tmp)

  if (.not. c_associated(obj)) then
    ierror = EXCEPTION_ERROR
  endif

end function

function box_value_int64(obj, the_value) result(ierror)
  type(c_ptr), intent(out) :: obj
  integer(kind=int64), intent(in) :: the_value
  integer(kind=C_INT) :: ierror

  integer(kind=C_LONG) :: tmp
  ierror = 0_C_INT

  ! this is the case for Windows and 32-bit Linux
  if (huge(the_value) > huge(tmp)) then
    if (the_value > huge(tmp) .or. the_value < -huge(tmp)) then
      if (the_value /= (-huge(tmp) - 1)) then
        !overflow: must use 'long'-type
        ierror = box_value_int64_as_long(obj, the_value)
        return
      endif
    endif  
  endif

  tmp = int(the_value, C_LONG)

  obj = PyInt_FromLong(tmp)

  if (.not. c_associated(obj)) then
    ierror = EXCEPTION_ERROR
  endif

end function
#endif

function box_value_real32(obj, the_value) result(ierror)
  type(c_ptr), intent(out) :: obj
  real(kind=real32), intent(in) :: the_value
  integer(kind=C_INT) :: ierror

  real(kind=C_DOUBLE) :: tmp

  ierror = 0_C_INT

  tmp = real(the_value, C_DOUBLE)

  obj = PyFloat_FromDouble(tmp)

  if (.not. c_associated(obj)) then
    ierror = EXCEPTION_ERROR
  endif

end function

function box_value_real64(obj, the_value) result(ierror)
  type(c_ptr), intent(out) :: obj
  real(kind=real64), intent(in) :: the_value
  integer(kind=C_INT) :: ierror

  real(kind=C_DOUBLE) :: tmp

  ierror = 0_C_INT

  tmp = real(the_value, C_DOUBLE)

  obj = PyFloat_FromDouble(tmp)

  if (.not. c_associated(obj)) then
    ierror = EXCEPTION_ERROR
  endif

end function

#:for TYPE in ("real32", "real64")
function box_value_complex_${TYPE}$(obj, the_value) result(ierror)
  type(c_ptr), intent(out) :: obj
  complex(kind=${TYPE}$), intent(in) :: the_value
  integer(kind=C_INT) :: ierror

  ierror = 0_C_INT

  obj = PyComplex_FromDoubles(real(the_value, C_DOUBLE), real(aimag(the_value), C_DOUBLE))

  if (.not. c_associated(obj)) then
    ierror = EXCEPTION_ERROR
  endif

end function
#:endfor

#:for TYPENAME, TYPE, LEN_FUNCTION in (("chars", "character(kind=C_CHAR, len=*)", "len"), ("char_1d", "character(kind=C_CHAR), dimension(:)", "size"))
function box_value_${TYPENAME}$(obj, the_value) result(ierror)
  type(c_ptr), intent(out) :: obj
  ${TYPE}$, intent(in) :: the_value
  integer(kind=C_INT) :: ierror

#ifdef PYTHON2
  ierror = box_value_${TYPENAME}$_as_bytestr(obj, the_value)
#else
  ierror = box_value_${TYPENAME}$_as_unicodestr(obj, the_value)
#endif

end function

function box_value_${TYPENAME}$_as_bytestr(obj, the_value) result(ierror)
  type(c_ptr), intent(out) :: obj
  ${TYPE}$, intent(in) :: the_value
  integer(kind=C_INT) :: ierror

  integer(kind=PY_SSIZE_T_KIND) :: length

  ierror = 0_C_INT

  length = ${LEN_FUNCTION}$(the_value)

  obj = PyBytes_FromStringAndSize(the_value, length)

  if (.not. c_associated(obj)) then
    ierror = EXCEPTION_ERROR
  endif

end function

function box_value_${TYPENAME}$_as_unicodestr(obj, the_value) result(ierror)
  type(c_ptr), intent(out) :: obj
  ${TYPE}$, intent(in) :: the_value
  integer(kind=C_INT) :: ierror

  integer(kind=PY_SSIZE_T_KIND) :: length

  ierror = 0_C_INT

  length = ${LEN_FUNCTION}$(the_value)

  obj = PyUnicode_DecodeUTF8(the_value, length, "strict" // C_NULL_CHAR)

  if (.not. c_associated(obj)) then
    ierror = EXCEPTION_ERROR
  endif

end function

#:endfor

function box_value_logical(obj, the_value) result(ierror)
  type(c_ptr), intent(out) :: obj
  logical, intent(in) :: the_value
  integer(kind=C_INT) :: ierror

  ierror = 0_C_INT

  if (the_value) then
    obj = global_Py_TrueStruct_ptr
    call Py_IncRef(obj)
  else
    obj = global_Py_FalseStruct_ptr
    call Py_IncRef(obj)
  endif

end function

!------------- Routines for unboxing -----------------------------------
#:for TYPE in ("int32", "int64")
function unbox_value_${TYPE}$(the_value, obj) result(ierror)
  integer(kind=${TYPE}$), intent(out) :: the_value
  type(c_ptr), intent(in) :: obj
  integer(kind=C_INT) :: ierror

  integer(kind=C_LONG_LONG) :: tmp
  integer :: overflow
  type(c_ptr) :: err_obj
  
  ierror = 0_C_INT
  tmp = PyLong_AsLongLongAndOverflow(obj, overflow)
  the_value = int(tmp, ${TYPE}$)
  
  if (tmp == -1_C_LONG_LONG) then
    if (overflow == 0) then
      err_obj = PyErr_Occurred()
      if (c_associated(err_obj)) then
        ierror = EXCEPTION_ERROR
        return
      endif 
    else
      ierror = EXCEPTION_ERROR
      call raise_exception(OverflowError, "int too big to convert")
      return
    endif
  endif
  
  if (huge(the_value) < huge(tmp)) then
    if (tmp > huge(the_value) .or. tmp < -huge(the_value)) then
      if (tmp /= (-huge(the_value) - 1)) then
        ierror = EXCEPTION_ERROR
        call raise_exception(OverflowError, "int too large for Fortran integer(kind=${TYPE}$)")
      endif
    endif
  endif

end function

#:endfor

#:for TYPE in ("real32", "real64")
function unbox_value_${TYPE}$(the_value, obj) result(ierror)
  real(kind=${TYPE}$), intent(out) :: the_value
  type(c_ptr), intent(in) :: obj
  integer(kind=C_INT) :: ierror

  real(kind=C_DOUBLE) :: tmp
  type(c_ptr) :: err_obj
  
  ierror = 0_C_INT
  tmp = PyFloat_AsDouble(obj)
  the_value = real(tmp, ${TYPE}$)
  
  if (tmp == -1.0_C_DOUBLE) then
$:  exception_check()
  endif

end function

#:endfor

#:for TYPE in ("real32", "real64")
function unbox_value_complex_${TYPE}$(the_value, obj) result(ierror)
  complex(kind=${TYPE}$), intent(out) :: the_value
  type(c_ptr), intent(in) :: obj
  integer(kind=C_INT) :: ierror

  type(Py_complex) :: tmp
  type(c_ptr) :: err_obj
  
  ierror = 0_C_INT
  tmp = PyComplex_AsCComplex(obj) !this handles objects with __complex__ method correctly
  
  the_value = cmplx(tmp%real_part, tmp%imag_part, kind=${TYPE}$)
  
  if (tmp%real_part == -1.0_C_DOUBLE) then
$:  exception_check()
  endif

end function

#:endfor

function unbox_value_logical(the_value, obj) result(ierror)
  logical, intent(out) :: the_value
  type(c_ptr), intent(in) :: obj
  integer(kind=C_INT) :: ierror
  
  the_value = .false.
  ierror = PyObject_IsTrue(obj)
  if (ierror /= -1_C_INT) then
    the_value = (ierror == 1_C_INT)
    ierror = 0_C_INT
  endif
end function

! unboxes WITHOUT making a copy - returns a pointer
! do not change string via pointer, since they are supposed to be
! immutable in Python
function unbox_value_char_1d(the_value, obj) result(ierror)
  character(kind=C_CHAR), pointer, dimension(:), intent(out) :: the_value
  type(c_ptr), intent(in) :: obj
  integer(kind=C_INT) :: ierror

  type(c_ptr) :: char_ptr
  integer(PY_SSIZE_T_KIND) :: length(1)
  
  logical :: obj_is_bytes
  type(object) :: dummy_obj ! just to be able to use is_bytes and is_unicode

  ierror = 0_C_INT
  dummy_obj%py_object = obj
      
  obj_is_bytes = is_bytes(dummy_obj)

  if (obj_is_bytes) then
    char_ptr = PyBytes_AsString(obj)  
  elseif (is_unicode(dummy_obj)) then
#ifndef PYTHON2
    !C-API-function not available in PY2
    char_ptr = PyUnicode_AsUTF8AndSize(obj, length(1)) 
#else
    char_ptr = C_NULL_PTR
    call raise_exception(TypeError, "forpy: cast of unicode object to character array not supported when using Python 2")
#endif
  else
    char_ptr = C_NULL_PTR
  endif
  
  if (.not. c_associated(char_ptr)) then
    ierror = EXCEPTION_ERROR
    if (.not. have_exception()) then
      call raise_exception(TypeError, "forpy: Cannot cast to character array")
    endif
    return
  endif
  
  if (obj_is_bytes) then
    length(1) = PyObject_Length(obj)
  endif
  
  if (length(1) == -1_PY_SSIZE_T_KIND) then
    ierror = EXCEPTION_ERROR
    call raise_exception(TypeError, "forpy: Cannot cast to character array")
    return
  endif
  
  ! length 0 strings also seem to work
  
  call c_f_pointer(char_ptr, the_value, length)

end function

! unboxes by making a copy
function unbox_value_chars(the_value, obj) result(ierror)
  character(kind=C_CHAR, len=:), allocatable, intent(out) :: the_value
  type(c_ptr), intent(in) :: obj
  integer(kind=C_INT) :: ierror
  
  character(kind=C_CHAR), dimension(:), pointer :: char_ptr
  
  ierror = unbox_value_char_1d(char_ptr, obj)
  
  if (ierror == 0_C_INT) then
    call char_1d_to_chars(char_ptr, the_value)
  endif
  
end function

#ifdef PYTHON2
function unbox_value_chars_py2(the_value, obj) result(ierror)

  character(kind=C_CHAR, len=:), allocatable, intent(out) :: the_value
  type(c_ptr), intent(in) :: obj
  integer(kind=C_INT) :: ierror

  type(c_ptr) :: bytes_obj
  type(object) :: dummy_obj

  dummy_obj%py_object = obj
  ierror = EXCEPTION_ERROR

  ! py2 unicode strategy: convert to Python str object first
  if (is_unicode(dummy_obj)) then
    bytes_obj = PyUnicode_AsUTF8String(obj)
    if (c_associated(bytes_obj)) then
      ierror = unbox_value_chars(the_value, bytes_obj)
      call Py_Decref(bytes_obj)
    endif
  else
    ierror = unbox_value_chars(the_value, obj)
  endif
end function
#endif

subroutine char_1d_to_chars(inp, outp)
  character(kind=C_CHAR), dimension(:), intent(in) :: inp
  character(kind=C_CHAR, len=:), allocatable, intent(inout) :: outp
  
  integer :: length, ii
  
  length = size(inp)
  
  if (allocated(outp)) then
    deallocate(outp)
  endif
  
  allocate(character(kind=C_CHAR, len=length) :: outp)
  
  do ii = 1, length
    outp(ii:ii) = inp(ii)
  enddo
  
end subroutine

!------------- Routines for (safely) casting types ---------------------
! Note: They do not transfer ownership to casted object - both input and
! output object have to be destroyed

#:for TYPE in ("list", "dict", "tuple", "NoneType", "ndarray", "str", "bytes", "unicode")
#:set OBJECT_OUT = TYPE + "_out"
#:set TEST_FUNCTION = "is_" + TYPE if TYPE != "NoneType" else "is_none"
function cast_to_${TYPE}$(${OBJECT_OUT}$, obj) result(ierror)
  type(${TYPE}$), intent(out) :: ${OBJECT_OUT}$
  class(object), intent(in) :: obj
  integer(kind=C_INT) :: ierror

  if (${TEST_FUNCTION}$(obj)) then
    ierror = 0_C_INT
    ${OBJECT_OUT}$%py_object = obj%py_object
    call Py_IncRef(obj%py_object)
  else
    ${OBJECT_OUT}$%py_object = C_NULL_PTR
    ierror = EXCEPTION_ERROR
    call raise_exception(TypeError, "forpy: Could not cast to ${TYPE}$.")
  endif
end function

#:endfor

#:for TYPE in ("list", "tuple", "str")
#:set OBJECT_OUT = TYPE + "_out"
function cast_nonstrict_to_${TYPE}$(${OBJECT_OUT}$, obj) result(ierror)
  type(${TYPE}$), intent(out) :: ${OBJECT_OUT}$
  class(object), intent(in) :: obj
  integer(kind=C_INT) :: ierror

  if (is_${TYPE}$(obj)) then
    ierror = 0_C_INT
    ${OBJECT_OUT}$%py_object = obj%py_object
    call Py_IncRef(obj%py_object)
  else
    ierror = ${TYPE}$_create(${OBJECT_OUT}$, obj)
  endif
end function

#:endfor

function cast_to_object(plain_obj, obj) result(ierror)
  type(object), intent(out) :: plain_obj
  class(object), intent(in) :: obj
  integer(kind=C_INT) :: ierror
  
  ierror = 0_C_INT
  plain_obj%py_object = obj%py_object
  call Py_IncRef(obj%py_object)
end function

! casts to scalar fortran types

#:for TYPE, TYPE_NAME, TEST_FUNCTION in SCALAR_FORTRAN_TYPE_INFO
function cast_to_${TYPE_NAME}$(out_value, obj) result(ierror)
  ${TYPE}$, intent(out) :: out_value
  class(object), intent(in) :: obj
  integer(kind=C_INT) :: ierror

  if (${TEST_FUNCTION}$(obj)) then
    ierror = unbox_value(out_value, obj%py_object)
  else
    ierror = EXCEPTION_ERROR
    call raise_exception(TypeError, "forpy: Could not cast to ${TYPE}$.")
  endif
end function

function cast_to_${TYPE_NAME}$_flex(out_value, obj, strict) result(ierror)
  ${TYPE}$, intent(out) :: out_value
  class(object), intent(in) :: obj
  logical, intent(in) :: strict
  integer(kind=C_INT) :: ierror

  if (.not. strict) then
    ierror = unbox_value(out_value, obj%py_object)
  else
    ierror = cast_to_${TYPE_NAME}$(out_value, obj)
  endif
end function

function cast_nonstrict_to_${TYPE_NAME}$(out_value, obj) result(ierror)
  ${TYPE}$, intent(out) :: out_value
  class(object), intent(in) :: obj
  integer(kind=C_INT) :: ierror
  
  ierror = cast(out_value, obj, .false.)
end function

#:endfor

! casts to/from strings
function cast_to_chars(out_value, obj) result(ierror)
  character(kind=C_CHAR, len=:), allocatable, intent(out) :: out_value
  class(object), intent(in) :: obj
  integer(kind=C_INT) :: ierror
  
  if (is_str(obj) .or. is_bytes(obj) .or. is_unicode(obj)) then
    ierror = unbox_value(out_value, obj%py_object)
  else
    ierror = EXCEPTION_ERROR
    call raise_exception(TypeError, "forpy: Could not cast to character(kind=C_CHAR, len=:).")
  endif
end function

function cast_from_chars(obj, in_value) result(ierror)
  type(object), intent(out) :: obj
  character(kind=C_CHAR, len=*), intent(in) :: in_value
  integer(kind=C_INT) :: ierror

  ierror = box_value(obj%py_object, in_value)
end function

function cast_from_char_1d(obj, in_value) result(ierror)
  type(object), intent(out) :: obj
  character(kind=C_CHAR), dimension(:), intent(in) :: in_value
  integer(kind=C_INT) :: ierror

  ierror = box_value(obj%py_object, in_value)
end function

function cast_to_char_1d(out_value, obj) result(ierror)
  character(kind=C_CHAR), dimension(:), pointer :: out_value
  class(object), intent(in) :: obj
  integer(kind=C_INT) :: ierror

  if (is_str(obj) .or. is_bytes(obj) .or. is_unicode(obj)) then
    ierror = unbox_value(out_value, obj%py_object)
  else
    ierror = EXCEPTION_ERROR
    call raise_exception(TypeError, "forpy: Could not cast to character(kind=C_CHAR), dimension(:), pointer.")
  endif
end function

function cast_nonstrict_to_chars(out_value, obj) result(ierror)
  character(kind=C_CHAR, len=:), allocatable, intent(out) :: out_value
  class(object), intent(in) :: obj
  integer(kind=C_INT) :: ierror
  
  type(c_ptr) :: str_obj
  
  if (is_str(obj) .or. is_bytes(obj) .or. is_unicode(obj)) then
    ierror = unbox_value(out_value, obj%py_object)
    return
  endif
  
  str_obj = PyObject_Str(obj%py_object)
  
  if (.not. c_associated(str_obj)) then
    ierror = EXCEPTION_ERROR
    return
  endif
  
  ierror = unbox_value(out_value, str_obj)
  call Py_DecRef(str_obj)
end function

! casting scalar Fortran types into Python objects

#:for TYPE, TYPE_NAME, _ in SCALAR_FORTRAN_TYPE_INFO
function cast_from_${TYPE_NAME}$(obj, in_value) result(ierror)
  type(object), intent(out) :: obj
  ${TYPE}$, intent(in) :: in_value
  integer(kind=C_INT) :: ierror
  
  ierror = box_value(obj%py_object, in_value)
end function

#:endfor

!===============================================================================
! Assignment with Python semantics
!===============================================================================

! Usage: call assign_py(lhs, rhs)

#:for TYPE_NAME in FORPY_TYPES
!> Equivalent to the following Python code: lhs = rhs
!>
!> do not forget to destroy lhs after usage
subroutine assign_py_${TYPE_NAME}$(lhs, rhs)
  type(${TYPE_NAME}$), intent(out) :: lhs
  class(${TYPE_NAME}$), intent(in) :: rhs
  
  lhs%py_object = rhs%py_object
  call Py_IncRef(lhs%py_object)
end subroutine

#:endfor

!===============================================================================
! Exception handling
!===============================================================================

!> Checks if a certain type of exception has occurred.
!>
!> Example: flag = exception_matches(KeyError)
!> Returns .false. if no exception has occurred.
function exception_matches(exc) result(is_match)
  class(object), intent(in) :: exc
  logical :: is_match
  
  type(c_ptr) :: err_obj
  
  err_obj = PyErr_Occurred()
  
  if (c_associated(err_obj) .and. c_associated(exc%py_object)) then
    is_match = (PyErr_GivenExceptionMatches(err_obj, exc%py_object) == 1)
    return
  endif
  
  is_match = .false.
end function

!> Clears an exception.
!>
!> No effect if no exception happened. Must be called 
!> after handling an exception, otherwise
!> future forpy/Python operations can fail in strange ways.
subroutine err_clear()
  call PyErr_Clear()
end subroutine

!> Prints and clears exception. If no exception has occurred, does nothing.
subroutine err_print()
  type(c_ptr) :: err_obj
  err_obj = PyErr_Occurred()
  ! check if there really is an error, otherwise call to PyErr_Print is fatal
  if (c_associated(err_obj)) then
    call PyErr_Print()
  endif
end subroutine

!> returns .true. if an exception has occurred
function have_exception()
  logical :: have_exception
  
  type(c_ptr) :: err_obj
  err_obj = PyErr_Occurred()
  have_exception = c_associated(err_obj)
end function

!> raises an exception
subroutine raise_exception(exc_type, message)
  !> The exception to raise.
  !>
  !> Example: call raise_exception(ValueError, "bad value")
  class(object), intent(in) :: exc_type
  character(kind=C_CHAR, len=*), intent(in) :: message
  
  call PyErr_SetString(exc_type%py_object, message // C_NULL_CHAR)
end subroutine

!=======================================================================
! Python extension development
!=======================================================================

function PythonModule_init(self, module_name, doc_string, method_table) result(module_ptr)
  class(PythonModule), intent(inout) :: self
  !> Name of the Python extension module.
  character(kind=C_CHAR, len=*), intent(in) :: module_name
  !> Doc string for the Python extension module.
  character(kind=C_CHAR, len=*), intent(in) :: doc_string
  !> Table of methods of the Python extension module.
  type(PythonMethodTable), intent(in) :: method_table
  type(c_ptr) :: module_ptr

  integer(kind=C_INT), parameter :: PYTHON_API_VERSION = 1013_C_INT !api-version is 1013 since 2006 and still is in 2018

  module_ptr = C_NULL_PTR
  self%module_ptr = C_NULL_PTR
  
  allocate(self%module_def) ! never deallocated, for reasons given in PythonMethodTable_init
  
  self%module_def = PyModuleDef(PyModuleDef_Base(1_PY_SSIZE_T_KIND, C_NULL_PTR, C_NULL_PTR, &
                                                 0_PY_SSIZE_T_KIND, C_NULL_PTR), &
                               C_NULL_PTR, C_NULL_PTR, -1_PY_SSIZE_T_KIND, C_NULL_PTR, C_NULL_PTR, &
                               C_NULL_FUNPTR, C_NULL_FUNPTR, C_NULL_FUNPTR)

  allocate(character(kind=C_CHAR,len=len(module_name)+1) :: self%module_name)
  self%module_name = module_name // C_NULL_CHAR
  allocate(character(kind=C_CHAR,len=len(doc_string)+1) :: self%doc_string)
  self%doc_string = doc_string // C_NULL_CHAR
                               
  self%module_def%m_methods = method_table%get_method_table()
  self%module_def%m_name = c_loc(self%module_name)
  self%module_def%m_doc = c_loc(self%doc_string)
  
#ifndef PYTHON2
  module_ptr = PyModule_Create2(c_loc(self%module_def), PYTHON_API_VERSION)
#else
  module_ptr = Py_InitModule4(self%module_name, self%module_def%m_methods, self%doc_string, C_NULL_PTR, PYTHON_API_VERSION)
#endif

  self%module_ptr = module_ptr
end function

!> add an object as a member to a module
function PythonModule_add_object(self, object_name, obj) result(ierror)
  class(PythonModule), intent(inout) :: self
  !> Name of the module member. It can be accessed by module_name.object_name in Python.
  character(kind=C_CHAR, len=*), intent(in) :: object_name
  !> The object to add as a member to the module.
  class(object), intent(in) :: obj
  !> Error code, 0 on success.
  integer(kind=C_INT) :: ierror
  
  call Py_IncRef(obj%py_object)  !PyModule_AddObject steals a reference
  ierror = PyModule_AddObject(self%module_ptr, object_name // C_NULL_CHAR, obj%py_object)
end function

subroutine PythonMethodTable_init(self, num_methods)
  class(PythonMethodTable), intent(inout) :: self
  !> The number of methods your Python module shall have.
  integer, intent(in) :: num_methods
  
  integer :: ii
  self%num_methods = num_methods
  self%method_count = 0
  ! These are never deallocated
  ! not a big problem, since "de-importing" modules in Python is unusual and
  ! sometimes impossible. There exist kind of a finish method, so this could be a TODO
  allocate(self%methods(num_methods+1)) !need extra space for sentinel entry
  allocate(self%strings(num_methods))
  
  do ii = 1, num_methods + 1
    ! at the end of methods array there has to be this sentinel value
    ! just to be safe, initialise complete method array with it
    self%methods(ii) = PyMethodDef(C_NULL_PTR, C_NULL_FUNPTR, 0_C_INT, C_NULL_PTR)
  enddo
end subroutine

subroutine PythonMethodTable_add_method(self, method_name, doc_string, flags, method_funptr)
  class(PythonMethodTable), intent(inout) :: self
  !> Name of the Python method.
  character(kind=C_CHAR, len=*), intent(in) :: method_name
  !> Doc string for the Python method
  character(kind=C_CHAR, len=*), intent(in) :: doc_string
  !> Controls which kind of arguments the Python method shall take.
  !>
  !> use flags=METH_VARARGS if method shall take only arguments.
  !> use flags=METH_KWARGS if method shall take only keyword args.
  !> use flags=METH_VARARGS+METH_KWARGS if method shall take both arguments and keyword args.
  !> use flags=METH_NOARGS if method shall take no arguments.
  integer(kind=C_INT), intent(in) :: flags
  !> Function pointer to the Fortran implementation of the method.
  !>
  !> Use C_FUNLOC(<Fortran function>) to get method_funptr
  !> The Fortran function must take "TYPE(c_ptr), VALUE" arguments (number depends on what arguments it takes)
  !> and have a type(c_ptr) return value.
  !> E. g. if flags=METH_VARARGS+METH_KWARGS, one needs 3 arguments
  !> (1st arg: module c_ptr, 2nd: arguments c_ptr, 3rd: kwargs c_ptr)
  !> use [[unsafe_cast_from_c_ptr]] to cast 2nd argument to a tuple
  !> and 3rd argument to a dict.
  !> The function must return a Python object type(c_ptr).
  !> Use object%get_c_ptr() to retrieve the c_ptr from a forpy object.
  type(c_funptr), intent(in) :: method_funptr
  
  integer :: ind
  type(c_ptr) :: method_name_loc, doc_string_loc
  
  if (self%method_count >= self%num_methods) then
    call raise_exception(ImportError, "forpy: Could not add method. Increase num_methods in PythonMethodTable%init")
    return
  endif
  
  ind = self%method_count + 1
  
  allocate(character(kind=C_CHAR,len=len(method_name)+1) :: self%strings(ind)%method_name)
  self%strings(ind)%method_name = method_name // C_NULL_CHAR
  
  allocate(character(kind=C_CHAR,len=len(doc_string)+1) :: self%strings(ind)%doc_string)
  self%strings(ind)%doc_string = doc_string // C_NULL_CHAR
  
  method_name_loc = c_loc(self%strings(ind)%method_name)
  doc_string_loc = c_loc(self%strings(ind)%doc_string)
  
  self%methods(ind) = PyMethodDef(method_name_loc, method_funptr, flags, doc_string_loc)
  self%method_count = self%method_count + 1
end subroutine

function PythonMethodTable_get(self) result(m)
  class(PythonMethodTable), intent(in) :: self
  type(c_ptr) :: m
  m = c_loc(self%methods)
end function

!> Creates an [[object]] from a type(c_ptr), no type checks
!>
!> use with care, use only for developing Python extensions
!> created object 'obj' has to be cleaned up by calling obj%destroy
subroutine unsafe_cast_from_c_ptr(obj, ptr)
  !> The created Python object.
  class(object), intent(out) :: obj
  !> C pointer to cast from
  type(c_ptr), intent(in) :: ptr
  
  call Py_IncRef(ptr)
  obj%py_object = ptr
end subroutine

!=======================================================================
! Tools
!=======================================================================

!> Python's print function.
function print_py(obj, kwargs) result(ierror)
  !> Object to print.
  class(object), intent(in) :: obj
  !> Optional dict of keyword arguments
  class(dict), intent(in), optional :: kwargs
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror

  type(c_ptr) :: builtin_dict, tmp
  type(object) :: print_fun
  type(tuple) :: args

  builtin_dict = PyEval_GetBuiltins() ! borrowed ref - do not decref
  if (.not. c_associated(builtin_dict)) then
    ierror = EXCEPTION_ERROR
    return
  endif
  
  tmp = PyDict_GetItemString(builtin_dict, "print" // C_NULL_CHAR) !borrowed ref
  print_fun%py_object = tmp

  ierror = tuple_create(args, 1)
  if (ierror /= 0_C_INT) return
  
  ierror = args%setitem(0, obj)
  if (ierror /= 0_C_INT) then
    call args%destroy
  endif
  
  if (present(kwargs)) then
    ierror = call_py_noret(print_fun, args, kwargs)
  else
    ierror = call_py_noret(print_fun, args)
  endif
  
  call args%destroy
  ! do not destroy print_fun: borrowed ref

end function

!> Getting the list of module search paths: sys.path
!>
!> Can be used to append additional directories, where modules shall be searched
function get_sys_path(paths) result(ierror)
  !> Output: list of module search paths
  type(list), intent(out) :: paths
  !> Error code, 0 on success  
  integer(kind=C_INT) :: ierror
  
  type(object) :: tmp
  
  tmp%py_object = PySys_GetObject("path" // C_NULL_CHAR)
  ierror = cast(paths, tmp)
  ! not destroying tmp, because PySys_GetObject returns borrowed reference
end function

!> Run Python code that is given as string.
function run_string(string) result(ierror)
  !> Python code to run.
  character(kind=C_CHAR, len=*), intent(in) :: string
  !> Error code, 0 on success
  integer(kind=C_INT) :: ierror
  
  integer :: length
  length = len(string)
  ! check if null-byte is at and of string, if not append it, which can
  ! be expensive
  if (string(length:length) == C_NULL_CHAR) then
    ierror = PyRun_SimpleString(string)
  else
    ierror = PyRun_SimpleString(string // C_NULL_CHAR)
  endif
end function

end module