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, 2021 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
*/ |
6
|
|
|
|
|
|
|
#include "EXTERN.h" |
7
|
|
|
|
|
|
|
#include "perl.h" |
8
|
|
|
|
|
|
|
#include "XSUB.h" |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
#define HAVE_PERL_VERSION(R, V, S) \ |
11
|
|
|
|
|
|
|
(PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
#include "perl-backcompat.c.inc" |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
#include "newOP_CUSTOM.c.inc" |
16
|
|
|
|
|
|
|
#include "BINOP_ANY.c.inc" |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
#include "XSParseInfix.h" |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
enum Inop_Operator { |
21
|
|
|
|
|
|
|
INOP_CUSTOM, |
22
|
|
|
|
|
|
|
INOP_NUMBER, |
23
|
|
|
|
|
|
|
INOP_STRING, |
24
|
|
|
|
|
|
|
}; |
25
|
|
|
|
|
|
|
|
26
|
4
|
|
|
|
|
|
static OP *pp_in(pTHX) |
27
|
|
|
|
|
|
|
{ |
28
|
4
|
|
|
|
|
|
dSP; |
29
|
8
|
|
|
|
|
|
dMARK; |
30
|
|
|
|
|
|
|
SV **svp; |
31
|
4
|
|
|
|
|
|
enum Inop_Operator type = PL_op->op_private; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
OP cmpop; |
34
|
4
|
|
|
|
|
|
switch(type) { |
35
|
|
|
|
|
|
|
case INOP_CUSTOM: |
36
|
|
|
|
|
|
|
{ |
37
|
0
|
|
|
|
|
|
ANY *op_any = cBINOP_ANY->op_any; |
38
|
0
|
|
|
|
|
|
cmpop.op_type = OP_CUSTOM; |
39
|
0
|
|
|
|
|
|
cmpop.op_flags = 0; |
40
|
0
|
|
|
|
|
|
cmpop.op_ppaddr = op_any[0].any_ptr; |
41
|
0
|
|
|
|
|
|
break; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
case INOP_NUMBER: |
45
|
2
|
|
|
|
|
|
cmpop.op_type = OP_EQ; |
46
|
2
|
|
|
|
|
|
cmpop.op_flags = 0; |
47
|
2
|
|
|
|
|
|
cmpop.op_ppaddr = PL_ppaddr[OP_EQ]; |
48
|
2
|
|
|
|
|
|
break; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
case INOP_STRING: |
51
|
2
|
|
|
|
|
|
cmpop.op_type = OP_SEQ; |
52
|
2
|
|
|
|
|
|
cmpop.op_flags = 0; |
53
|
2
|
|
|
|
|
|
cmpop.op_ppaddr = PL_ppaddr[OP_SEQ]; |
54
|
2
|
|
|
|
|
|
break; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
4
|
|
|
|
|
|
SV *lhs = *MARK; |
58
|
|
|
|
|
|
|
SV **listend = SP; |
59
|
|
|
|
|
|
|
|
60
|
4
|
|
|
|
|
|
SP = MARK - 1; |
61
|
4
|
|
|
|
|
|
PUTBACK; |
62
|
|
|
|
|
|
|
|
63
|
4
|
|
|
|
|
|
ENTER; |
64
|
4
|
|
|
|
|
|
SAVEVPTR(PL_op); |
65
|
4
|
|
|
|
|
|
PL_op = &cmpop; |
66
|
4
|
50
|
|
|
|
|
EXTEND(SP, 2); |
67
|
|
|
|
|
|
|
|
68
|
18
|
100
|
|
|
|
|
for(svp = MARK + 1; svp <= listend; svp++) { |
69
|
16
|
|
|
|
|
|
SV *rhs = *svp; |
70
|
|
|
|
|
|
|
|
71
|
16
|
|
|
|
|
|
PUSHs(lhs); |
72
|
16
|
|
|
|
|
|
PUSHs(rhs); |
73
|
16
|
|
|
|
|
|
PUTBACK; |
74
|
|
|
|
|
|
|
|
75
|
16
|
|
|
|
|
|
(*cmpop.op_ppaddr)(aTHX); |
76
|
|
|
|
|
|
|
|
77
|
16
|
|
|
|
|
|
SPAGAIN; |
78
|
|
|
|
|
|
|
|
79
|
16
|
|
|
|
|
|
SV *ret = POPs; |
80
|
|
|
|
|
|
|
|
81
|
16
|
50
|
|
|
|
|
if(SvTRUE(ret)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
82
|
2
|
|
|
|
|
|
LEAVE; |
83
|
|
|
|
|
|
|
|
84
|
2
|
|
|
|
|
|
PUSHs(&PL_sv_yes); |
85
|
2
|
|
|
|
|
|
RETURN; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
2
|
|
|
|
|
|
LEAVE; |
90
|
|
|
|
|
|
|
|
91
|
2
|
|
|
|
|
|
PUSHs(&PL_sv_no); |
92
|
2
|
|
|
|
|
|
RETURN; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
#ifndef isIDCONT_utf8_safe |
96
|
|
|
|
|
|
|
/* It doesn't really matter that this is not "safe", because the function is |
97
|
|
|
|
|
|
|
* only ever called on perls new enough to have PL_infix_plugin, and in that |
98
|
|
|
|
|
|
|
* case they'll have the _safe version anyway |
99
|
|
|
|
|
|
|
*/ |
100
|
|
|
|
|
|
|
# define isIDCONT_utf8_safe(s, e) isIDCONT_utf8(s) |
101
|
|
|
|
|
|
|
#endif |
102
|
|
|
|
|
|
|
|
103
|
0
|
|
|
|
|
|
static void parse_in(pTHX_ U32 flags, SV **parsedata, void *hookdata) |
104
|
|
|
|
|
|
|
{ |
105
|
|
|
|
|
|
|
bool using_circumfix = false; |
106
|
0
|
0
|
|
|
|
|
if(lex_peek_unichar(0) == '<') |
107
|
|
|
|
|
|
|
using_circumfix = true; |
108
|
0
|
0
|
|
|
|
|
else if(lex_peek_unichar(0) != ':') |
109
|
0
|
|
|
|
|
|
croak("Expected ':' or '<'"); |
110
|
0
|
|
|
|
|
|
lex_read_unichar(0); |
111
|
|
|
|
|
|
|
|
112
|
0
|
|
|
|
|
|
lex_read_space(0); |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
struct XSParseInfixInfo *info; |
115
|
0
|
0
|
|
|
|
|
if(!parse_infix(XPI_SELECT_ANY, &info)) |
116
|
0
|
|
|
|
|
|
croak("Expected an equality test operator"); |
117
|
0
|
0
|
|
|
|
|
if(info->cls != XPI_CLS_EQUALITY) |
118
|
0
|
|
|
|
|
|
croak("The %s operator is not permitted for the in: meta-operator (cls=%d)", info->opname, info->cls); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
/* parsedata will be an AV containing |
121
|
|
|
|
|
|
|
* [0] IV = enum Inop_Operator |
122
|
|
|
|
|
|
|
* [1] UV = PTR to pp_addr if CUSTOM |
123
|
|
|
|
|
|
|
*/ |
124
|
0
|
|
|
|
|
|
AV *parsedata_av = newAV(); |
125
|
0
|
|
|
|
|
|
*parsedata = newRV_noinc((SV *)parsedata_av); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
/* See if we got one of the core ones */ |
128
|
0
|
0
|
|
|
|
|
if(info->opcode == OP_EQ) { |
129
|
0
|
|
|
|
|
|
av_push(parsedata_av, newSViv(INOP_NUMBER)); |
130
|
|
|
|
|
|
|
} |
131
|
0
|
0
|
|
|
|
|
else if(info->opcode == OP_SEQ) { |
132
|
0
|
|
|
|
|
|
av_push(parsedata_av, newSViv(INOP_STRING)); |
133
|
|
|
|
|
|
|
} |
134
|
0
|
0
|
|
|
|
|
else if(info->opcode == OP_CUSTOM) { |
135
|
0
|
0
|
|
|
|
|
if(info->hooks->new_op) |
136
|
0
|
|
|
|
|
|
croak("TODO: handle custom op using the new_op function for '%s'", info->opname); |
137
|
|
|
|
|
|
|
|
138
|
0
|
|
|
|
|
|
av_push(parsedata_av, newSViv(INOP_CUSTOM)); |
139
|
0
|
|
|
|
|
|
av_push(parsedata_av, newSVuv(PTR2UV(info->hooks->ppaddr))); |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
else |
142
|
0
|
|
|
|
|
|
croak("Expected an equality test operator name but found '%s'", info->opname); |
143
|
|
|
|
|
|
|
|
144
|
0
|
0
|
|
|
|
|
if(using_circumfix) { |
145
|
0
|
0
|
|
|
|
|
if(lex_peek_unichar(0) != '>') |
146
|
0
|
|
|
|
|
|
croak("Expected '>'"); |
147
|
0
|
|
|
|
|
|
lex_read_unichar(0); |
148
|
|
|
|
|
|
|
} |
149
|
0
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
0
|
|
|
|
|
|
static OP *newop_in(pTHX_ U32 flags, OP *lhs, OP *rhs, SV **parsedata, void *hookdata) |
152
|
|
|
|
|
|
|
{ |
153
|
0
|
|
|
|
|
|
AV *parsedata_av = AV_FROM_REF(*parsedata); |
154
|
|
|
|
|
|
|
|
155
|
0
|
0
|
|
|
|
|
enum Inop_Operator operator = SvIV(AvARRAY(parsedata_av)[0]); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
OP *ret; |
158
|
0
|
|
|
|
|
|
switch(operator) { |
159
|
|
|
|
|
|
|
case INOP_CUSTOM: |
160
|
|
|
|
|
|
|
ret = newBINOP_ANY_CUSTOM(&pp_in, 0, lhs, rhs, 1); |
161
|
0
|
0
|
|
|
|
|
cBINOP_ANYx(ret)->op_any[0].any_ptr = INT2PTR(void *, SvUV(AvARRAY(parsedata_av)[1])); |
162
|
0
|
|
|
|
|
|
ret->op_private = INOP_CUSTOM; |
163
|
0
|
|
|
|
|
|
break; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
case INOP_NUMBER: |
166
|
|
|
|
|
|
|
case INOP_STRING: |
167
|
|
|
|
|
|
|
ret = newBINOP_CUSTOM(&pp_in, 0, lhs, rhs); |
168
|
0
|
|
|
|
|
|
ret->op_private = operator; |
169
|
0
|
|
|
|
|
|
break; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
return ret; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
7
|
|
|
|
|
|
static OP *newop_in_str(pTHX_ U32 flags, OP *lhs, OP *rhs, SV **parsedata, void *hookdata) |
176
|
|
|
|
|
|
|
{ |
177
|
|
|
|
|
|
|
OP *ret = newBINOP_CUSTOM(&pp_in, 0, lhs, rhs); |
178
|
7
|
|
|
|
|
|
ret->op_private = INOP_STRING; |
179
|
|
|
|
|
|
|
|
180
|
7
|
|
|
|
|
|
return ret; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
7
|
|
|
|
|
|
static OP *newop_in_num(pTHX_ U32 flags, OP *lhs, OP *rhs, SV **parsedata, void *hookdata) |
184
|
|
|
|
|
|
|
{ |
185
|
|
|
|
|
|
|
OP *ret = newBINOP_CUSTOM(&pp_in, 0, lhs, rhs); |
186
|
7
|
|
|
|
|
|
ret->op_private = INOP_NUMBER; |
187
|
|
|
|
|
|
|
|
188
|
7
|
|
|
|
|
|
return ret; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
struct XSParseInfixHooks infix_in = { |
192
|
|
|
|
|
|
|
.cls = XPI_CLS_MATCH_MISC, |
193
|
|
|
|
|
|
|
.rhs_flags = XPI_OPERAND_LIST, |
194
|
|
|
|
|
|
|
.permit_hintkey = "Syntax::Operator::In/in", |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
.parse = &parse_in, |
197
|
|
|
|
|
|
|
.new_op = &newop_in, |
198
|
|
|
|
|
|
|
}; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
struct XSParseInfixHooks infix_elem_str = { |
201
|
|
|
|
|
|
|
.cls = XPI_CLS_MATCH_MISC, |
202
|
|
|
|
|
|
|
.rhs_flags = XPI_OPERAND_LIST, |
203
|
|
|
|
|
|
|
.permit_hintkey = "Syntax::Operator::Elem/elem", |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
.wrapper_func_name = "Syntax::Operator::Elem::elem_str", |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
.new_op = &newop_in_str, |
208
|
|
|
|
|
|
|
}; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
struct XSParseInfixHooks infix_elem_num = { |
211
|
|
|
|
|
|
|
.cls = XPI_CLS_MATCH_MISC, |
212
|
|
|
|
|
|
|
.rhs_flags = XPI_OPERAND_LIST, |
213
|
|
|
|
|
|
|
.permit_hintkey = "Syntax::Operator::Elem/elem", |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
.wrapper_func_name = "Syntax::Operator::Elem::elem_num", |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
.new_op = &newop_in_num, |
218
|
|
|
|
|
|
|
}; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
MODULE = Syntax::Operator::In PACKAGE = Syntax::Operator::In |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
BOOT: |
223
|
7
|
|
|
|
|
|
boot_xs_parse_infix(0.28); |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
register_xs_parse_infix("in", &infix_in, NULL); |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
register_xs_parse_infix("elem", &infix_elem_str, NULL); |
228
|
|
|
|
|
|
|
register_xs_parse_infix("∈", &infix_elem_num, NULL); |