-
Notifications
You must be signed in to change notification settings - Fork 51
/
forpy_mod.F90
11884 lines (9638 loc) · 377 KB
/
forpy_mod.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
! 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
!
#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 -------------------
!> 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
procedure, private :: sequence_len_int32
!> Get the length of the object (number of elements).
generic, public :: len => sequence_len_int32
procedure, private :: sequence_count_int32
generic, public :: count => sequence_count_int32
!index - does not support optional start and stop indices as the Python function does
procedure, private :: sequence_index_int32
!> Get the first index of a value.
generic, public :: index => sequence_index_int32
procedure, private :: sequence_getitem_int32_object
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int32_object
procedure, private :: sequence_getitem_int32_int32
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int32_int32
procedure, private :: sequence_getitem_int32_int64
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int32_int64
procedure, private :: sequence_getitem_int32_real32
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int32_real32
procedure, private :: sequence_getitem_int32_real64
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int32_real64
procedure, private :: sequence_getitem_int32_complex_real32
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int32_complex_real32
procedure, private :: sequence_getitem_int32_complex_real64
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int32_complex_real64
procedure, private :: sequence_getitem_int32_logical
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int32_logical
procedure, private :: sequence_getitem_int32_char_1d
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int32_char_1d
procedure, private :: sequence_getitem_int32_chars
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int32_chars
procedure, private :: sequence_len_int64
!> Get the length of the object (number of elements).
generic, public :: len => sequence_len_int64
procedure, private :: sequence_count_int64
generic, public :: count => sequence_count_int64
!index - does not support optional start and stop indices as the Python function does
procedure, private :: sequence_index_int64
!> Get the first index of a value.
generic, public :: index => sequence_index_int64
procedure, private :: sequence_getitem_int64_object
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int64_object
procedure, private :: sequence_getitem_int64_int32
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int64_int32
procedure, private :: sequence_getitem_int64_int64
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int64_int64
procedure, private :: sequence_getitem_int64_real32
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int64_real32
procedure, private :: sequence_getitem_int64_real64
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int64_real64
procedure, private :: sequence_getitem_int64_complex_real32
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int64_complex_real32
procedure, private :: sequence_getitem_int64_complex_real64
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int64_complex_real64
procedure, private :: sequence_getitem_int64_logical
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int64_logical
procedure, private :: sequence_getitem_int64_char_1d
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int64_char_1d
procedure, private :: sequence_getitem_int64_chars
!> Get item at a certain index
generic, public :: getitem => sequence_getitem_int64_chars
!> 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
procedure, private :: mutablesequence_setitem_int32_object
!> Set an item at a given index
generic, public :: setitem => mutablesequence_setitem_int32_object
procedure, private :: mutablesequence_setitem_int32_int32
!> Set an item at a given index
generic, public :: setitem => mutablesequence_setitem_int32_int32
procedure, private :: mutablesequence_setitem_int32_int64
!> Set an item at a given index
generic, public :: setitem => mutablesequence_setitem_int32_int64
procedure, private :: mutablesequence_setitem_int32_real32
!> Set an item at a given index
generic, public :: setitem => mutablesequence_setitem_int32_real32
procedure, private :: mutablesequence_setitem_int32_real64
!> Set an item at a given index
generic, public :: setitem => mutablesequence_setitem_int32_real64