1 /**
2    A D API for dealing with Python's PyTypeObject
3  */
4 module python.type;
5 
6 
7 import python.raw: PyObject;
8 import mirror.meta.traits: isParameter, BinaryOperator;
9 import std.traits: Unqual, isArray, isIntegral, isBoolean, isFloatingPoint,
10     isAggregateType, isCallable, isAssociativeArray, isSomeFunction;
11 import std.datetime: DateTime, Date;
12 import std.typecons: Tuple;
13 import std.range.primitives: isInputRange;
14 import std.meta: allSatisfy;
15 static import core.time;
16 
17 
18 package enum isPhobos(T) = isDateOrDateTime!T || isTuple!T || is(Unqual!T == core.time.Duration);
19 package enum isDateOrDateTime(T) = is(Unqual!T == DateTime) || is(Unqual!T == Date);
20 package enum isTuple(T) = is(Unqual!T == Tuple!A, A...);
21 package enum isUserAggregate(T) = isAggregateType!T && !isPhobos!(T);
22 package enum isNonRangeUDT(T) = isUserAggregate!T && !isInputRange!T;
23 
24 
25 /**
26    A wrapper for `PyTypeObject`.
27 
28    This struct does all of the necessary boilerplate to intialise
29    a `PyTypeObject` for a Python extension type that mimics the D
30    type `T`.
31  */
32 struct PythonType(T) {
33     import python.raw: PyTypeObject, PySequenceMethods, PyMappingMethods;
34     import std.traits: FieldNameTuple, Fields, Unqual, fullyQualifiedName, BaseClassesTuple;
35     import std.meta: Alias, AliasSeq, staticMap;
36 
37     static if(is(T == struct) || is(T == union)) {
38         alias fieldNames = FieldNameTuple!T;
39         alias fieldTypes = Fields!T;
40     } else static if(is(T == class)) {
41         // recurse over base classes to get all fields
42         alias fieldNames = AliasSeq!(FieldNameTuple!T, staticMap!(FieldNameTuple, BaseClassesTuple!T));
43         private alias fieldType(string name) = typeof(__traits(getMember, T, name));
44         alias fieldTypes = staticMap!(fieldType, fieldNames);
45     } else static if(is(T == interface)) {
46         alias fieldNames = AliasSeq!();
47         alias fieldTypes = AliasSeq!();
48     }
49 
50     enum hasLength = is(typeof({ size_t len = T.init.length; }));
51 
52     static PyTypeObject _pyType;
53     static bool failedToReady;
54 
55     static PyObject* pyObject() {
56         initialise;
57         return failedToReady ? null : cast(PyObject*) &_pyType;
58     }
59 
60     static PyTypeObject* pyType() nothrow {
61         initialise;
62         return failedToReady ? null : &_pyType;
63     }
64 
65     private static void initialise() nothrow {
66         import autowrap.common: AlwaysTry;
67         import python.raw: PyType_GenericNew, PyType_Ready, TypeFlags,
68             PyErr_SetString, PyExc_TypeError,
69             PyNumberMethods, PySequenceMethods;
70         import mirror.meta.traits: UnaryOperators, BinaryOperators, AssignOperators, functionName;
71         import std.traits: arity, hasMember, TemplateOf;
72         import std.meta: Filter;
73         static import std.typecons;
74 
75         if(_pyType != _pyType.init) return;
76 
77         // This allows tp_name to do its usual Python job and allos us to
78         // construct a D class from its runtime Python type.
79         _pyType.tp_name = fullyQualifiedName!(Unqual!T).ptr;
80         _pyType.tp_flags = TypeFlags.Default;
81         static if(is(T == class) || is(T == interface))
82             _pyType.tp_flags |= TypeFlags.BaseType;
83 
84         // FIXME: types are that user aggregates *and* callables
85         static if(isUserAggregate!T) {
86             _pyType.tp_basicsize = PythonClass!T.sizeof;
87 
88             static if(AlwaysTry || __traits(compiles, getsetDefs()))
89                 _pyType.tp_getset = getsetDefs;
90             else
91                 pragma(msg, "WARNING: could not generate attribute accessors for ", fullyQualifiedName!T);
92 
93             _pyType.tp_methods = methodDefs;
94             static if(!isAbstract!T)
95                 _pyType.tp_new = &_py_new;
96             _pyType.tp_repr = &_py_repr;
97             _pyType.tp_init = &_py_init;
98 
99             // special-case std.typecons.Typedef
100             // see: https://issues.dlang.org/show_bug.cgi?id=20117
101             static isSamePtr(void* lhs, void* rhs) {
102                 return lhs is rhs;
103             }
104 
105             static if(__traits(compiles, isSamePtr(&T.opCmp, &Object.opCmp))) {
106                 static if(
107                     hasMember!(T, "opCmp")
108                     && !__traits(isSame, TemplateOf!T, std.typecons.Typedef)
109                     && !isSamePtr(&T.opCmp, &Object.opCmp)
110                     )
111                 {
112                     _pyType.tp_richcompare = &PythonOpCmp!T._py_cmp;
113                 }
114             }
115 
116             static if(hasMember!(T, "opSlice")) {
117                 static if(AlwaysTry || __traits(compiles, &PythonIterViaList!T._py_iter))
118                     _pyType.tp_iter = &PythonIterViaList!T._py_iter;
119                 else
120                     pragma(msg, "WARNING: could not implement Python opSlice for ", fullyQualifiedName!T);
121             } else static if(isInputRange!T) {
122                 static if(AlwaysTry || __traits(compiles, &PythonIter!T._py_iter_next)) {
123                     _pyType.tp_iter = &PythonIter!T._py_iter;
124                     _pyType.tp_iternext = &PythonIter!T._py_iter_next;
125                 } else
126                     pragma(msg, "WARNING: could not implement Python iterator for ", fullyQualifiedName!T);
127             }
128 
129             // In Python, both D's opIndex and opSlice are dealt with by one function,
130             // in opSlice's case when the type is indexed by a Python slice
131             static if(hasMember!(T, "opIndex") || hasMember!(T, "opSlice")) {
132                 if(_pyType.tp_as_mapping is null)
133                     _pyType.tp_as_mapping = new PyMappingMethods;
134                 static if(AlwaysTry || __traits(compiles, &PythonSubscript!T._py_index))
135                     _pyType.tp_as_mapping.mp_subscript = &PythonSubscript!T._py_index;
136                 else
137                     pragma(msg, "WARNING: could not implement Python index for ",
138                            fullyQualifiedName!T);
139             }
140 
141             static if(hasMember!(T, "opIndexAssign")) {
142                 if(_pyType.tp_as_mapping is null)
143                     _pyType.tp_as_mapping = new PyMappingMethods;
144 
145                 static if(AlwaysTry || __traits(compiles, &PythonIndexAssign!T._py_index_assign))
146                     _pyType.tp_as_mapping.mp_ass_subscript = &PythonIndexAssign!T._py_index_assign;
147                 else
148                     pragma(msg, "WARNING: could not implement Python index assign for ",
149                            fullyQualifiedName!T);
150             }
151 
152             enum isPythonableUnary(string op) = op == "+" || op == "-" || op == "~";
153             enum unaryOperators = Filter!(isPythonableUnary, UnaryOperators!T);
154             alias binaryOperators = BinaryOperators!T;
155             alias assignOperators = AssignOperators!T;
156 
157             static if(unaryOperators.length > 0 || binaryOperators.length > 0 || assignOperators.length > 0) {
158                 _pyType.tp_as_number = new PyNumberMethods;
159                 _pyType.tp_as_sequence = new PySequenceMethods;
160             }
161 
162             static foreach(op; unaryOperators) {
163                 mixin(`_pyType.`, dlangUnOpToPythonSlot(op), ` = &PythonUnaryOperator!(T, op)._py_un_op;`);
164             }
165 
166             static foreach(binOp; binaryOperators) {{
167                 // first get the Python function pointer name
168                 enum slot = dlangBinOpToPythonSlot(binOp.op);
169                 // some of them differ in arity
170                 enum slotArity = arity!(mixin(`typeof(PyTypeObject.`, slot, `)`));
171 
172                 // get the function name in PythonBinaryOperator
173                 // `in` is special because the function signature is different
174                 static if(binOp.op == "in") {
175                     enum cFuncName = "_py_in_func";
176                 } else {
177                     static if(slotArity == 2)
178                         enum cFuncName = "_py_bin_func";
179                     else static if(slotArity == 3)
180                         enum cFuncName = "_py_ter_func";
181                     else
182                         static assert("Do not know how to deal with slot " ~ slot);
183                 }
184 
185                 // set the C function that implements this operator
186                 mixin(`_pyType.`, slot, ` = &PythonBinaryOperator!(T, binOp).`, cFuncName, `;`);
187             }}
188 
189             static foreach(assignOp; assignOperators) {{
190                 enum slot = dlangAssignOpToPythonSlot(assignOp);
191                                 // some of them differ in arity
192                 enum slotArity = arity!(mixin(`typeof(PyTypeObject.`, slot, `)`));
193 
194                 // get the function name in PythonAssignOperator
195                 static if(slotArity == 2)
196                     enum cFuncName = "_py_bin_func";
197                 else static if(slotArity == 3)
198                     enum cFuncName = "_py_ter_func";
199                 else
200                     static assert("Do not know how to deal with slot " ~ slot);
201 
202                 // set the C function that implements this operator
203                 mixin(`_pyType.`, slot, ` = &PythonAssignOperator!(T, assignOp).`, cFuncName, `;`);
204             }}
205 
206             static if(isCallable!T) {
207                 _pyType.tp_call = &PythonCallable!T._py_call;
208             }
209 
210             // inheritance
211             static if(is(T Bases == super)) {
212                 enum isSuperClass(U) = is(U == class) && !is(U == Object);
213                 alias supers = Filter!(isSuperClass, Bases);
214                 static if(supers.length == 1) {
215                     _pyType.tp_base = PythonType!(supers[0]).pyType;
216                 }
217             }
218 
219         } else static if(isCallable!T) {
220             _pyType.tp_basicsize = PythonCallable!T.sizeof;
221             _pyType.tp_call = &PythonCallable!T._py_call;
222         } else static if(is(T == enum)) {
223             import python.raw: PyEnum_Type;
224             _pyType.tp_basicsize = 0;
225             _pyType.tp_base = &PyEnum_Type;
226             try
227                 _pyType.tp_dict = classDict;
228             catch(Exception e) {
229                 import core.stdc.stdio;
230                 enum msg = "Could not create class dict for " ~ T.stringof ~ "\n";
231                 printf(msg);
232             }
233         } else
234             static assert(false, "Don't know what to do for type " ~ T.stringof);
235 
236         static if(hasLength) {
237             if(_pyType.tp_as_sequence is null)
238                 _pyType.tp_as_sequence = new PySequenceMethods;
239             _pyType.tp_as_sequence.sq_length = &_py_length;
240         }
241 
242         if(PyType_Ready(&_pyType) < 0) {
243             PyErr_SetString(PyExc_TypeError, &"not ready"[0]);
244             failedToReady = true;
245         }
246     }
247 
248     static if(is(T == enum)) {
249         private static PyObject* classDict() {
250             import python.conv.d_to_python: toPython;
251             import std.traits: EnumMembers, OriginalType;
252 
253             OriginalType!T[string] dict;
254 
255             static foreach(i; 0 .. EnumMembers!T.length) {
256                 dict[__traits(identifier, EnumMembers!T[i])] = EnumMembers!T[i];
257             }
258 
259             return dict.toPython;
260         }
261     }
262 
263     static if(isUserAggregate!T)
264     private static auto getsetDefs() {
265         import autowrap.common: AlwaysTry;
266         import python.raw: PyGetSetDef;
267         import mirror.meta.traits: isProperty, MemberFunctionsByOverload;
268         import std.meta: Filter;
269         import std.traits: ReturnType;
270 
271         alias properties = Filter!(isProperty, MemberFunctionsByOverload!T);
272 
273         // +1 due to the sentinel
274         static PyGetSetDef[fieldNames.length + properties.length + 1] getsets;
275 
276         // don't bother if already initialised
277         if(getsets != getsets.init) return &getsets[0];
278 
279         template isPublic(string fieldName) {
280             static if(__traits(compiles, __traits(getMember, T, fieldName))) {
281                 alias field = __traits(getMember, T, fieldName);
282                 static if(__traits(compiles, __traits(getProtection, field)))
283                     enum isPublic = __traits(getProtection, field) == "public";
284                 else
285                     enum isPublic = false;
286             } else
287                 enum isPublic = false;
288         }
289 
290         // first deal with the public fields
291         static foreach(i; 0 .. fieldNames.length) {
292             getsets[i].name = cast(typeof(PyGetSetDef.name)) fieldNames[i];
293             static if(isPublic!(fieldNames[i])) {
294                 getsets[i].get = &PythonClass!T._get_impl!i;
295                 getsets[i].set = &PythonClass!T._set_impl!i;
296             }
297         }
298 
299         // then deal with the property functions
300         static foreach(j, property; properties) {{
301             enum i = fieldNames.length + j;
302 
303             getsets[i].name = cast(typeof(PyGetSetDef.name)) __traits(identifier, property);
304 
305             static foreach(overload; __traits(getOverloads, T, __traits(identifier, property))) {
306                 static if(is(ReturnType!overload == void)) { // setter
307                     static if(AlwaysTry || __traits(compiles, &PythonClass!T.propertySet!overload))
308                         getsets[i].set = &PythonClass!T.propertySet!overload;
309                     else
310                         pragma(msg, "Cannot implement ", fullyQualifiedName!T, ".set!", i, " (", __traits(identifier, overload), ")");
311                 } else  { // getter
312                     static if(AlwaysTry || __traits(compiles, &PythonClass!T.propertyGet!overload))
313                         getsets[i].get = &PythonClass!T.propertyGet!overload;
314                     else {
315                         pragma(msg, "Cannot implement ", fullyQualifiedName!T, ".get!", i, " (", __traits(identifier, overload), ")");
316                         // getsets[i].get = &PythonClass!T.propertyGet!overload;
317                     }
318                 }
319             }
320         }}
321 
322         return &getsets[0];
323     }
324 
325     private static auto methodDefs()() {
326         import autowrap.common: AlwaysTry;
327         import python.raw: PyMethodDef, MethodArgs;
328         import python.cooked: pyMethodDef, defaultMethodFlags;
329         import mirror.meta.traits: isProperty;
330         import std.meta: AliasSeq, Alias, staticMap, Filter, templateNot;
331         import std.traits: isSomeFunction;
332         import std.algorithm: startsWith;
333 
334         alias memberNames = AliasSeq!(__traits(allMembers, T));
335         enum ispublic(string name) = isPublic!(T, name);
336         alias publicMemberNames = Filter!(ispublic, memberNames);
337 
338         enum isRegular(string name) =
339             name != "this"
340             && name != "toHash"
341             && name != "factory"
342             && !name.startsWith("op")
343             && !name.startsWith("__")
344             ;
345         alias regularMemberNames = Filter!(isRegular, publicMemberNames);
346         alias overloads(string name) = AliasSeq!(__traits(getOverloads, T, name));
347         alias members = staticMap!(overloads, regularMemberNames);
348         alias memberFunctions = Filter!(templateNot!isProperty, Filter!(isSomeFunction, members));
349 
350         // +1 due to sentinel
351         static PyMethodDef[memberFunctions.length + 1] methods;
352 
353         if(methods != methods.init) return &methods[0];
354 
355         static foreach(i, memberFunction; memberFunctions) {{
356 
357             static if(__traits(isStaticFunction, memberFunction))
358                 enum flags = defaultMethodFlags | MethodArgs.Static;
359             else
360                 enum flags = defaultMethodFlags;
361 
362             static if(AlwaysTry || __traits(compiles, &PythonMethod!(T, memberFunction)._py_method_impl))
363                 methods[i] = pyMethodDef!(__traits(identifier, memberFunction), flags)
364                                          (&PythonMethod!(T, memberFunction)._py_method_impl);
365             else {
366                 pragma(msg, "WARNING: could not wrap D method `", T, ".", __traits(identifier, memberFunction), "`");
367                 // uncomment to get the compiler error message to find out why not
368                 // auto ptr = &PythonMethod!(T, memberFunction)._py_method_impl;
369             }
370         }}
371 
372         return &methods[0];
373     }
374 
375     import python.raw: Py_ssize_t;
376     private static extern(C) Py_ssize_t _py_length(PyObject* self_) nothrow {
377 
378         return noThrowable!({
379             assert(self_ !is null);
380             static if(hasLength) {
381                 import python.conv: to;
382                 return self_.to!T.length;
383             } else
384                 return -1;
385         });
386     }
387 
388     private static extern(C) PyObject* _py_repr(PyObject* self_) nothrow {
389 
390         return noThrowable!({
391 
392             import python: pyUnicodeDecodeUTF8;
393             import python.conv: to;
394             import std..string: toStringz;
395             import std.conv: text;
396             import std.traits: fullyQualifiedName;
397 
398             assert(self_ !is null);
399 
400             static if(__traits(compiles, text(self_.to!T))) {
401                 auto ret = text(self_.to!T);
402                 return pyUnicodeDecodeUTF8(ret.ptr, ret.length, null /*errors*/);
403             } else {
404                 pragma(msg, "WARNING: cannot generate repr for ", fullyQualifiedName!T);
405                 PyObject* impl() {
406                     throw new Exception("Unable to generate Python repr for F " ~ fullyQualifiedName!T);
407                 }
408                 return impl;
409             }
410         });
411     }
412 
413     private static extern(C) int _py_init(PyObject* self_, PyObject* args, PyObject* kwargs) nothrow {
414         // nothing to do
415         return 0;
416     }
417 
418     static if(isUserAggregate!T && !isAbstract!T)
419     private static extern(C) PyObject* _py_new(PyTypeObject *type, PyObject* args, PyObject* kwargs) nothrow {
420         return noThrowable!({
421             import python.conv: toPython;
422             import python.raw: PyTuple_Size;
423             import mirror.meta.traits: isPrivate;
424             import std.traits: hasMember, fullyQualifiedName;
425 
426             if(PyTuple_Size(args) == 0) return toPython(userAggregateInit!T);
427 
428             static if(hasMember!(T, "__ctor") && !isPrivate!(__traits(getMember, T, "__ctor"))) {
429                 static if(__traits(compiles, callDlangFunction!(T, __traits(getMember, T, "__ctor"))(null /*self*/, args, kwargs)))
430                     return callDlangFunction!(T, __traits(getMember, T, "__ctor"))(null /*self*/, args, kwargs);
431                 else {
432                     pragma(msg, "WARNING: cannot wrap constructor for `", fullyQualifiedName!T, "`");
433                     // uncomment below to see the compilation error
434                     // return callDlangFunction!(T, __traits(getMember, T, "__ctor"))(null /*self*/, args, kwargs);
435                     return toPython(userAggregateInit!T);
436                 }
437 
438             } else { // allow implicit constructors to work in Python
439                 T impl(fieldTypes fields = fieldTypes.init) {
440                     static if(is(T == class)) {
441                         if(PyTuple_Size(args) != 0)
442                             throw new Exception(T.stringof ~ " has no constructor therefore can't construct one from arguments");
443                         return T.init;
444                     } else {
445                         static if(__traits(compiles, T(fields)))
446                             return T(fields);
447                         else {
448                             pragma(msg, "WARNING: cannot use implicit constructor for `", T, "`");
449                             // uncomment below to see the compiler error
450                             // auto _t_tmp = T(fields);
451                             return T.init;
452                         }
453                     }
454                 }
455 
456                 static if(__traits(compiles, callDlangFunction!(typeof(impl), impl)(null, args, kwargs)))
457                     return callDlangFunction!(typeof(impl), impl)(null /*self*/, args, kwargs);
458                 else {
459                     enum msg = "could not generate constructor for " ~ fullyQualifiedName!T;
460                     pragma(msg, "WARNING: ", msg);
461                     static PyObject* oops() {
462                         throw new Exception(msg);
463                     }
464                     return oops;
465                 }
466             }
467         });
468     }
469 }
470 
471 
472 private template isAbstract(T) {
473     import std.traits: isAbstractClass;
474     enum isAbstract = is(T == interface) || isAbstractClass!T;
475 }
476 
477 
478 // From a D operator (e.g. `+`) to a Python function pointer member name
479 private string dlangUnOpToPythonSlot(string op) {
480     enum opToSlot = [
481         "+": "tp_as_number.nb_positive",
482         "-": "tp_as_number.nb_negative",
483         "~": "tp_as_number.nb_invert",
484     ];
485     if(op !in opToSlot) throw new Exception("Unknown unary operator " ~ op);
486     return opToSlot[op];
487 }
488 
489 
490 // From a D operator (e.g. `+`) to a Python function pointer member name
491 private string dlangBinOpToPythonSlot(string op) {
492     enum opToSlot = [
493         "+":   "tp_as_number.nb_add",
494         "+=":  "tp_as_number.nb_inplace_add",
495         "-":   "tp_as_number.nb_subtract",
496         "-=":  "tp_as_number.nb_inplace_subtract",
497         "*":   "tp_as_number.nb_multiply",
498         "*=":  "tp_as_number.nb_inplace_multiply",
499         "/":   "tp_as_number.nb_divide",
500         "/=":  "tp_as_number.nb_inplace_true_divide",
501         "%":   "tp_as_number.nb_remainder",
502         "%=":  "tp_as_number.nb_inplace_remainder",
503         "^^":  "tp_as_number.nb_power",
504         "^^=": "tp_as_number.nb_inplace_power",
505         "&":   "tp_as_number.nb_and",
506         "&=":  "tp_as_number.nb_inplace_and",
507         "|":   "tp_as_number.nb_or",
508         "|=":  "tp_as_number.nb_inplace_or",
509         "^":   "tp_as_number.nb_xor",
510         "^=":  "tp_as_number.nb_inplace_xor",
511         "<<":  "tp_as_number.nb_lshift",
512         "<<=": "tp_as_number.nb_inplace_lshift",
513         ">>":  "tp_as_number.nb_rshift",
514         ">>=": "tp_as_number.nb_inplace_rshift",
515         "~":   "tp_as_sequence.sq_concat",
516         "~=":  "tp_as_sequence.sq_concat",
517         "in":  "tp_as_sequence.sq_contains",
518     ];
519     if(op !in opToSlot) throw new Exception("Unknown binary operator " ~ op);
520     return opToSlot[op];
521 }
522 
523 
524 // From a D operator (e.g. `+`) to a Python function pointer member name
525 private string dlangAssignOpToPythonSlot(string op) {
526     enum opToSlot = [
527         "+":  "tp_as_number.nb_inplace_add",
528         "-":  "tp_as_number.nb_inplace_subtract",
529         "*":  "tp_as_number.nb_inplace_multiply",
530         "/":  "tp_as_number.nb_inplace_true_divide",
531         "%":  "tp_as_number.nb_inplace_remainder",
532         "^^": "tp_as_number.nb_inplace_power",
533         "&":  "tp_as_number.nb_inplace_and",
534         "|":  "tp_as_number.nb_inplace_or",
535         "^":  "tp_as_number.nb_inplace_xor",
536         "<<": "tp_as_number.nb_inplace_lshift",
537         ">>": "tp_as_number.nb_inplace_rshift",
538         "~":  "tp_as_sequence.sq_concat",
539     ];
540     if(op !in opToSlot) throw new Exception("Unknown assignment operator " ~ op);
541     return opToSlot[op];
542 }
543 
544 
545 private auto pythonArgsToDArgs(bool isVariadic, P...)(PyObject* args, PyObject* kwargs)
546     if(allSatisfy!(isParameter, P))
547 {
548     import python.raw: PyTuple_Size, PyTuple_GetItem, PyTuple_GetSlice, pyUnicodeDecodeUTF8, PyDict_GetItem;
549     import python.conv: to;
550     import std.typecons: Tuple;
551     import std.meta: staticMap;
552     import std.traits: Unqual;
553     import std.conv: text;
554     import std.exception: enforce;
555 
556     const argsLength = args is null ? 0 : PyTuple_Size(args);
557 
558     alias Type(alias Param) = Param.Type;
559     alias Types = staticMap!(Type, P);
560 
561     // If one or more of the parameters is const/immutable,
562     // it'll be hard to construct it as such, so we Unqual
563     // the types for construction and cast to the appropriate
564     // type when returning.
565     alias MutableTuple = Tuple!(staticMap!(Unqual, Types));
566     alias RetTuple = Tuple!(Types);
567 
568     MutableTuple dArgs;
569 
570     void positional(size_t i, T)() {
571         auto item = PyTuple_GetItem(args, i);
572 
573         static if(__traits(compiles, checkPythonType!T(item))) {
574             if(!checkPythonType!T(item)) {
575                 import python.raw: PyErr_Clear;
576                 PyErr_Clear;
577                 throw new ArgumentConversionException("Can't convert to " ~ T.stringof);
578             }
579         } else {
580             version(PynihCheckType) {
581                 pragma(msg, "WARNING: cannot check python type for `", T, "`");
582                 // uncomment to see the compilation error
583                 // checkPythonType!T(item);
584             }
585         }
586 
587         dArgs[i] = item.to!T;
588     }
589 
590     int pythonArgIndex = 0;
591     static foreach(i; 0 .. P.length) {
592 
593         static if(i == P.length - 1 && isVariadic) {  // last parameter and it's a typesafe variadic one
594             // slice the remaining arguments
595             auto remainingArgs = PyTuple_GetSlice(args, i, PyTuple_Size(args));
596             dArgs[i] = remainingArgs.to!(P[i].Type);
597         } else static if(is(P[i].Default == void)) {
598             // ith parameter is required
599             enforce(i < argsLength,
600                     text(__FUNCTION__, ": not enough Python arguments"));
601             positional!(i, typeof(dArgs[i]));
602         } else {
603 
604             if(i < argsLength) {  // regular case
605                 positional!(i, P[i].Type);
606             } else {
607                 // Here it gets tricky. The user could have supplied it in
608                 // args positionally or via kwargs
609                 auto key = pyUnicodeDecodeUTF8(&P[i].identifier[0],
610                                                P[i].identifier.length,
611                                                null /*errors*/);
612                 enforce(key, "Errors converting '" ~ P[i].identifier ~ "' to Python object");
613                 auto val = kwargs ? PyDict_GetItem(kwargs, key) : null;
614                 dArgs[i] = val
615                     ? val.to!(P[i].Type) // use kwargs
616                     : P[i].Default; // use default value
617             }
618         }
619     }
620 
621     return cast(RetTuple) dArgs;
622 }
623 
624 
625 private alias Type(alias A) = typeof(A);
626 
627 
628 /**
629    The C API implementation of a Python method F of aggregate type T
630  */
631 struct PythonMethod(T, alias F) {
632     static extern(C) PyObject* _py_method_impl(PyObject* self,
633                                                PyObject* args,
634                                                PyObject* kwargs)
635         nothrow
636     {
637         return noThrowable!(callDlangFunction!(T, F))(self, args, kwargs);
638     }
639 }
640 
641 
642 private void mutateSelf(T)(PyObject* self, auto ref T dAggregate) {
643 
644     import python.conv.d_to_python: toPython;
645     import python.raw: pyDecRef;
646 
647     auto newSelf = self is null ? self : toPython(dAggregate);
648     scope(exit) {
649         if(self !is null) pyDecRef(newSelf);
650     }
651     auto pyClassSelf = cast(PythonClass!T*) self;
652     auto pyClassNewSelf = cast(PythonClass!T*) newSelf;
653 
654     static foreach(i; 0 .. PythonClass!T.fieldNames.length) {
655         if(self !is null)
656             pyClassSelf._set_impl!i(self, pyClassNewSelf._get_impl!i(newSelf));
657     }
658 
659 }
660 
661 
662 /**
663    The C API implementation that calls a D function F.
664  */
665 struct PythonFunction(alias F) {
666     static extern(C) PyObject* _py_function_impl(PyObject* self, PyObject* args, PyObject* kwargs) nothrow {
667         return noThrowable!(callDlangFunction!(void, F))(self, args, kwargs);
668     }
669 }
670 
671 
672 private auto noThrowable(alias F, A...)(auto ref A args) {
673     import python.raw: PyErr_SetString, PyExc_RuntimeError;
674     import std..string: toStringz;
675     import std.traits: ReturnType;
676 
677     try {
678         return F(args);
679     } catch(Exception e) {
680         PyErr_SetString(PyExc_RuntimeError, e.msg.toStringz);
681         return ReturnType!F.init;
682     } catch(Error e) {
683         import std.conv: text;
684         try
685             PyErr_SetString(PyExc_RuntimeError, ("FATAL ERROR: " ~ e.text).toStringz);
686         catch(Exception _)
687             PyErr_SetString(PyExc_RuntimeError, ("FATAL ERROR: " ~ e.msg).toStringz);
688 
689         return ReturnType!F.init;
690     }
691 }
692 
693 
694 class ArgsException: Exception {
695     import std.exception: basicExceptionCtors;
696     mixin basicExceptionCtors;
697 }
698 
699 private PyObject* callDlangFunction(T, alias F)(PyObject* self, PyObject* args, PyObject *kwargs) {
700 
701     import python.raw: PyTuple_Size;
702     import python.conv: toPython, to;
703     import mirror.meta.traits: Parameters, NumDefaultParameters, NumRequiredParameters;
704     import std.traits: variadicFunctionStyle, Variadic,
705         moduleName, isCallable, StdParameters = Parameters;
706     import std.conv: text;
707     import std.exception: enforce;
708     import std.meta: AliasSeq;
709 
710     enum identifier = __traits(identifier, F);
711     enum isCtor = isUserAggregate!T && identifier == "__ctor";
712     enum isMethod = isUserAggregate!T && identifier != "__ctor";
713 
714     static if(is(T == void)) { // regular function
715         enum parent = moduleName!F;
716         mixin(`static import `, parent, `;`);
717         mixin(`alias Parent = `, parent, `;`);
718     } else static if(isMethod) {
719         enum parent =  "dAggregate";
720         alias Parent = T;
721     } else static if(isCallable!T) {
722         // nothing to do here
723     } else static if(isCtor) {
724         alias Parent = T;
725     } else
726         static assert(false, __FUNCTION__ ~ " does not know how to handle " ~ T.stringof);
727 
728     static if(is(T == void))
729         enum callMixin = `auto ret = callDlangFunction!F(dArgs);`;
730     else static if(isMethod)
731         enum callMixin = `auto ret = callDlangFunction!((StdParameters!overload dArgs) => ` ~ parent ~ `.` ~ identifier ~ `(dArgs))(dArgs);`;
732     else static if(isCtor) {
733         static if(is(T == class))
734             enum callMixin = `auto ret = callDlangFunction!((StdParameters!overload dArgs) => new T(dArgs))(dArgs);`;
735         else
736             enum callMixin = `auto ret = callDlangFunction!((StdParameters!overload dArgs) => T(dArgs))(dArgs);`;
737     } else static if(isCallable!T && !isUserAggregate!T)
738         enum callMixin = `auto ret = callDlangFunction!F(dArgs);`;
739     else
740         static assert(false);
741 
742     static if(__traits(compiles, __traits(getOverloads, Parent, identifier))) {
743         alias candidates = __traits(getOverloads, Parent, identifier);
744         // Deal with possible template instantiation functions.
745         // If it's a free function (T is void), then there must be at least
746         // one overload. The only reason for there to not be one is because
747         // it's a function template.
748         static if(is(T == void) && candidates.length == 0)
749             alias overloads = AliasSeq!F;
750         else
751             alias overloads = candidates;
752     } else
753         alias overloads = AliasSeq!F;
754 
755     static foreach(overload; overloads) {{
756         enum numDefaults = NumDefaultParameters!overload;
757         enum numRequired = NumRequiredParameters!overload;
758         enum isVariadic = variadicFunctionStyle!overload == Variadic.typesafe;
759         enum isMemberFunction = !__traits(isStaticFunction, overload) && !is(T == void);
760 
761         static if(isUserAggregate!T && isMemberFunction && !isCtor)
762             assert(self !is null,
763                    "Cannot call PythonMethod!" ~ identifier ~ " on null self");
764 
765         alias Aggregate = QualifiedType!(T, overload);
766 
767         static if(isUserAggregate!T) { // member function, static or not
768             // The reason we alias this here is because Aggregate could be a value
769             // type but self.to!Aggregate could return a pointer when the struct
770             // is not copiable.
771             alias typeofConversion = typeof(self.to!Aggregate);
772             // self could be null for static member functions
773             auto dAggregate = self is null ? typeofConversion.init : self.to!Aggregate;
774         }
775 
776         try {
777             const numArgs = args is null ? 0 : PyTuple_Size(args);
778             if(!isVariadic)
779                 enforce!ArgumentConversionException(
780                     numArgs >= numRequired
781                     && numArgs <= Parameters!overload.length,
782                     text("Received ", numArgs, " parameters but ",
783                          identifier, " takes ", Parameters!overload.length));
784 
785             auto dArgs = pythonArgsToDArgs!(isVariadic, Parameters!overload)(args, kwargs);
786 
787             void testCallMixin()() {
788                 mixin(callMixin);
789             }
790 
791             static if(is(typeof(testCallMixin!()))) {
792 
793                 mixin(callMixin);
794 
795                 static if(isUserAggregate!T && isMemberFunction && !isConstMemberFunction!overload) {
796                     mutateSelf(self, dAggregate);
797                 }
798 
799                 return ret;
800             } else
801                 throw new Exception("Cannot call function since `" ~ callMixin ~ "` does not compile");
802 
803         } catch(ArgumentConversionException _) {
804             // only using this to weed out incompatible overloads
805         }
806     }}
807 
808     throw new Exception("Could not find suitable overload for `" ~ identifier ~ "`");
809 }
810 
811 
812 private template QualifiedType(T, alias overload) {
813 
814     import std.traits: functionAttributes, FunctionAttribute;
815 
816     static if(functionAttributes!overload & FunctionAttribute.const_)
817         alias QualifiedType = const T;
818     else static if(functionAttributes!overload & FunctionAttribute.immutable_)
819         alias QualifiedType = immutable T;
820     else static if(functionAttributes!overload & FunctionAttribute.shared_)
821         alias QualifiedType = shared T;
822     else
823         alias QualifiedType = Unqual!T;
824 }
825 
826 
827 class ArgumentConversionException: Exception {
828     import std.exception: basicExceptionCtors;
829     mixin basicExceptionCtors;
830 }
831 
832 
833 private PyObject* callDlangFunction(alias F, A)(auto ref A argTuple) {
834     import python.raw: pyIncRef, pyNone;
835     import python.conv: toPython;
836     import std.traits: ReturnType;
837 
838     // TODO - side-effects on parameters?
839     static if(is(ReturnType!F == void)) {
840         F(argTuple.expand);
841         pyIncRef(pyNone);
842         return pyNone;
843     } else {
844         auto dret = F(argTuple.expand);
845         return dret.toPython;
846     }
847 }
848 
849 
850 /**
851    Creates an instance of a Python class that is equivalent to the D type `T`.
852    Return PyObject*.
853  */
854 PyObject* pythonClass(T)(auto ref T dobj) {
855 
856     import python.conv: toPython;
857     import python.raw: pyObjectNew;
858     import std.traits: isPointer, PointerTarget;
859 
860     static if(is(T == class) || isPointer!T) {
861         if(dobj is null)
862             throw new Exception("Cannot create Python class from null D object");
863     }
864 
865     static if(isPointer!T)
866         alias Type = PointerTarget!T;
867     else
868         alias Type = T;
869 
870     auto _type = PythonType!Type.pyType;
871 
872     auto ret = pyObjectNew!(PythonClass!Type)(PythonType!Type.pyType);
873 
874     static foreach(fieldName; PythonType!Type.fieldNames) {
875         static if(isPublic!(T, fieldName))
876             mixin(`ret.`, fieldName, ` = dobj.`, fieldName, `.toPython;`);
877     }
878 
879     return cast(PyObject*) ret;
880 }
881 
882 
883 private template isPublic(T, string memberName) {
884 
885     static if(__traits(compiles, __traits(getProtection, __traits(getMember, T, memberName)))) {
886         enum protection = __traits(getProtection, __traits(getMember, T, memberName));
887         enum isPublic = protection == "public" || protection == "export";
888     } else
889         enum isPublic = false;
890 }
891 
892 /**
893    OOP types register factory functions here, indexed by the fully qualified
894    name of the type. This allows us to construct D class types from the
895    runtime types of Python values.
896  */
897 Object delegate(PyObject*)[string] gFactory;
898 
899 /**
900    A Python class that mirrors the D type `T`.
901    For instance, this struct:
902    ----------
903    struct Foo {
904        int i;
905        string s;
906    }
907    ----------
908 
909    Will generate a Python class called `Foo` with two members, and trying to
910    assign anything but an integer to `Foo.i` or a string to `Foo.s` in Python
911    will raise `TypeError`.
912  */
913 struct PythonClass(T) {//}if(isUserAggregate!T) {
914     import python.raw: PyObjectHead, PyGetSetDef;
915     import std.traits: Unqual;
916 
917     alias fieldNames = PythonType!(Unqual!T).fieldNames;
918     alias fieldTypes = PythonType!(Unqual!T).fieldTypes;
919 
920     // Every python object must have this
921     mixin PyObjectHead;
922 
923     // Field members
924     // Generate a python object field for every field in T
925     static foreach(fieldName; fieldNames) {
926         mixin(`PyObject* `, fieldName, `;`);
927     }
928 
929     static if(is(T == class)) {
930         static this() {
931             import std.traits: fullyQualifiedName;
932 
933             gFactory[fullyQualifiedName!(Unqual!T)] = (PyObject* value) {
934                 import python.conv.python_to_d: to;
935 
936                 auto pyclass = cast(PythonClass!T*) value;
937                 auto ret = userAggregateInit!(Unqual!T);
938 
939                 static foreach(fieldName; fieldNames) {{
940                     alias Field = typeof(__traits(getMember, ret, fieldName));
941                     // The reason we can't just assign to the field here is that the field
942                     // might be const or immutable.
943                     auto fieldPtr = cast(Unqual!Field*) &__traits(getMember, ret, fieldName);
944                     *fieldPtr = __traits(getMember, pyclass, fieldName).to!Field;
945                 }}
946 
947                 return cast(Object) ret;
948             };
949         }
950     }
951 
952     // The function pointer for PyGetSetDef.get
953     private static extern(C) PyObject* _get_impl(int FieldIndex)
954                                                 (PyObject* self_, void* closure = null)
955         nothrow
956         in(self_ !is null)
957     {
958         import python.raw: pyIncRef;
959 
960         auto self = cast(PythonClass*) self_;
961 
962         auto impl() {
963             auto field = self.getField!FieldIndex;
964             assert(field !is null, "Cannot increase reference count on null field");
965             pyIncRef(field);
966 
967             return field;
968         }
969 
970         return noThrowable!impl;
971     }
972 
973     // The function pointer for PyGetSetDef.set
974     static extern(C) int _set_impl(int FieldIndex)
975                                   (PyObject* self_, PyObject* value, void* closure = null)
976         nothrow
977         in(self_ !is null)
978     {
979         import python.raw: pyIncRef, pyDecRef, PyErr_SetString, PyExc_TypeError;
980 
981         if(value is null) {
982             enum deleteErrStr = "Cannot delete " ~ fieldNames[FieldIndex];
983             PyErr_SetString(PyExc_TypeError, deleteErrStr);
984             return -1;
985         }
986 
987         static if(__traits(compiles, checkPythonType!(fieldTypes[FieldIndex])(value))) {
988             if(!checkPythonType!(fieldTypes[FieldIndex])(value)) {
989                 return -1;
990             }
991         } else {
992             version(PynihCheckType) {
993                 pragma(msg, "WARNING: cannot check python type for field #", FieldIndex, " of ", T);
994                 // uncomment below to see compilation failure
995                 // checkPythonType!(fieldTypes[FieldIndex])(value);
996             }
997         }
998 
999         auto impl() {
1000             auto self = cast(PythonClass!T*) self_;
1001             auto tmp = self.getField!FieldIndex;
1002 
1003             pyIncRef(value);
1004             mixin(`self.`, fieldNames[FieldIndex], ` = value;`);
1005             pyDecRef(tmp);
1006 
1007             return 0;
1008         }
1009 
1010         return noThrowable!impl;
1011     }
1012 
1013     PyObject* getField(int FieldIndex)() {
1014 
1015         import autowrap.common: AlwaysTry;
1016 
1017         auto impl()() {
1018             mixin(`return this.`, fieldNames[FieldIndex], `;`);
1019         }
1020 
1021         static if(AlwaysTry || __traits(compiles, impl!()()))
1022             return impl;
1023         else {
1024             import std.traits: fullyQualifiedName;
1025             import std.conv: text;
1026 
1027             enum msg = text("cannot implement ", fullyQualifiedName!T, ".getField!", FieldIndex);
1028             pragma(msg, "WARNING: ", msg);
1029             throw new Exception(msg);
1030         }
1031     }
1032 
1033     static extern(C) PyObject* propertyGet(alias F)
1034                                           (PyObject* self_, void* closure = null)
1035         nothrow
1036         in(self_ !is null)
1037     {
1038         return PythonMethod!(T, F)._py_method_impl(self_, null /*args*/, null /*kwargs*/);
1039     }
1040 
1041     static extern(C) int propertySet(alias F)
1042                                     (PyObject* self_, PyObject* value, void* closure = null)
1043         nothrow
1044         in(self_ !is null)
1045     {
1046         import python.raw: PyTuple_New, PyTuple_SetItem, pyDecRef;
1047 
1048         auto args = PyTuple_New(1);
1049         PyTuple_SetItem(args, 0, value);
1050         scope(exit) pyDecRef(args);
1051 
1052         PythonMethod!(T, F)._py_method_impl(self_, args, null /*kwargs*/);
1053 
1054         return 0;
1055     }
1056 }
1057 
1058 
1059 PyObject* pythonCallable(T)(T callable) {
1060     import python.raw: pyObjectNew;
1061 
1062     auto ret = pyObjectNew!(PythonCallable!T)(PythonType!T.pyType);
1063     ret._callable = callable;
1064 
1065     return cast(PyObject*) ret;
1066 }
1067 
1068 
1069 private struct PythonCallable(T) if(isCallable!T) {
1070 
1071     import std.traits: hasMember;
1072 
1073     static if(hasMember!(T, "opCall")) {
1074         private static extern(C) PyObject* _py_call(PyObject* self, PyObject* args, PyObject* kwargs) nothrow {
1075             return PythonMethod!(T, T.opCall)._py_method_impl(self, args, kwargs);
1076         }
1077     } else {
1078         /**
1079            Reserves space for a callable to be stored in a PyObject struct so that it
1080            can later be called.
1081         */
1082 
1083         import python.raw: PyObjectHead;
1084 
1085         // Every python object must have this
1086         mixin PyObjectHead;
1087 
1088         private T _callable;
1089 
1090         private static extern(C) PyObject* _py_call(PyObject* self_, PyObject* args, PyObject* kwargs)
1091             nothrow
1092             in(self_ !is null)
1093             do
1094         {
1095             import std.traits: Parameters, ReturnType;
1096             auto self = cast(PythonCallable!T*) self_;
1097             assert(self._callable !is null, "Cannot have null callable");
1098             return noThrowable!(callDlangFunction!(T, (Parameters!T args) => self._callable(args)))(self_, args, kwargs);
1099         }
1100     }
1101 }
1102 
1103 private bool isConstMemberFunction(alias F)() {
1104     import std.traits: functionAttributes, FunctionAttribute;
1105     return cast(bool) (functionAttributes!F & FunctionAttribute.const_);
1106 }
1107 
1108 
1109 private template PythonUnaryOperator(T, string op) {
1110     static extern(C) PyObject* _py_un_op(PyObject* self) nothrow {
1111         return noThrowable!({
1112             import python.conv.python_to_d: to;
1113             import python.conv.d_to_python: toPython;
1114             import std.traits: Parameters;
1115 
1116             static assert(Parameters!(T.opUnary!op).length == 0, "opUnary can't take any parameters");
1117 
1118             return self.to!T.opUnary!op.toPython;
1119         });
1120     }
1121 }
1122 
1123 
1124 private template PythonBinaryOperator(T, BinaryOperator operator) {
1125 
1126     static extern(C) int _py_in_func(PyObject* lhs, PyObject* rhs)
1127         nothrow
1128         in(operator.op == "in")
1129     {
1130         import python.conv.python_to_d: to;
1131         import python.conv.d_to_python: toPython;
1132         import std.traits: Parameters, hasMember;
1133 
1134         alias inParams(U) = Parameters!(U.opBinaryRight!(operator.op));
1135 
1136         static if(__traits(compiles, inParams!T))
1137             alias parameters = inParams!T;
1138         else
1139             alias parameters = void;
1140 
1141         static if(is(typeof(T.init.opBinaryRight!(operator.op)(parameters.init)): bool)) {
1142             return noThrowable!({
1143 
1144                 static assert(parameters.length == 1, "opBinaryRight!in must have one parameter");
1145                 alias Arg = parameters[0];
1146 
1147                 auto this_ = lhs.to!T;
1148                 auto dArg  = rhs.to!Arg;
1149 
1150                 const ret = this_.opBinaryRight!(operator.op)(dArg);
1151                 // See https://docs.python.org/3/c-api/sequence.html#c.PySequence_Contains
1152                 return ret ? 1 : 0;
1153             });
1154         } else {
1155             // Error. See https://docs.python.org/3/c-api/sequence.html#c.PySequence_Contains
1156             return -1;
1157         }
1158     }
1159 
1160     static extern(C) PyObject* _py_bin_func(PyObject* lhs, PyObject* rhs) nothrow {
1161         return _py_ter_func(lhs, rhs, null);
1162     }
1163 
1164     // Should only be for `^^` because in Python the function is ternary
1165     static extern(C) PyObject* _py_ter_func(PyObject* lhs_, PyObject* rhs_, PyObject* extra) nothrow {
1166         import python.conv.python_to_d: to;
1167         import python.conv.d_to_python: toPython;
1168         import mirror.meta.traits: BinOpDir, functionName;
1169         import std.traits: Parameters;
1170         import std.exception: enforce;
1171         import std.conv: text;
1172 
1173         return noThrowable!({
1174 
1175             PyObject* self, pArg;
1176 
1177             if(lhs_.isInstanceOf!T) {
1178                 self = lhs_;
1179                 pArg = rhs_;
1180             } else if(rhs_.isInstanceOf!T) {
1181                 self = rhs_;
1182                 pArg = lhs_;
1183             } else
1184                 throw new Exception("Neither lhs or rhs were of type " ~ T.stringof);
1185 
1186             PyObject* impl(BinOpDir dir)() {
1187 
1188                 enum funcName = functionName(dir);
1189 
1190                 static if(operator.dirs & dir) {
1191                     mixin(`alias parameters = Parameters!(T.init.`, funcName, `!(operator.op));`);
1192                     static assert(parameters.length == 1, "Binary operators must take one parameter");
1193                     alias Arg = parameters[0];
1194 
1195                     auto this_ = self.to!T;
1196                     auto dArg  = pArg.to!Arg;
1197                     mixin(`return this_.`, funcName, `!(operator.op)(dArg).toPython;`);
1198                 } else
1199                     throw new Exception(text(T.stringof, " does not support ", funcName, " with self on ", dir));
1200             }
1201 
1202             if(lhs_.isInstanceOf!T)   // self is on the left hand side
1203                 return impl!(BinOpDir.left);
1204             else if(rhs_.isInstanceOf!T)   // self is on the right hand side
1205                 return impl!(BinOpDir.right);
1206             else
1207                 throw new Exception("Neither lhs or rhs were of type " ~ T.stringof);
1208         });
1209     }
1210 }
1211 
1212 private template PythonAssignOperator(T, string op) {
1213 
1214     static extern(C) PyObject* _py_bin_func(PyObject* lhs, PyObject* rhs) nothrow {
1215         return _py_ter_func(lhs, rhs, null);
1216     }
1217 
1218     // Should only be for `^^` because in Python the function is ternary
1219     static extern(C) PyObject* _py_ter_func(PyObject* lhs, PyObject* rhs, PyObject* extra) nothrow {
1220         import python.conv.python_to_d: to;
1221         import python.conv.d_to_python: toPython;
1222         import std.traits: Parameters;
1223 
1224         PyObject* impl() {
1225             alias parameters = Parameters!(T.init.opOpAssign!op);
1226             static assert(parameters.length == 1, "Assignment operators must take one parameter");
1227 
1228             auto dObj = lhs.to!T;
1229             dObj.opOpAssign!op(rhs.to!(parameters[0]));
1230             return dObj.toPython;
1231         }
1232 
1233         return noThrowable!impl;
1234     }
1235 }
1236 
1237 
1238 private template PythonOpCmp(T) {
1239     static extern(C) PyObject* _py_cmp(PyObject* lhs, PyObject* rhs, int opId) nothrow {
1240         import python.raw: Py_LT, Py_LE, Py_EQ, Py_NE, Py_GT, Py_GE;
1241         import python.conv.python_to_d: to;
1242         import python.conv.d_to_python: toPython;
1243         import std.conv: text;
1244         import std.traits: Unqual, Parameters;
1245 
1246         return noThrowable!({
1247 
1248             alias parameters = Parameters!(T.opCmp);
1249             static assert(parameters.length == 1, T.stringof ~ ".opCmp must have exactly one parameter");
1250 
1251             const cmp = lhs.to!(Unqual!T).opCmp(rhs.to!(Unqual!(parameters[0])));
1252 
1253             const dRes = {
1254                 switch(opId) {
1255                     default: throw new Exception(text("Unknown opId for opCmp: ", opId));
1256                     case Py_LT: return cmp < 0;
1257                     case Py_LE: return cmp <= 0;
1258                     case Py_EQ: return cmp == 0;
1259                     case Py_NE: return cmp !=0;
1260                     case Py_GT: return cmp > 0;
1261                     case Py_GE: return cmp >=0;
1262                 }
1263             }();
1264 
1265             return dRes.toPython;
1266        });
1267     }
1268 }
1269 
1270 
1271 private template PythonSubscript(T) {
1272 
1273     static extern(C) PyObject* _py_index(PyObject* self, PyObject* key) nothrow {
1274         import python.raw: pyIndexCheck, pySliceCheck, PyObject_Repr, PyObject_Length,
1275             Py_ssize_t, PySlice_GetIndices;
1276         import python.conv.python_to_d: to;
1277         import python.conv.d_to_python: toPython;
1278         import std.traits: Parameters, Unqual, hasMember, fullyQualifiedName;
1279         import std.meta: Filter, AliasSeq;
1280 
1281         PyObject* impl() {
1282             static if(!hasMember!(T, "opIndex") && !hasMember!(T, "opSlice")) {
1283                 throw new Exception(fullyQualifiedName!T ~ " has no opIndex or opSlice");
1284             } else {
1285                 if(pyIndexCheck(key)) {
1286                     static if(__traits(compiles, Parameters!(T.opIndex))) {
1287                         alias parameters = Parameters!(T.opIndex);
1288                         static if(parameters.length == 1)
1289                             return self.to!(Unqual!T).opIndex(key.to!(parameters[0])).toPython;
1290                         else
1291                             throw new Exception("Don't know how to handle opIndex with more than one parameter");
1292                     }
1293                 } else if(pySliceCheck(key)) {
1294 
1295                     enum hasTwoParams(alias F) = Parameters!F.length == 2;
1296 
1297                     static if(!hasMember!(T, "opSlice")) {
1298                         throw new Exception(fullyQualifiedName!T ~ " has no opSlice");
1299                     } else {
1300 
1301                         alias twoParamOpSlices = Filter!(hasTwoParams, __traits(getOverloads, T, "opSlice"));
1302 
1303                         static if(twoParamOpSlices.length > 0) {
1304 
1305                             static assert(twoParamOpSlices.length == 1);
1306                             alias opSlice = twoParamOpSlices[0];
1307 
1308                             const len = PyObject_Length(self);
1309                             Py_ssize_t start, stop, step;
1310                             const indicesRet = PySlice_GetIndices(key, len, &start, &stop, &step);
1311 
1312                             if(indicesRet < 0)
1313                                 throw new Exception("Could not get slice indices for key '" ~ PyObject_Repr(key).to!string ~ "'");
1314 
1315                             if(step != 1)
1316                                 throw new Exception("Slice steps other than 1 not supported in D: " ~ PyObject_Repr(key).to!string);
1317 
1318                             auto dObj = self.to!T;
1319                             return dObj[start .. stop].toPython;
1320 
1321                         } else {
1322                             throw new Exception(T.stringof ~ " cannot be sliced by " ~ PyObject_Repr(key).to!string);
1323                         }
1324 
1325                         assert(0, "Error in slicing " ~ T.stringof ~ " with " ~ PyObject_Repr(key).to!string);
1326                     }
1327                 } else
1328                     throw new Exception(T.stringof ~ " failed pyIndexCheck and pySliceCheck for key '" ~ PyObject_Repr(key).to!string ~ "'");
1329                 assert(0);
1330             }
1331         }
1332 
1333         return noThrowable!impl;
1334     }
1335 }
1336 
1337 
1338 /**
1339    Implement a Python iterator for D type T.
1340    We get a D slice from it, convert it to a Python list,
1341    then return its iterator.
1342  */
1343 private template PythonIterViaList(T) {
1344 
1345     static extern(C) PyObject* _py_iter(PyObject* self) nothrow {
1346         import python.raw: PyObject_GetIter;
1347         import python.conv.d_to_python: toPython;
1348         import python.conv.python_to_d: to;
1349         import std.array: array;
1350         import std.traits: fullyQualifiedName;
1351 
1352         PyObject* impl() {
1353             static if(__traits(compiles, T.init[].array[0])) {
1354                 auto dObj = self.to!T;
1355                 auto list = dObj[].array.toPython;
1356                 return PyObject_GetIter(list);
1357             } else {
1358                 throw new Exception("Cannot get an array from " ~ fullyQualifiedName!T ~ "[]");
1359             }
1360         }
1361 
1362         return noThrowable!impl;
1363     }
1364 }
1365 
1366 
1367 /**
1368    Implement a Python iterator based on a D range.
1369  */
1370 private template PythonIter(T) if(isInputRange!T)
1371 {
1372     static extern(C) PyObject* _py_iter(PyObject* self) nothrow {
1373         return self;
1374     }
1375 
1376     static extern(C) PyObject* _py_iter_next(PyObject* self) nothrow {
1377         import python.raw: PyErr_SetNone, PyExc_StopIteration;
1378         import python.conv: to, toPython;
1379 
1380         auto impl() {
1381             auto dObj = self.to!T;
1382 
1383             if(dObj.empty) {
1384                 PyErr_SetNone(PyExc_StopIteration);
1385                 return null;
1386             }
1387 
1388             dObj.popFront;
1389             auto newSelf = dObj.toPython;
1390             *self = *newSelf;
1391             auto ret = dObj.front.toPython;
1392             return ret;
1393         }
1394 
1395         return noThrowable!impl;
1396     }
1397 }
1398 
1399 
1400 private template PythonIndexAssign(T) {
1401 
1402     static extern(C) int _py_index_assign(PyObject* self, PyObject* key, PyObject* val) nothrow {
1403 
1404         import python.conv.python_to_d: to;
1405         import python.conv.d_to_python: toPython;
1406         import python.raw: pyIndexCheck, pySliceCheck, PyObject_Repr, PyObject_Length, PySlice_GetIndices, Py_ssize_t;
1407         import std.traits: Parameters, Unqual;
1408         import std.conv: to;
1409         import std.meta: Filter, AliasSeq;
1410 
1411         int impl() {
1412             if(pyIndexCheck(key)) {
1413                 static if(__traits(compiles, Parameters!(T.opIndexAssign))) {
1414                     alias parameters = Parameters!(T.opIndexAssign);
1415                     static if(parameters.length == 2) {
1416                         auto dObj = self.to!(Unqual!T);
1417                         dObj.opIndexAssign(val.to!(parameters[0]), key.to!(parameters[1]));
1418                         mutateSelf(self, dObj);
1419                         return 0;
1420                     } else
1421                         //throw new Exception("Don't know how to handle opIndex with more than one parameter");
1422                         return -1;
1423                 } else
1424                     return -1;
1425             } else if(pySliceCheck(key)) {
1426 
1427                 enum hasThreeParams(alias F) = Parameters!F.length == 3;
1428                 alias threeParamOps = Filter!(hasThreeParams,
1429                                               AliasSeq!(
1430                                                   __traits(getOverloads, T, "opIndexAssign"),
1431                                                   __traits(getOverloads, T, "opSliceAssign"),
1432                                               )
1433                 );
1434 
1435                 static if(threeParamOps.length > 0) {
1436 
1437                     static assert(threeParamOps.length == 1);
1438                     alias opIndexAssign = threeParamOps[0];
1439                     alias parameters = Parameters!opIndexAssign;
1440 
1441                     const len = PyObject_Length(self);
1442                     Py_ssize_t start, stop, step;
1443                     const indicesRet = PySlice_GetIndices(key, len, &start, &stop, &step);
1444 
1445                     if(indicesRet < 0)
1446                         return -1;
1447 
1448                     if(step != 1)
1449                         return -1;
1450 
1451                     auto dObj = self.to!(Unqual!T);
1452                     mixin(`dObj.`, __traits(identifier, opIndexAssign), `(val.to!(parameters[0]), start, stop);`);
1453                     mutateSelf(self, dObj);
1454                     return 0;
1455                 } else {
1456                     return -1;
1457                 }
1458             } else
1459                 return -1;
1460         }
1461 
1462         return noThrowable!impl;
1463     }
1464 }
1465 
1466 private bool isInstanceOf(T)(PyObject* obj) {
1467     import python.raw: PyObject_IsInstance;
1468     return cast(bool) PyObject_IsInstance(obj, cast(PyObject*) PythonType!T.pyType);
1469 }
1470 
1471 
1472 private bool checkPythonType(T)(PyObject* value) if(isArray!T) {
1473     import python.raw: pySequenceCheck;
1474     const ret = pySequenceCheck(value);
1475     if(!ret) setPyErrTypeString!"sequence";
1476     return ret;
1477 }
1478 
1479 
1480 private bool checkPythonType(T)(PyObject* value) if(isIntegral!T) {
1481     import python.raw: pyIntCheck, pyLongCheck;
1482     const ret = pyLongCheck(value) || pyIntCheck(value);
1483     if(!ret) setPyErrTypeString!"long";
1484     return ret;
1485 }
1486 
1487 
1488 private bool checkPythonType(T)(PyObject* value) if(isFloatingPoint!T) {
1489     import python.raw: pyFloatCheck;
1490     const ret = pyFloatCheck(value);
1491     if(!ret) setPyErrTypeString!"float";
1492     return ret;
1493 }
1494 
1495 
1496 private bool checkPythonType(T)(PyObject* value) if(is(T == DateTime)) {
1497     import python.raw: pyDateTimeCheck;
1498     const ret = pyDateTimeCheck(value);
1499     if(!ret) setPyErrTypeString!"DateTime";
1500     return ret;
1501 }
1502 
1503 
1504 private bool checkPythonType(T)(PyObject* value) if(is(T == Date)) {
1505     import python.raw: pyDateCheck;
1506     const ret = pyDateCheck(value);
1507     if(!ret) setPyErrTypeString!"Date";
1508     return ret;
1509 }
1510 
1511 
1512 private bool checkPythonType(T)(PyObject* value) if(isAssociativeArray!T) {
1513     import python.raw: pyMappingCheck;
1514     const ret = pyMappingCheck(value);
1515     if(!ret) setPyErrTypeString!"dict";
1516     return ret;
1517 }
1518 
1519 
1520 private bool checkPythonType(T)(PyObject* value) if(isUserAggregate!T) {
1521     return true;  // FIXMME
1522 }
1523 
1524 
1525 private bool checkPythonType(T)(PyObject* value) if(isSomeFunction!T) {
1526     import python.raw: pyCallableCheck;
1527     const ret = pyCallableCheck(value);
1528     if(!ret) setPyErrTypeString!"callable";
1529     return ret;
1530 }
1531 
1532 
1533 private void setPyErrTypeString(string type)() @trusted @nogc nothrow {
1534     import python.raw: PyErr_SetString, PyExc_TypeError;
1535     enum str = "must be a " ~ type;
1536     PyErr_SetString(PyExc_TypeError, &str[0]);
1537 }
1538 
1539 // Generalises T.init for classes since null isn't a value we want to use
1540 T userAggregateInit(T)() {
1541     static if(is(T == class)) {
1542         auto buffer = new void[__traits(classInstanceSize, T)];
1543         // this is needed for the vtable to work
1544         buffer[] = typeid(T).initializer[];
1545         return cast(T) buffer.ptr;
1546     } else
1547         return T.init;
1548 }