perl_callback
meta that we imlepment in this module arranges does this. Its input is an instance of
pliant's Function data type, and its output is an SV that is a callback (CV). It also allows
in some cases a shortcut to specify pliant function name instead of the Function datatype insance.
Here is an example,
function non_perl_aware i j k -> r arg Str i j ; arg Int k ; arg Str r console i j k eol r := 10function somewhat_perl_aware obj i j -> r arg PerlScalar obj ; arg Int i j r obj dump #call method on perl object console i j eol r := 20
perl "iterate_over_datastructure" wx_callback:non_perl_aware perl "iterate_another_datastructure" wx_callback:somewhat_perl_aware
In order to implement such comfortabile usage, we need to work step by step. The first step is to make functions of the following form available as callbacks to perl. These functions receive and return a perl array.
The second step is for each non perl aware pliant function to create a perl aware wrapper function of above form.function perl_aware args -> retval arg PerlArray args retval var PerlScalar arg1 := args 0 var PerlScalar arg2 := args 1 # do stuff with arg1 and arg2 # set retvalue by filling up the retval array retval 0 := 10
newXS
function under
some name and the call must be made by that explicit name. There are two problems
with this. First, we want the callback to be anonymous to the calling function,
therefore the caller can not call a variable function name.
Second, we want to pass as callbacks many different functions.
The solution to both issues is to wrap the address to the callback
in anonymous perl subroutine. This anonymous subroutine calls a pliant function
declared with newXS
using an explicit name pliant_generate_callback_
and pass the callback address to it as a first argument.
The actual details are as follows,
<init-gen-callback>= (U->) perl_eval {{ sub pliant_generate_callback_ { my $address = shift; return sub { push @_, $address; pliant_call_function_(); }; \}}}
Note that we push the address onto the special array @_
, which will be
visible to the pliant_call_function_
. Not sure why the argument propagates like that.
I think it has to do with the fact that pliant_call_function_
is an XS subroutine.
Please feel free to send feedback regarding this issue.
pliant_callback_explicit
first, which convertes
a Function
type to a perl callback. Later, we implement
perl_callback
which allows shortcuts.
<callback.pli>= module "/pliant/language/unsafe.pli" module "/pliant/language/compiler.pli" module "/pliantx/lexer/multiline_string.pli" module "cperl.pli" module "call.pli" module "interpreter.pli" module "types/scalar.pli" module "types/list.pli" module "types/array.pli" module "types/hash.pli" function perl_callback_explicit callback -> closure arg Function callback arg PerlScalar closure closure := perl pliant_generate_callback_ address_to_int:(addressof:callback) <perl-callback-meta> <perl-define-meta> <callback-helper> <perl-function-meta> function 'initialize callback module' p fh arg Address p ; arg Int fh perl_prepare <init-gen-callback> <init-define-meta-helper> <init-XS> 'initialize callback module' null 0 gvar DelayedAction restore restore function :> the_function 'initialize callback module' Address Int pliant_restore_actions append addressof:restore
And this is the code to register the XS function pliant_call_function_
(the code is executed in the global block),
<callback-helper>= (<-U) <callback-signature> <callback-wrapper>
<init-XS>= (<-U) lperl_newXS "pliant_call_function_" (the_function 'pliant-perl callback wrapper' Address Address):executable ""
Note that on the pliant end the function is called pliant-perl callback wrapper
(note: We have used the single quotes to allow spaces in the function name.).
Choosing a name like this helps to avoid clashes with any user-defined name.
The Perl XS API requires that an XS function recieves two arguments -- the
current interpreter and the CV object that corresponds to the XS function.
This function must pop the last argument which will be a function address.
<callback-wrapper>= (<-U) [D->] function 'pliant-perl callback wrapper' interpreter cv arg Address interpreter arg Address cv varargs_calling_convention var PerlArray array array set_from_name "_" # the special array @_ magically has the right stuff var Int num_arguments := array:size var Int tmp_address := array:pop var Address address := (addressof:tmp_address map Address) # force cast lperl_POPMARK <call-callback> <install-retvalue>
This is somewhat of a hack, but we need to export this function in order to lock it in memory. Otherwise it gets freed too early and we get a segmentation fault when we try to call it.
<callback-wrapper>+= (<-U) [<-D] export 'pliant-perl callback wrapper'
What remains is to implement calling the callback. We must know the signature
(prototype) of a function in order to call it. The user callback receives
one argument, the @_
array in the form of PerlArray
object.
<callback-signature>= (<-U) function 'pliant-perl callback signature' arguments f -> retval arg_rw PerlArray arguments arg Function f arg PerlArray retval indirect
The ``f'' argument is not part of the callback signature, but it is there because thats
how callbacks in Pliant work (note: the indirect
keyword does all the work. It's somewhat of hack).
Calling the callback is then like this,
where `callback' must be of typeretval := 'pliant-perl callback signature' array callback
Function
. Here is the precise code that is
appended to the end of pliant-perl callback wrapper
.
<call-callback>= (<-U) var Pointer:Function callback :> address map Function var PerlArray retval retval := 'pliant-perl callback signature' array callback
We must also handle the return value from our function by putting it on the stack. Note that the EXTEND call below makes space for the return values to be pushed on the stack.
<install-retvalue>= (<-U) #pre: retval contains return value(s) var Address sp := lperl__GET_STACK_SP lperl_EXTEND sp sp retval:size for (var Int index) 0 retval:size-1 var PerlScalar scalar := retval:index scalar _mortalize # increment ref count; decrement will automatically occur when Perl leaves scope lperl_XPUSHs sp scalar:sv lperl__SET_STACK_SP sp
Make it nice
We would like to make it easy for the user to pass Pliant callbacks to perl.
First, above we have implemented perl_callback_explicit
which must receive
a function pointer of the form (the_function Name PerlArray->PerlArray)
but we want
to remove this extra syntax. If an argument to perl_callback
is an
identifier Name
, we find the corresponding the_function
. However,
if (the_function ...)
is already given, we don't do extra work.
<perl-callback-meta>= (<-U) meta perl_callback e if e:size <> 1 return var Link:Expression func_expr if e:0:is_pure_ident func_expr :> expression immediat { (the_function x PerlArray -> PerlArray) } substitute x e:0 else func_expr :> e:0 var Link:Expression newexpr :> expression ident "perl_callback_explicit" subexpressions func_expr e compile_as newexpr export perl_callback_explicit perl_callback
We need to export perl_callback_explict
because we are compiling the new
expression in the users space, and we are using perl_callback_explicit
there.
In the same spirit we make an ``explict'' version and a meta wrapper version.
<init-define-meta-helper>= (<-U) perl_eval {{ sub pliant_define_function { my($name, $sub) = @_; *{$name} = $sub; \}}}
<perl-define-meta>= (<-U) [D->] function perl_define_explicit name func arg Function func arg Str namevar PerlScalar sub := perl_callback_explicit func perl pliant_define_function name sub
The define meta follows. TODO{ In the future it would be good to allow absence of the first parameter, in which case it will be assumed to be the ``main'' package }.
<perl-define-meta>+= (<-U) [<-D] meta perl_define e if e:size <> 2 return var Link:Expression func_expr if e:1:is_pure_ident func_expr :> expression immediat { (the_function x PerlArray -> PerlArray) } substitute x e:1 else func_expr :> e:1 var Link:Expression newexpr :> expression ident "perl_define_explicit" subexpressions e:0 func_expr e compile_as newexpr export perl_define_explicit perl_define
we can better do this,function call_me_from_perl args -> retval arg PerlArray args retval arg Str arg1 := args 0 arg Int arg2 := args 1 # do stuff with arg1, arg2 retval 0 := 10
This will bring as closer to dissolving the boundary between Pliant and Perl, because the body of the function now knows nothing about perl.perl_function call_me_from_perl arg1 arg2 -> retval arg Str arg1 arg Int arg2 arg Int retval # do stuff with arg1 and arg2 and possibly retval retval := 10
Here is the perl_function
meta,
<perl-function-meta>= (<-U) meta perl_function e if e:size > 0 # we need to figure out if we have a return value, and the number of arguments var Bool have_return_value := false if (e:size - 3) > 0 have_return_value := e:(e:size - 3):ident = "->" var Int num_arguments := shunt have_return_value (e:size - 4) (e:size - 2) var Link:Expression func_mainbody_expr func_mainbody_expr :> expression ident "function" near e subexpressions (e 0 e:size) named_expression wrapper_template function NAME args -> retval arg PerlArray args retval GENCALL # prepare the wrapper function var Link:Expression call_expr :> expression ident e:0:ident near e call_expr:arguments:size := num_arguments for (var Int count) 0 num_arguments-1 var Link:Expression constant_expr :> expression constant count call_expr:arguments:count := addressof (expression immediat args:X substitute X constant_expr) var Link:Expression gencall_expr if have_return_value gencall_expr :> expression ident ":=" near e subexpressions (expression immediat retval:0 near e) call_expr else gencall_expr :> call_expr # replace NAME and GENCALL with the right stuff var Link:Expression wrapper_func :> expression map wrapper_template substitute NAME e:0 substitute GENCALL gencall_expr # now, compile both the real function and the wrapper function e compile_as (expression ident "{}" subexpressions func_mainbody_expr wrapper_func) export perl_function
Using non-perl aware functions as callbacks