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-2023 -- 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 "XSParseKeyword.h" |
13
|
|
|
|
|
|
|
#include "XSParseInfix.h" |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
#define HAVE_PERL_VERSION(R, V, S) \ |
16
|
|
|
|
|
|
|
(PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
#include "hax/perl-backcompat.c.inc" |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
#if HAVE_PERL_VERSION(5,32,0) |
21
|
|
|
|
|
|
|
# define HAVE_OP_ISA |
22
|
|
|
|
|
|
|
#endif |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
#if HAVE_PERL_VERSION(5,18,0) |
25
|
|
|
|
|
|
|
# define HAVE_BOOL_SvIV_please_nomg |
26
|
|
|
|
|
|
|
#endif |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
#if HAVE_PERL_VERSION(5,35,9) |
29
|
|
|
|
|
|
|
# define HAVE_SV_NUMEQ_FLAGS |
30
|
|
|
|
|
|
|
#endif |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
#ifndef block_start |
33
|
|
|
|
|
|
|
# define block_start(flags) Perl_block_start(aTHX_ flags) |
34
|
|
|
|
|
|
|
#endif |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
#ifndef block_end |
37
|
|
|
|
|
|
|
# define block_end(floor, op) Perl_block_end(aTHX_ floor, op) |
38
|
|
|
|
|
|
|
#endif |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
#include "dispatchop.h" |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
#ifndef HAVE_SV_NUMEQ_FLAGS |
43
|
|
|
|
|
|
|
/* We'd like to call Perl_do_ncmp, except that isn't an exported API function |
44
|
|
|
|
|
|
|
* Here's a near-copy of it for num-equality testing purposes */ |
45
|
|
|
|
|
|
|
#define do_numeq(left, right) S_do_numeq(aTHX_ left, right) |
46
|
5
|
|
|
|
|
|
static bool S_do_numeq(pTHX_ SV *left, SV *right) |
47
|
|
|
|
|
|
|
{ |
48
|
|
|
|
|
|
|
#ifndef HAVE_BOOL_SvIV_please_nomg |
49
|
|
|
|
|
|
|
/* Before perl 5.18, SvIV_please_nomg() was void-returning */ |
50
|
|
|
|
|
|
|
SvIV_please_nomg(left); |
51
|
|
|
|
|
|
|
SvIV_please_nomg(right); |
52
|
|
|
|
|
|
|
#endif |
53
|
|
|
|
|
|
|
|
54
|
10
|
100
|
|
|
|
|
if( |
55
|
|
|
|
|
|
|
#ifdef HAVE_BOOL_SvIV_please_nomg |
56
|
9
|
50
|
|
|
|
|
SvIV_please_nomg(right) && SvIV_please_nomg(left) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
57
|
|
|
|
|
|
|
#else |
58
|
|
|
|
|
|
|
SvIOK(left) && SvIOK(right) |
59
|
|
|
|
|
|
|
#endif |
60
|
|
|
|
|
|
|
) { |
61
|
|
|
|
|
|
|
/* Compare as integers */ |
62
|
3
|
100
|
|
|
|
|
switch((SvUOK(left) ? 1 : 0) | (SvUOK(right) ? 2 : 0)) { |
63
|
|
|
|
|
|
|
case 0: /* IV == IV */ |
64
|
0
|
|
|
|
|
|
return SvIVX(left) == SvIVX(right); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
case 1: /* UV == IV */ |
67
|
|
|
|
|
|
|
{ |
68
|
1
|
|
|
|
|
|
const IV riv = SvUVX(right); |
69
|
1
|
50
|
|
|
|
|
if(riv < 0) |
70
|
|
|
|
|
|
|
return 0; |
71
|
1
|
|
|
|
|
|
return (SvUVX(left) == riv); |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
case 2: /* IV == UV */ |
75
|
|
|
|
|
|
|
{ |
76
|
0
|
|
|
|
|
|
const IV liv = SvUVX(left); |
77
|
0
|
0
|
|
|
|
|
if(liv < 0) |
78
|
|
|
|
|
|
|
return 0; |
79
|
0
|
|
|
|
|
|
return (liv == SvUVX(right)); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
case 3: /* UV == UV */ |
83
|
2
|
|
|
|
|
|
return SvUVX(left) == SvUVX(right); |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
else { |
87
|
|
|
|
|
|
|
/* Compare NVs */ |
88
|
2
|
50
|
|
|
|
|
NV const rnv = SvNV_nomg(right); |
89
|
2
|
50
|
|
|
|
|
NV const lnv = SvNV_nomg(left); |
90
|
|
|
|
|
|
|
|
91
|
2
|
|
|
|
|
|
return lnv == rnv; |
92
|
|
|
|
|
|
|
} |
93
|
0
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
#endif |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
#define newPADSVOP(type, flags, padix) MY_newPADSVOP(aTHX_ type, flags, padix) |
97
|
|
|
|
|
|
|
static OP *MY_newPADSVOP(pTHX_ I32 type, I32 flags, PADOFFSET padix) |
98
|
|
|
|
|
|
|
{ |
99
|
81
|
|
|
|
|
|
OP *op = newOP(type, flags); |
100
|
81
|
|
|
|
|
|
op->op_targ = padix; |
101
|
|
|
|
|
|
|
return op; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
4
|
|
|
|
|
|
static OP *pp_dispatch_numeq(pTHX) |
105
|
|
|
|
|
|
|
{ |
106
|
4
|
|
|
|
|
|
dDISPATCH; |
107
|
4
|
|
|
|
|
|
dTARGET; |
108
|
|
|
|
|
|
|
int idx; |
109
|
|
|
|
|
|
|
|
110
|
4
|
50
|
|
|
|
|
bool has_magic = SvAMAGIC(TARG); |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
8
|
50
|
|
|
|
|
for(idx = 0; idx < n_cases; idx++) { |
113
|
8
|
|
|
|
|
|
SV *val = values[idx]; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
SV *ret; |
116
|
8
|
50
|
|
|
|
|
if(has_magic && |
|
|
0
|
|
|
|
|
|
117
|
|
|
|
|
|
|
(ret = amagic_call(TARG, val, eq_amg, 0))) { |
118
|
0
|
0
|
|
|
|
|
if(SvTRUE(ret)) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
119
|
0
|
|
|
|
|
|
return dispatch[idx]; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
#ifdef HAVE_SV_NUMEQ_FLAGS |
122
|
|
|
|
|
|
|
else if(sv_numeq_flags(TARG, val, SV_SKIP_OVERLOAD)) |
123
|
|
|
|
|
|
|
#else |
124
|
|
|
|
|
|
|
/* stolen from core's pp_hot.c / pp_eq() */ |
125
|
8
|
100
|
|
|
|
|
else if((SvIOK_notUV(TARG) && SvIOK_notUV(val)) ? |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
126
|
3
|
|
|
|
|
|
SvIVX(TARG) == SvIVX(val) : (do_numeq(TARG, val))) |
127
|
|
|
|
|
|
|
#endif |
128
|
4
|
|
|
|
|
|
return dispatch[idx]; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
0
|
|
|
|
|
|
return cDISPATCHOP->op_other; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
1000012
|
|
|
|
|
|
static OP *pp_dispatch_streq(pTHX) |
135
|
|
|
|
|
|
|
{ |
136
|
1000012
|
|
|
|
|
|
dDISPATCH; |
137
|
1000012
|
|
|
|
|
|
dTARGET; |
138
|
|
|
|
|
|
|
int idx; |
139
|
|
|
|
|
|
|
|
140
|
1000012
|
100
|
|
|
|
|
bool has_magic = SvAMAGIC(TARG); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
141
|
|
|
|
|
|
|
|
142
|
10000059
|
100
|
|
|
|
|
for(idx = 0; idx < n_cases; idx++) { |
143
|
9000057
|
|
|
|
|
|
SV *val = values[idx]; |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
SV *ret; |
146
|
9000057
|
100
|
|
|
|
|
if(has_magic && |
|
|
50
|
|
|
|
|
|
147
|
|
|
|
|
|
|
(ret = amagic_call(TARG, val, seq_amg, 0))) { |
148
|
3
|
50
|
|
|
|
|
if(SvTRUE(ret)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
149
|
1
|
|
|
|
|
|
return dispatch[idx]; |
150
|
|
|
|
|
|
|
} |
151
|
9000054
|
100
|
|
|
|
|
else if(sv_eq(TARG, val)) |
152
|
9
|
|
|
|
|
|
return dispatch[idx]; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
1000002
|
|
|
|
|
|
return cDISPATCHOP->op_other; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
#ifdef HAVE_OP_ISA |
159
|
|
|
|
|
|
|
static OP *pp_dispatch_isa(pTHX) |
160
|
|
|
|
|
|
|
{ |
161
|
|
|
|
|
|
|
dDISPATCH; |
162
|
|
|
|
|
|
|
dTARGET; |
163
|
|
|
|
|
|
|
int idx; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
for(idx = 0; idx < n_cases; idx++) |
166
|
|
|
|
|
|
|
if(sv_isa_sv(TARG, values[idx])) |
167
|
|
|
|
|
|
|
return dispatch[idx]; |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
return cDISPATCHOP->op_other; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
#endif |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
struct MatchCaseBlock { |
174
|
|
|
|
|
|
|
int n_cases; |
175
|
|
|
|
|
|
|
OP **case_exprs; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
OP *op; |
178
|
|
|
|
|
|
|
}; |
179
|
|
|
|
|
|
|
|
180
|
51
|
|
|
|
|
|
static OP *build_cases_nondispatch(pTHX_ XSParseInfixInfo *matchinfo, PADOFFSET padix, struct MatchCaseBlock *block, OP *elseop) |
181
|
|
|
|
|
|
|
{ |
182
|
51
|
|
|
|
|
|
size_t n_cases = block->n_cases; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
assert(n_cases); |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
OP *testop = NULL; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
U32 i; |
189
|
104
|
100
|
|
|
|
|
for(i = 0; i < n_cases; i++) { |
190
|
53
|
|
|
|
|
|
OP *caseop = block->case_exprs[i]; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
OP *thistestop; |
193
|
|
|
|
|
|
|
|
194
|
53
|
|
|
|
|
|
switch(matchinfo->opcode) { |
195
|
|
|
|
|
|
|
#ifdef HAVE_OP_ISA |
196
|
|
|
|
|
|
|
case OP_ISA: |
197
|
|
|
|
|
|
|
#endif |
198
|
|
|
|
|
|
|
case OP_SEQ: |
199
|
|
|
|
|
|
|
case OP_EQ: |
200
|
42
|
|
|
|
|
|
thistestop = newBINOP(matchinfo->opcode, 0, |
201
|
|
|
|
|
|
|
newPADSVOP(OP_PADSV, 0, padix), caseop); |
202
|
42
|
|
|
|
|
|
break; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
case OP_MATCH: |
205
|
4
|
50
|
|
|
|
|
if(caseop->op_type != OP_MATCH || cPMOPx(caseop)->op_first) |
|
|
50
|
|
|
|
|
|
206
|
0
|
|
|
|
|
|
croak("Expected a regexp match"); |
207
|
|
|
|
|
|
|
thistestop = caseop; |
208
|
|
|
|
|
|
|
#if HAVE_PERL_VERSION(5,22,0) |
209
|
4
|
|
|
|
|
|
thistestop->op_targ = padix; |
210
|
|
|
|
|
|
|
#else |
211
|
|
|
|
|
|
|
cPMOPx(thistestop)->op_first = newPADSVOP(OP_PADSV, 0, padix); |
212
|
|
|
|
|
|
|
thistestop->op_flags |= OPf_KIDS|OPf_STACKED; |
213
|
|
|
|
|
|
|
#endif |
214
|
4
|
|
|
|
|
|
break; |
215
|
|
|
|
|
|
|
case OP_CUSTOM: |
216
|
|
|
|
|
|
|
thistestop = xs_parse_infix_new_op(matchinfo, 0, |
217
|
|
|
|
|
|
|
newPADSVOP(OP_PADSV, 0, padix), caseop); |
218
|
7
|
|
|
|
|
|
break; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
53
|
100
|
|
|
|
|
if(testop) |
222
|
2
|
|
|
|
|
|
testop = newLOGOP(OP_OR, 0, testop, thistestop); |
223
|
|
|
|
|
|
|
else |
224
|
|
|
|
|
|
|
testop = thistestop; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
assert(testop); |
228
|
|
|
|
|
|
|
|
229
|
51
|
100
|
|
|
|
|
if(elseop) |
230
|
33
|
|
|
|
|
|
return newCONDOP(0, testop, block->op, elseop); |
231
|
|
|
|
|
|
|
else |
232
|
18
|
|
|
|
|
|
return newLOGOP(OP_AND, 0, testop, block->op); |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
8
|
|
|
|
|
|
static OP *build_cases_dispatch(pTHX_ OPCODE matchtype, PADOFFSET padix, size_t n_cases, struct MatchCaseBlock *blocks, OP *elseop) |
236
|
|
|
|
|
|
|
{ |
237
|
|
|
|
|
|
|
assert(n_cases); |
238
|
|
|
|
|
|
|
assert(matchtype != OP_MATCH); |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
U32 blocki; |
241
|
|
|
|
|
|
|
|
242
|
8
|
|
|
|
|
|
ENTER; |
243
|
|
|
|
|
|
|
|
244
|
8
|
|
|
|
|
|
SV *valuessv = newSV(n_cases * sizeof(SV *)); |
245
|
8
|
|
|
|
|
|
SV *dispatchsv = newSV(n_cases * sizeof(OP *)); |
246
|
8
|
|
|
|
|
|
SAVEFREESV(valuessv); |
247
|
8
|
|
|
|
|
|
SAVEFREESV(dispatchsv); |
248
|
|
|
|
|
|
|
|
249
|
8
|
|
|
|
|
|
SV **values = (SV **)SvPVX(valuessv); |
250
|
8
|
|
|
|
|
|
OP **dispatch = (OP **)SvPVX(dispatchsv); |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
DISPATCHOP *o = alloc_DISPATCHOP(); |
253
|
8
|
|
|
|
|
|
o->op_type = OP_CUSTOM; |
254
|
8
|
|
|
|
|
|
o->op_targ = padix; |
255
|
|
|
|
|
|
|
|
256
|
8
|
|
|
|
|
|
switch(matchtype) { |
257
|
|
|
|
|
|
|
#ifdef HAVE_OP_ISA |
258
|
|
|
|
|
|
|
case OP_ISA: o->op_ppaddr = &pp_dispatch_isa; break; |
259
|
|
|
|
|
|
|
#endif |
260
|
3
|
|
|
|
|
|
case OP_SEQ: o->op_ppaddr = &pp_dispatch_streq; break; |
261
|
5
|
|
|
|
|
|
case OP_EQ: o->op_ppaddr = &pp_dispatch_numeq; break; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
8
|
|
|
|
|
|
o->op_first = NULL; |
265
|
|
|
|
|
|
|
|
266
|
8
|
|
|
|
|
|
o->n_cases = n_cases; |
267
|
8
|
|
|
|
|
|
o->values = values; |
268
|
8
|
|
|
|
|
|
o->dispatch = dispatch; |
269
|
|
|
|
|
|
|
|
270
|
8
|
|
|
|
|
|
OP *retop = newUNOP(OP_NULL, 0, (OP *)o); |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
U32 idx = 0; |
273
|
|
|
|
|
|
|
blocki = 0; |
274
|
38
|
100
|
|
|
|
|
while(n_cases) { |
275
|
30
|
|
|
|
|
|
struct MatchCaseBlock *block = &blocks[blocki]; |
276
|
|
|
|
|
|
|
|
277
|
30
|
|
|
|
|
|
U32 this_n_cases = block->n_cases; |
278
|
|
|
|
|
|
|
|
279
|
30
|
|
|
|
|
|
OP *blockop = block->op; |
280
|
30
|
50
|
|
|
|
|
OP *blockstart = LINKLIST(blockop); |
281
|
30
|
|
|
|
|
|
blockop->op_next = retop; |
282
|
|
|
|
|
|
|
|
283
|
30
|
|
|
|
|
|
n_cases -= this_n_cases; |
284
|
|
|
|
|
|
|
|
285
|
60
|
100
|
|
|
|
|
for(U32 casei = 0; casei < this_n_cases; casei++) { |
286
|
30
|
|
|
|
|
|
OP *caseop = block->case_exprs[casei]; |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
assert(caseop->op_type == OP_CONST); |
289
|
60
|
|
|
|
|
|
values[idx] = SvREFCNT_inc(cSVOPx(caseop)->op_sv); |
290
|
30
|
|
|
|
|
|
op_free(caseop); |
291
|
|
|
|
|
|
|
|
292
|
30
|
|
|
|
|
|
dispatch[idx] = blockstart; |
293
|
|
|
|
|
|
|
|
294
|
30
|
|
|
|
|
|
idx++; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
/* TODO: link chain of siblings */ |
298
|
|
|
|
|
|
|
|
299
|
30
|
|
|
|
|
|
blocki++; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
8
|
100
|
|
|
|
|
if(elseop) { |
303
|
7
|
100
|
|
|
|
|
o->op_other = LINKLIST(elseop); |
304
|
7
|
|
|
|
|
|
elseop->op_next = retop; |
305
|
|
|
|
|
|
|
/* TODO: sibling linkage */ |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
else { |
308
|
1
|
|
|
|
|
|
o->op_other = retop; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
/* Steal the SV buffers */ |
312
|
8
|
|
|
|
|
|
SvPVX(valuessv) = NULL; SvLEN(valuessv) = 0; |
313
|
8
|
|
|
|
|
|
SvPVX(dispatchsv) = NULL; SvLEN(dispatchsv) = 0; |
314
|
|
|
|
|
|
|
|
315
|
8
|
|
|
|
|
|
LEAVE; |
316
|
|
|
|
|
|
|
|
317
|
8
|
|
|
|
|
|
return retop; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
32
|
|
|
|
|
|
static int build_match(pTHX_ OP **out, XSParseKeywordPiece *args[], size_t nargs, void *hookdata) |
321
|
|
|
|
|
|
|
{ |
322
|
|
|
|
|
|
|
/* args: |
323
|
|
|
|
|
|
|
* [0]: topic expression |
324
|
|
|
|
|
|
|
* [1]: match type |
325
|
|
|
|
|
|
|
* [2]: count of blocks |
326
|
|
|
|
|
|
|
* [3]: count of case exprs = $N |
327
|
|
|
|
|
|
|
* [4...]: $N * case exprs |
328
|
|
|
|
|
|
|
* []: block |
329
|
|
|
|
|
|
|
* [LAST]: default case if present |
330
|
|
|
|
|
|
|
*/ |
331
|
|
|
|
|
|
|
U32 argi = 0; |
332
|
|
|
|
|
|
|
|
333
|
32
|
|
|
|
|
|
OP *topic = args[argi++]->op; |
334
|
32
|
|
|
|
|
|
XSParseInfixInfo *matchinfo = args[argi++]->infix; |
335
|
32
|
|
|
|
|
|
int n_blocks = args[argi++]->i; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
/* Extract the raw args into a better data structure we can work with */ |
338
|
|
|
|
|
|
|
struct MatchCaseBlock *blocks; |
339
|
|
|
|
|
|
|
|
340
|
32
|
50
|
|
|
|
|
Newx(blocks, n_blocks, struct MatchCaseBlock); |
341
|
32
|
|
|
|
|
|
SAVEFREEPV(blocks); |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
int blocki; |
344
|
113
|
100
|
|
|
|
|
for(blocki = 0; blocki < n_blocks; blocki++) { |
345
|
81
|
|
|
|
|
|
struct MatchCaseBlock *block = &blocks[blocki]; |
346
|
|
|
|
|
|
|
|
347
|
81
|
|
|
|
|
|
int n_cases = args[argi++]->i; |
348
|
|
|
|
|
|
|
|
349
|
81
|
|
|
|
|
|
block->n_cases = n_cases; |
350
|
|
|
|
|
|
|
|
351
|
81
|
50
|
|
|
|
|
Newx(block->case_exprs, n_cases, OP *); |
352
|
81
|
|
|
|
|
|
SAVEFREEPV(block->case_exprs); |
353
|
|
|
|
|
|
|
|
354
|
164
|
100
|
|
|
|
|
for(int i = 0; i < n_cases; i++) |
355
|
83
|
|
|
|
|
|
block->case_exprs[i] = args[argi++]->op; |
356
|
|
|
|
|
|
|
|
357
|
81
|
|
|
|
|
|
block->op = args[argi++]->op; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
32
|
|
|
|
|
|
bool has_default = args[argi]->i; |
361
|
|
|
|
|
|
|
OP *o = NULL; |
362
|
32
|
100
|
|
|
|
|
if(has_default) |
363
|
13
|
|
|
|
|
|
o = args[argi + 1]->op; |
364
|
|
|
|
|
|
|
|
365
|
32
|
|
|
|
|
|
bool use_dispatch = hv_fetchs(GvHV(PL_hintgv), "Syntax::Keyword::Match/experimental(dispatch)", 0); |
366
|
|
|
|
|
|
|
|
367
|
32
|
|
|
|
|
|
I32 floor_ix = block_start(0); |
368
|
|
|
|
|
|
|
/* The name is totally meaningless and never used, but if we don't set a |
369
|
|
|
|
|
|
|
* name and instead use pad_alloc(SVs_PADTMP) then the peephole optimiser |
370
|
|
|
|
|
|
|
* for aassign will crash |
371
|
|
|
|
|
|
|
*/ |
372
|
32
|
|
|
|
|
|
PADOFFSET padix = pad_add_name_pvs("$(Syntax::Keyword::Match/topic)", 0, NULL, NULL); |
373
|
32
|
|
|
|
|
|
intro_my(); |
374
|
|
|
|
|
|
|
|
375
|
32
|
|
|
|
|
|
OP *startop = newBINOP(OP_SASSIGN, 0, |
376
|
|
|
|
|
|
|
topic, newPADSVOP(OP_PADSV, OPf_MOD|OPf_REF|(OPpLVAL_INTRO << 8), padix)); |
377
|
32
|
|
|
|
|
|
PL_hints |= HINT_BLOCK_SCOPE; /* ensures that op_scope() creates a full ENTER+LEAVE pair */ |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
int n_dispatch = 0; |
380
|
|
|
|
|
|
|
|
381
|
32
|
|
|
|
|
|
blocki = n_blocks-1; |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
/* Roll up the blocks backwards, from end to beginning */ |
384
|
113
|
100
|
|
|
|
|
while(blocki >= 0) { |
385
|
81
|
|
|
|
|
|
struct MatchCaseBlock *block = &blocks[blocki--]; |
386
|
|
|
|
|
|
|
|
387
|
81
|
|
|
|
|
|
int n_cases = block->n_cases; |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
/* perl expects a strict optree, where each block appears exactly once. |
390
|
|
|
|
|
|
|
* We can't reĆ¼se the block between dispatch and non-dispatch ops, so |
391
|
|
|
|
|
|
|
* we'll have to decide which strategy to use here |
392
|
|
|
|
|
|
|
*/ |
393
|
|
|
|
|
|
|
bool this_block_dispatch = use_dispatch; |
394
|
|
|
|
|
|
|
|
395
|
164
|
100
|
|
|
|
|
for(U32 casei = 0; casei < n_cases; casei++) { |
396
|
|
|
|
|
|
|
/* TODO: forbid the , operator in the case label */ |
397
|
83
|
|
|
|
|
|
OP *caseop = block->case_exprs[casei]; |
398
|
|
|
|
|
|
|
|
399
|
83
|
|
|
|
|
|
switch(matchinfo->opcode) { |
400
|
|
|
|
|
|
|
#ifdef HAVE_OP_ISA |
401
|
|
|
|
|
|
|
case OP_ISA: |
402
|
|
|
|
|
|
|
/* bareword class names are permitted */ |
403
|
|
|
|
|
|
|
if(caseop->op_type == OP_CONST && caseop->op_private & OPpCONST_BARE) |
404
|
|
|
|
|
|
|
caseop->op_private &= ~(OPpCONST_BARE|OPpCONST_STRICT); |
405
|
|
|
|
|
|
|
/* FALLTHROUGH */ |
406
|
|
|
|
|
|
|
#endif |
407
|
|
|
|
|
|
|
case OP_SEQ: |
408
|
|
|
|
|
|
|
case OP_EQ: |
409
|
72
|
100
|
|
|
|
|
if(use_dispatch && caseop->op_type == OP_CONST) |
|
|
100
|
|
|
|
|
|
410
|
30
|
|
|
|
|
|
continue; |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
/* FALLTHROUGH */ |
413
|
|
|
|
|
|
|
case OP_MATCH: |
414
|
|
|
|
|
|
|
case OP_CUSTOM: |
415
|
|
|
|
|
|
|
this_block_dispatch = false; |
416
|
53
|
|
|
|
|
|
break; |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
|
420
|
81
|
100
|
|
|
|
|
if(this_block_dispatch) { |
421
|
30
|
|
|
|
|
|
n_dispatch += n_cases; |
422
|
30
|
|
|
|
|
|
continue; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
51
|
100
|
|
|
|
|
if(n_dispatch) { |
426
|
1
|
|
|
|
|
|
o = build_cases_dispatch(aTHX_ matchinfo->opcode, padix, |
427
|
|
|
|
|
|
|
n_dispatch, block + 1, o); |
428
|
|
|
|
|
|
|
n_dispatch = 0; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
|
431
|
81
|
|
|
|
|
|
o = build_cases_nondispatch(aTHX_ matchinfo, padix, block, o); |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
32
|
100
|
|
|
|
|
if(n_dispatch) |
435
|
7
|
|
|
|
|
|
o = build_cases_dispatch(aTHX_ matchinfo->opcode, padix, |
436
|
|
|
|
|
|
|
n_dispatch, blocks, o); |
437
|
|
|
|
|
|
|
|
438
|
32
|
|
|
|
|
|
*out = op_scope(block_end(floor_ix, newLISTOP(OP_LINESEQ, 0, startop, o))); |
439
|
|
|
|
|
|
|
|
440
|
32
|
|
|
|
|
|
return KEYWORD_PLUGIN_STMT; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
static const struct XSParseKeywordHooks hooks_match = { |
444
|
|
|
|
|
|
|
.permit_hintkey = "Syntax::Keyword::Match/match", |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
.pieces = (const struct XSParseKeywordPieceType []){ |
447
|
|
|
|
|
|
|
XPK_PARENSCOPE( /* ( EXPR : OP ) */ |
448
|
|
|
|
|
|
|
XPK_TERMEXPR_SCALARCTX, |
449
|
|
|
|
|
|
|
XPK_COLON, |
450
|
|
|
|
|
|
|
XPK_INFIX_MATCH_NOSMART |
451
|
|
|
|
|
|
|
), |
452
|
|
|
|
|
|
|
XPK_BRACESCOPE( /* { blocks... } */ |
453
|
|
|
|
|
|
|
XPK_REPEATED( /* case (EXPR) {BLOCK} */ |
454
|
|
|
|
|
|
|
XPK_COMMALIST( |
455
|
|
|
|
|
|
|
XPK_KEYWORD("case"), |
456
|
|
|
|
|
|
|
XPK_PARENSCOPE( XPK_TERMEXPR_SCALARCTX ) |
457
|
|
|
|
|
|
|
), |
458
|
|
|
|
|
|
|
XPK_BLOCK |
459
|
|
|
|
|
|
|
), |
460
|
|
|
|
|
|
|
XPK_OPTIONAL( /* default { ... } */ |
461
|
|
|
|
|
|
|
XPK_KEYWORD("default"), |
462
|
|
|
|
|
|
|
XPK_BLOCK |
463
|
|
|
|
|
|
|
) |
464
|
|
|
|
|
|
|
), |
465
|
|
|
|
|
|
|
0, |
466
|
|
|
|
|
|
|
}, |
467
|
|
|
|
|
|
|
.build = &build_match, |
468
|
|
|
|
|
|
|
}; |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
#ifndef HAVE_OP_ISA |
471
|
|
|
|
|
|
|
#include "hax/newOP_CUSTOM.c.inc" |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
/* Can't use sv_isa_sv() because that was only added in 5.32 */ |
474
|
6
|
|
|
|
|
|
static bool S_sv_isa_sv(pTHX_ SV *sv, SV *namesv) |
475
|
|
|
|
|
|
|
{ |
476
|
6
|
50
|
|
|
|
|
if(!SvROK(sv) || !SvOBJECT(SvRV(sv))) |
|
|
50
|
|
|
|
|
|
477
|
|
|
|
|
|
|
return FALSE; |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
/* Also can't use GV_NOUNIVERSAL here because that also only turned up in 5.32 */ |
480
|
6
|
|
|
|
|
|
GV *isagv = gv_fetchmeth_pvn(SvSTASH(SvRV(sv)), "isa", 3, -1, 0); |
481
|
|
|
|
|
|
|
/* This probably finds UNIVERSAL::isa; if so we can avoid it and just do it |
482
|
|
|
|
|
|
|
* directly ourselves by calling sv_derived_from_sv() |
483
|
|
|
|
|
|
|
*/ |
484
|
6
|
50
|
|
|
|
|
if(isagv && !strEQ(HvNAME(GvSTASH(isagv)), "UNIVERSAL")) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
485
|
2
|
|
|
|
|
|
dSP; |
486
|
2
|
50
|
|
|
|
|
CV *isacv = isGV(isagv) ? GvCV(isagv) : MUTABLE_CV(isagv); |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
PUTBACK; |
489
|
|
|
|
|
|
|
|
490
|
2
|
|
|
|
|
|
ENTER; |
491
|
2
|
|
|
|
|
|
SAVETMPS; |
492
|
|
|
|
|
|
|
|
493
|
2
|
50
|
|
|
|
|
EXTEND(SP, 2); |
494
|
2
|
50
|
|
|
|
|
PUSHMARK(SP); |
495
|
2
|
|
|
|
|
|
PUSHs(sv); |
496
|
2
|
|
|
|
|
|
PUSHs(namesv); |
497
|
2
|
|
|
|
|
|
PUTBACK; |
498
|
|
|
|
|
|
|
|
499
|
2
|
|
|
|
|
|
call_sv((SV *)isacv, G_SCALAR); |
500
|
|
|
|
|
|
|
|
501
|
2
|
|
|
|
|
|
SPAGAIN; |
502
|
2
|
|
|
|
|
|
SV *retsv = POPs; |
503
|
2
|
50
|
|
|
|
|
bool ret = SvTRUE(retsv); |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
504
|
2
|
|
|
|
|
|
PUTBACK; |
505
|
|
|
|
|
|
|
|
506
|
2
|
50
|
|
|
|
|
FREETMPS; |
507
|
2
|
|
|
|
|
|
LEAVE; |
508
|
|
|
|
|
|
|
|
509
|
2
|
|
|
|
|
|
return ret; |
510
|
|
|
|
|
|
|
} |
511
|
|
|
|
|
|
|
|
512
|
4
|
|
|
|
|
|
return sv_derived_from_sv(sv, namesv, 0); |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
|
515
|
6
|
|
|
|
|
|
static OP *pp_isa(pTHX) |
516
|
|
|
|
|
|
|
{ |
517
|
6
|
|
|
|
|
|
dSP; |
518
|
6
|
|
|
|
|
|
SV *rhs = POPs; |
519
|
6
|
|
|
|
|
|
SV *lhs = TOPs; |
520
|
|
|
|
|
|
|
|
521
|
6
|
100
|
|
|
|
|
SETs(boolSV(S_sv_isa_sv(aTHX_ lhs, rhs))); |
522
|
6
|
|
|
|
|
|
RETURN; |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
|
525
|
7
|
|
|
|
|
|
static OP *newop_isa(pTHX_ U32 flags, OP *lhs, OP *rhs, SV **parsedata, void *hookdata) |
526
|
|
|
|
|
|
|
{ |
527
|
|
|
|
|
|
|
/* Avoid strictness failure on bareword RHS */ |
528
|
7
|
50
|
|
|
|
|
if(rhs->op_type == OP_CONST && rhs->op_private & OPpCONST_BARE) |
|
|
50
|
|
|
|
|
|
529
|
7
|
|
|
|
|
|
rhs->op_private &= ~(OPpCONST_BARE|OPpCONST_STRICT); |
530
|
|
|
|
|
|
|
|
531
|
7
|
|
|
|
|
|
return newBINOP_CUSTOM(&pp_isa, flags, lhs, rhs); |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
static const struct XSParseInfixHooks hooks_isa = { |
535
|
|
|
|
|
|
|
.flags = 0, |
536
|
|
|
|
|
|
|
.cls = XPI_CLS_ISA, |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
.new_op = &newop_isa, |
539
|
|
|
|
|
|
|
}; |
540
|
|
|
|
|
|
|
#endif |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
MODULE = Syntax::Keyword::Match PACKAGE = Syntax::Keyword::Match |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
BOOT: |
545
|
14
|
|
|
|
|
|
boot_xs_parse_keyword(0.23); |
546
|
14
|
|
|
|
|
|
boot_xs_parse_infix(0); |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
register_xs_parse_keyword("match", &hooks_match, NULL); |
549
|
|
|
|
|
|
|
#ifndef HAVE_OP_ISA |
550
|
|
|
|
|
|
|
register_xs_parse_infix("isa", &hooks_isa, NULL); |
551
|
|
|
|
|
|
|
#endif |