Skip to content

Commit 9924e54

Browse files
committed
Work-in-progress: Implement a PPC0031-style eq:u flagged operator
Adds: * operator flag parser token type (OPFLAGS) * expected next token to be opflags or term (XOPFLAGTERM) * internal API function to modify operator opcode to add private flags (apply_opflags) Still TODO: * More robustness testing, especially around new PL_expect value * Think about and test how actual chaining works with multiple of these
1 parent 44d9512 commit 9924e54

File tree

12 files changed

+1710
-1570
lines changed

12 files changed

+1710
-1570
lines changed

embed.fnc

+2
Original file line numberDiff line numberDiff line change
@@ -701,6 +701,8 @@ Apx |void |apply_attrs_string \
701701
Adp |OP * |apply_builtin_cv_attributes \
702702
|NN CV *cv \
703703
|NULLOK OP *attrlist
704+
Xp |U32 |apply_opflags |U32 optype \
705+
|NULLOK char *flagstr
704706
CTp |void |atfork_lock
705707
CTp |void |atfork_unlock
706708
Cop |SV ** |av_arylen_p |NN AV *av

embed.h

+1
Original file line numberDiff line numberDiff line change
@@ -999,6 +999,7 @@
999999
# define amagic_applies(a,b,c) Perl_amagic_applies(aTHX_ a,b,c)
10001000
# define amagic_is_enabled(a) Perl_amagic_is_enabled(aTHX_ a)
10011001
# define apply(a,b,c) Perl_apply(aTHX_ a,b,c)
1002+
# define apply_opflags(a,b) Perl_apply_opflags(aTHX_ a,b)
10021003
# define av_extend_guts(a,b,c,d,e) Perl_av_extend_guts(aTHX_ a,b,c,d,e)
10031004
# define av_nonelem(a,b) Perl_av_nonelem(aTHX_ a,b)
10041005
# define av_remove_offset(a) Perl_av_remove_offset(aTHX_ a)

op.c

+22
Original file line numberDiff line numberDiff line change
@@ -16192,6 +16192,28 @@ Perl_rcpv_copy(pTHX_ char *pv) {
1619216192
return pv;
1619316193
}
1619416194

16195+
U32
16196+
Perl_apply_opflags(pTHX_ U32 opcode, char *flagstr)
16197+
{
16198+
U16 opcode_base = opcode & 0xFFFF;
16199+
U8 priv = (opcode_base >> 16) & 0xFF;
16200+
16201+
for(char flag; (flag = *flagstr); flagstr++) {
16202+
switch(opcode_base) {
16203+
case OP_SEQ:
16204+
case OP_EQ:
16205+
switch(flag) {
16206+
case 'u':
16207+
priv |= OPpEQ_UNDEF;
16208+
continue;
16209+
}
16210+
}
16211+
croak("Unrecognized flag '%c' for %s", flag, PL_op_desc[opcode_base]);
16212+
}
16213+
16214+
return opcode_base | (priv << 16);
16215+
}
16216+
1619516217
/*
1619616218
* ex: set ts=8 sts=4 sw=4 et:
1619716219
*/

perl.h

+2-1
Original file line numberDiff line numberDiff line change
@@ -5898,7 +5898,8 @@ typedef enum {
58985898
XTERMBLOCK,
58995899
XBLOCKTERM,
59005900
XPOSTDEREF,
5901-
XTERMORDORDOR /* evil hack */
5901+
XTERMORDORDOR, /* evil hack */
5902+
XOPFLAGSTERM, /* next token should be opflags or a term */
59025903
/* update exp_name[] in toke.c if adding to this enum */
59035904
} expectation;
59045905

0 commit comments

Comments
 (0)