| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
/* You may distribute under the terms of either the GNU General Public License |
|
2
|
|
|
|
|
|
|
* or the Artistic License (the same terms as Perl itself) |
|
3
|
|
|
|
|
|
|
* |
|
4
|
|
|
|
|
|
|
* (C) Paul Evans, 2024 -- leonerd@leonerd.org.uk |
|
5
|
|
|
|
|
|
|
*/ |
|
6
|
|
|
|
|
|
|
#define PERL_NO_GET_CONTEXT |
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
#include "EXTERN.h" |
|
9
|
|
|
|
|
|
|
#include "perl.h" |
|
10
|
|
|
|
|
|
|
#include "XSUB.h" |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
#include "XSParseInfix.h" |
|
13
|
|
|
|
|
|
|
|
|
14
|
5
|
|
|
|
|
|
static OP *new_op_lexmeth(pTHX_ U32 flags, OP *lhs, OP *rhs, SV **parsedata, void *hookdata) |
|
15
|
|
|
|
|
|
|
{ |
|
16
|
|
|
|
|
|
|
/* LHS can be any ol' expression as the invocant, that's fine */ |
|
17
|
|
|
|
|
|
|
OP *invocant = lhs; |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
/* RHS must be an OP_ENTERSUB whose final kid is an OP_PADCV */ |
|
20
|
5
|
100
|
|
|
|
|
if(rhs->op_type != OP_ENTERSUB) |
|
21
|
1
|
|
|
|
|
|
croak("Expected ->& to see a method call on RHS"); |
|
22
|
|
|
|
|
|
|
|
|
23
|
4
|
|
|
|
|
|
OP *args = cUNOPx(rhs)->op_first; |
|
24
|
|
|
|
|
|
|
/* This should be an OP_LIST or a nulled-out ex-list */ |
|
25
|
4
|
50
|
|
|
|
|
if(!(args->op_type == OP_LIST || (args->op_type == OP_NULL && args->op_targ == OP_LIST))) |
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
26
|
0
|
|
|
|
|
|
croak("ARGH expected to find list of args for OP_ENTERSUB"); |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
/* args should be a LIST whose first is OP_PUSHMARK and last is an OP_PADCV */ |
|
29
|
4
|
|
|
|
|
|
OP *pushmark = cLISTOPx(args)->op_first; |
|
30
|
4
|
50
|
|
|
|
|
if(pushmark->op_type != OP_PUSHMARK) |
|
31
|
0
|
|
|
|
|
|
croak("ARGH expected to find an OP_PUSHMARK as first arg"); |
|
32
|
|
|
|
|
|
|
|
|
33
|
4
|
|
|
|
|
|
OP *rv2cvop = cLISTOPx(args)->op_last; |
|
34
|
4
|
50
|
|
|
|
|
if(rv2cvop->op_type != OP_NULL || rv2cvop->op_targ != OP_RV2CV) |
|
|
|
50
|
|
|
|
|
|
|
35
|
0
|
|
|
|
|
|
croak("ARGH expected to find a NULL (ex-RV2CV)"); |
|
36
|
4
|
|
|
|
|
|
OP *cvop = cUNOPx(rv2cvop)->op_first; |
|
37
|
4
|
100
|
|
|
|
|
if(cvop->op_type != OP_PADCV) |
|
38
|
1
|
|
|
|
|
|
croak("Expected a lexical function call on RHS of ->&"); |
|
39
|
|
|
|
|
|
|
|
|
40
|
3
|
50
|
|
|
|
|
bool has_args = OpSIBLING(pushmark) != rv2cvop; |
|
41
|
3
|
100
|
|
|
|
|
if(has_args && rv2cvop->op_private & OPpENTERSUB_NOPAREN) |
|
|
|
100
|
|
|
|
|
|
|
42
|
1
|
|
|
|
|
|
croak("Lexical method call ->& with arguments must use parentheses"); |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
/* TODO: Assert that the CV of the lastarg is definitely a `my method` and |
|
45
|
|
|
|
|
|
|
* not simply `my sub`. But for that we'll first have to accept `my method` |
|
46
|
|
|
|
|
|
|
* as sub syntax. |
|
47
|
|
|
|
|
|
|
*/ |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
/* All seems well; now just splice the invocant expression to be the first |
|
50
|
|
|
|
|
|
|
* argument after the pushmark |
|
51
|
|
|
|
|
|
|
*/ |
|
52
|
2
|
|
|
|
|
|
op_sibling_splice(args, pushmark, 0, invocant); |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
/* The overall result is now simply the modified OP_ENTERSUB on the RHS */ |
|
55
|
2
|
|
|
|
|
|
return rhs; |
|
56
|
|
|
|
|
|
|
} |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
static const struct XSParseInfixHooks hooks_lexmeth = { |
|
59
|
|
|
|
|
|
|
.cls = XPI_CLS_HIGH_MISC, |
|
60
|
|
|
|
|
|
|
.new_op = &new_op_lexmeth, |
|
61
|
|
|
|
|
|
|
}; |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
MODULE = Object::Pad::LexicalMethods PACKAGE = Object::Pad::LexicalMethods |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
BOOT: |
|
66
|
3
|
|
|
|
|
|
boot_xs_parse_infix(0.44); |
|
67
|
|
|
|
|
|
|
|
|
68
|
3
|
|
|
|
|
|
register_xs_parse_infix("Object::Pad::LexicalMethods::->&", &hooks_lexmeth, NULL); |