Skip to content

Commit 72c70bf

Browse files
committed
Support passing callables between Python and Perl
1 parent 71ee63c commit 72c70bf

File tree

3 files changed

+118
-14
lines changed

3 files changed

+118
-14
lines changed

lib/Inline/Python.pm6

Lines changed: 64 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
class Inline::Python;
22

3+
has &!call_object;
34
has &!call_method;
45

56
use NativeCall;
@@ -50,9 +51,12 @@ class ObjectKeeper {
5051
}
5152
}
5253

53-
sub py_init_python(&call_method(Int, Str, OpaquePointer, OpaquePointer --> OpaquePointer))
54+
sub py_init_python(&call_object(Int, OpaquePointer, OpaquePointer --> OpaquePointer), &call_method(Int, Str, OpaquePointer, OpaquePointer --> OpaquePointer))
5455
{ ... }
5556
native(&py_init_python);
57+
sub py_init_perl6object()
58+
{ ... }
59+
native(&py_init_perl6object);
5660
sub py_eval(Str, Int)
5761
returns OpaquePointer { ... }
5862
native(&py_eval);
@@ -80,6 +84,9 @@ sub py_sequence_check(OpaquePointer)
8084
sub py_mapping_check(OpaquePointer)
8185
returns int32 { ... }
8286
native(&py_mapping_check);
87+
sub py_callable_check(OpaquePointer)
88+
returns int32 { ... }
89+
native(&py_callable_check);
8390
sub py_is_none(OpaquePointer)
8491
returns int32 { ... }
8592
native(&py_is_none);
@@ -183,7 +190,7 @@ method py_to_p6(OpaquePointer $value) {
183190
if py_is_none($value) {
184191
return Any;
185192
}
186-
elsif py_instance_check($value) {
193+
elsif py_instance_check($value) or py_callable_check($value) {
187194
if py_is_instance($value, $perl6object) {
188195
return $objects.get(
189196
py_int_as_long(
@@ -319,6 +326,18 @@ method invoke(OpaquePointer $obj, Str $method, *@args) {
319326
}
320327

321328
method BUILD {
329+
&!call_object = sub (Int $index, OpaquePointer $args, OpaquePointer $err) returns OpaquePointer {
330+
my $p6obj = $objects.get($index);
331+
my \retvals = $p6obj(|self.py_array_to_array($args));
332+
return self.p6_to_py(retvals);
333+
CATCH {
334+
default {
335+
warn $_;
336+
nativecast(CArray[OpaquePointer], $err)[0] = self.p6_to_py($_);
337+
return OpaquePointer;
338+
}
339+
}
340+
}
322341
&!call_method = sub (Int $index, Str $name, OpaquePointer $args, OpaquePointer $err) returns OpaquePointer {
323342
my $p6obj = $objects.get($index);
324343
my @retvals = $p6obj."$name"(|self.py_array_to_array($args));
@@ -331,18 +350,23 @@ method BUILD {
331350
}
332351
}
333352

334-
py_init_python(&!call_method);
353+
py_init_python(&!call_object, &!call_method);
335354

336355
self.run(q:heredoc/PYTHON/);
337-
import perl6
338-
class Perl6Object:
339-
def __init__(self, index):
340-
self.index = index
341-
def get_perl6_object(self):
342-
return self.index
343-
def __getattr__(self, attr):
344-
return lambda *args: perl6.invoke(self.index, attr, args)
345-
PYTHON
356+
import perl6
357+
from logging import warn
358+
class Perl6Object:
359+
def __init__(self, index):
360+
self.index = index
361+
def get_perl6_object(self):
362+
return self.index
363+
def __call__(self, *args):
364+
return perl6.call(self.index, args)
365+
def __getattr__(self, attr):
366+
return lambda *args: perl6.invoke(self.index, attr, args)
367+
PYTHON
368+
369+
py_init_perl6object();
346370

347371
$perl6object = py_eval('Perl6Object', 0);
348372
}
@@ -353,15 +377,42 @@ class PythonObject {
353377

354378
method sink() { self }
355379

380+
method postcircumfix:<( )>(\args) {
381+
$.python.invoke($.ptr, '__call__', args.list);
382+
}
383+
384+
method invoke(\args) {
385+
$.python.invoke($.ptr, '__call__', args.list);
386+
}
387+
356388
method DESTROY {
357389
$!python.py_dec_ref($!ptr) if $!ptr;
358390
$!ptr = OpaquePointer;
359391
}
360392
}
361393

394+
role PythonParent[$package, $class] {
395+
has $.parent;
396+
has $.python;
397+
398+
submethod BUILD(:$python, :$parent?) {
399+
$!parent = $parent // $python.call($package, $class);
400+
$!python = $python;
401+
#$python.rebless($!parent);
402+
}
403+
404+
::?CLASS.HOW.add_fallback(::?CLASS, -> $, $ { True },
405+
method ($name) {
406+
-> \self, |args {
407+
$.python.invoke(self, $.parent.ptr, $name, args.list);
408+
}
409+
}
410+
);
411+
}
412+
362413
BEGIN {
363414
PythonObject.^add_fallback(-> $, $ { True },
364-
method ($name ) {
415+
method ($name) {
365416
-> \self, |args {
366417
$.python.invoke($.ptr, $name, args.list);
367418
}

pyhelper.c

Lines changed: 24 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,15 +2,17 @@
22

33
void initperl6(void);
44

5+
PyObject *(*call_p6_object)(int, PyObject *, PyObject **);
56
PyObject *(*call_p6_method)(int, char * , PyObject *, PyObject **);
67

7-
void py_init_python(PyObject *(*call_method)(int, char * , PyObject *, PyObject **)) {
8+
void py_init_python(PyObject *(*call_object)(int, PyObject *, PyObject **), PyObject *(*call_method)(int, char * , PyObject *, PyObject **)) {
89
/* sometimes Python needs to know about argc and argv to be happy */
910
int _python_argc = 1;
1011
char *_python_argv[] = {
1112
"python",
1213
};
1314

15+
call_p6_object = call_object;
1416
call_p6_method = call_method;
1517

1618
Py_SetProgramName("python");
@@ -21,6 +23,14 @@ void py_init_python(PyObject *(*call_method)(int, char * , PyObject *, PyObject
2123
PySys_SetArgv(_python_argc, _python_argv); /* Tk needs this */
2224
}
2325

26+
PyObject *perl6object;
27+
28+
void py_init_perl6object() {
29+
PyObject *main_module = PyImport_AddModule("__main__");
30+
PyObject *globals = PyModule_GetDict(main_module);
31+
perl6object = PyDict_GetItemString(globals, "Perl6Object");
32+
}
33+
2434
PyObject *py_eval(const char* p, int type) {
2535
PyObject * main_module;
2636
PyObject * globals;
@@ -81,6 +91,10 @@ int py_mapping_check(PyObject *obj) {
8191
return PyMapping_Check(obj);
8292
}
8393

94+
int py_callable_check(PyObject *obj) {
95+
return PyFunction_Check(obj) || PyMethod_Check(obj);
96+
}
97+
8498
int py_is_none(PyObject *obj) {
8599
return obj == Py_None;
86100
}
@@ -201,6 +215,14 @@ PyObject *py_call_method(PyObject *obj, char *name, PyObject *args) {
201215
return py_retval;
202216
}
203217

218+
static PyObject *perl6_call(PyObject *self, PyObject *args) {
219+
PyObject * const index = PySequence_GetItem(args, 0);
220+
PyObject * const params = PySequence_GetItem(args, 1);
221+
222+
PyObject *retval = call_p6_object(PyInt_AsLong(index), params, NULL);
223+
return retval;
224+
}
225+
204226
static PyObject *perl6_invoke(PyObject *self, PyObject *args) {
205227
PyObject * const index = PySequence_GetItem(args, 0);
206228
PyObject * const name = PySequence_GetItem(args, 1);
@@ -217,6 +239,7 @@ static PyObject *perl6_invoke(PyObject *self, PyObject *args) {
217239
}
218240

219241
static PyMethodDef perl_functions[] = {
242+
{"call", perl6_call, METH_VARARGS, PyDoc_STR("invoke(object, *args) -> retval")},
220243
{"invoke", perl6_invoke, METH_VARARGS, PyDoc_STR("invoke(object, method_name, *args) -> retval")},
221244
{NULL, NULL} /* sentinel */
222245
};

t/callables.t

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
#!/usr/bin/env perl6
2+
3+
use v6;
4+
use Test;
5+
use Inline::Python;
6+
use NativeCall;
7+
8+
plan 3;
9+
10+
my $py = Inline::Python.new();
11+
12+
$py.run(q:heredoc/PYTHON/);
13+
import logging
14+
def call_something(something, param):
15+
return something(param)
16+
17+
def return_code(name):
18+
return lambda param: "%s %s" % (name, param)
19+
PYTHON
20+
21+
sub something($suffix) {
22+
return 'Perl ' ~ $suffix;
23+
}
24+
25+
is $py.call('__main__', 'call_something', &something, 6), 'Perl 6';
26+
is $py.call('__main__', 'return_code', 'Perl')(5), 'Perl 5';
27+
my $sub = $py.call('__main__', 'return_code', 'Foo');
28+
is $py.call('__main__', 'call_something', $sub, 1), 'Foo 1';
29+
30+
# vim: ft=perl6

0 commit comments

Comments
 (0)