Skip to content

Commit 5ad613a

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 36f4cc0 commit 5ad613a

File tree

12 files changed

+1679
-1548
lines changed

12 files changed

+1679
-1548
lines changed

embed.fnc

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -717,6 +717,8 @@ Apx |void |apply_attrs_string \
717717
Adp |OP * |apply_builtin_cv_attributes \
718718
|NN CV *cv \
719719
|NULLOK OP *attrlist
720+
Xp |U32 |apply_opflags |U32 optype \
721+
|NULLOK char *flagstr
720722
CTp |void |atfork_child
721723
CTp |void |atfork_lock
722724
CTp |void |atfork_unlock

embed.h

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -954,6 +954,7 @@
954954
# define amagic_applies(a,b,c) Perl_amagic_applies(aTHX_ a,b,c)
955955
# define amagic_is_enabled(a) Perl_amagic_is_enabled(aTHX_ a)
956956
# define apply(a,b,c) Perl_apply(aTHX_ a,b,c)
957+
# define apply_opflags(a,b) Perl_apply_opflags(aTHX_ a,b)
957958
# define av_extend_guts(a,b,c,d,e) Perl_av_extend_guts(aTHX_ a,b,c,d,e)
958959
# define av_nonelem(a,b) Perl_av_nonelem(aTHX_ a,b)
959960
# define av_remove_offset(a) Perl_av_remove_offset(aTHX_ a)

op.c

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17078,6 +17078,28 @@ Perl_subsignature_finish(pTHX)
1707817078
return ret;
1707917079
}
1708017080

17081+
U32
17082+
Perl_apply_opflags(pTHX_ U32 opcode, char *flagstr)
17083+
{
17084+
U16 opcode_base = opcode & 0xFFFF;
17085+
U8 priv = (opcode_base >> 16) & 0xFF;
17086+
17087+
for(char flag; (flag = *flagstr); flagstr++) {
17088+
switch(opcode_base) {
17089+
case OP_SEQ:
17090+
case OP_EQ:
17091+
switch(flag) {
17092+
case 'u':
17093+
priv |= OPpEQ_UNDEF;
17094+
continue;
17095+
}
17096+
}
17097+
croak("Unrecognized flag '%c' for %s", flag, PL_op_desc[opcode_base]);
17098+
}
17099+
17100+
return opcode_base | (priv << 16);
17101+
}
17102+
1708117103
/*
1708217104
* ex: set ts=8 sts=4 sw=4 et:
1708317105
*/

perl.h

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6045,7 +6045,8 @@ typedef enum {
60456045
XTERMBLOCK,
60466046
XBLOCKTERM,
60476047
XPOSTDEREF,
6048-
XTERMORDORDOR /* evil hack */
6048+
XTERMORDORDOR, /* evil hack */
6049+
XOPFLAGSTERM, /* next token should be opflags or a term */
60496050
/* update exp_name[] in toke.c if adding to this enum */
60506051
} expectation;
60516052

0 commit comments

Comments
 (0)