Skip to content

Commit d36c014

Browse files
leonerdleonerd
committed
Allow operator overloading on equ/neu, ===/!==
1 parent a88eebe commit d36c014

9 files changed

Lines changed: 359 additions & 75 deletions

File tree

‎gv.c‎

Lines changed: 102 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3551,6 +3551,14 @@ Perl_amagic_applies(pTHX_ SV *sv, int method, int flags)
35513551
if (cvp[ncmp_amg])
35523552
return TRUE;
35533553
break;
3554+
case equ_amg:
3555+
if (cvp[eq_amg] || cvp[ncmp_amg])
3556+
return TRUE;
3557+
break;
3558+
case neu_amg:
3559+
if (cvp[ne_amg] || cvp[ncmp_amg])
3560+
return TRUE;
3561+
break;
35543562
case slt_amg:
35553563
case sle_amg:
35563564
case sgt_amg:
@@ -3560,6 +3568,14 @@ Perl_amagic_applies(pTHX_ SV *sv, int method, int flags)
35603568
if (cvp[scmp_amg])
35613569
return TRUE;
35623570
break;
3571+
case sequ_amg:
3572+
if (cvp[seq_amg] || cvp[scmp_amg])
3573+
return TRUE;
3574+
break;
3575+
case sneu_amg:
3576+
if (cvp[sne_amg] || cvp[scmp_amg])
3577+
return TRUE;
3578+
break;
35633579
}
35643580
}
35653581

@@ -3964,7 +3980,9 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
39643980
|| method==repeat_amg || method==repeat_ass_amg) {
39653981
return NULL; /* Delegate operation to string conversion */
39663982
}
3983+
bool negate = false;
39673984
off = -1;
3985+
39683986
switch (method) {
39693987
case lt_amg:
39703988
case le_amg:
@@ -3974,6 +3992,35 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
39743992
case ne_amg:
39753993
off = ncmp_amg;
39763994
break;
3995+
case neu_amg:
3996+
negate = true;
3997+
/* FALLTHROUGH */
3998+
case equ_amg:
3999+
if (!SvOK(left) || !SvOK(right)) {
4000+
/* result is determined */
4001+
return boolSV((SvOK(left) == SvOK(right)) ^ negate);
4002+
}
4003+
/* TODO: Think about whether a missing `!==` ought to be
4004+
* synthesized by `not(===)`. But if so, what about != vs ==?
4005+
* https://github.com/Perl/PPCs/discussions/84
4006+
*/
4007+
4008+
/* Try to synthesize out of != / == */
4009+
if ((off = (negate ? ne_amg : eq_amg)) &&
4010+
ocvp && (oamtp->fallback > AMGfallNEVER) && (cv = ocvp[off]))
4011+
lr = -1;
4012+
else if(cvp && (amtp->fallback > AMGfallNEVER) && (cv = cvp[off]))
4013+
lr = 1;
4014+
/* else try to synthesize out of <=> */
4015+
else if((off = ncmp_amg) &&
4016+
ocvp && (oamtp->fallback > AMGfallNEVER) && (cv = ocvp[off]))
4017+
lr = -1;
4018+
else if(cvp && (amtp->fallback > AMGfallNEVER) && (cv = cvp[off]))
4019+
lr = 1;
4020+
/* else give up */
4021+
else
4022+
off = -1;
4023+
break;
39774024
case slt_amg:
39784025
case sle_amg:
39794026
case sgt_amg:
@@ -3982,6 +4029,35 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
39824029
case sne_amg:
39834030
off = scmp_amg;
39844031
break;
4032+
case sneu_amg:
4033+
negate = true;
4034+
/* FALLTHROUGH */
4035+
case sequ_amg:
4036+
if (!SvOK(left) || !SvOK(right)) {
4037+
/* result is determined */
4038+
return boolSV((SvOK(left) == SvOK(right)) ^ negate);
4039+
}
4040+
/* TODO: Think about whether a missing `neu` ought to be
4041+
* synthesized by `not(equ)`. But if so, what about ne vs eq?
4042+
* https://github.com/Perl/PPCs/discussions/84
4043+
*/
4044+
4045+
/* Try to synthesize out of ne / eq */
4046+
if ((off = (negate ? sne_amg : seq_amg)) &&
4047+
ocvp && (oamtp->fallback > AMGfallNEVER) && (cv = ocvp[off]))
4048+
lr = -1;
4049+
else if(cvp && (amtp->fallback > AMGfallNEVER) && (cv = cvp[off]))
4050+
lr = 1;
4051+
/* else try to synthesize out of cmp */
4052+
else if((off = scmp_amg) &&
4053+
ocvp && (oamtp->fallback > AMGfallNEVER) && (cv = ocvp[off]))
4054+
lr = -1;
4055+
else if(cvp && (amtp->fallback > AMGfallNEVER) && (cv = cvp[off]))
4056+
lr = 1;
4057+
/* else give up */
4058+
else
4059+
off = -1;
4060+
break;
39854061
}
39864062
if (off != -1) {
39874063
if (ocvp && (oamtp->fallback > AMGfallNEVER)) {
@@ -4272,7 +4348,12 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
42724348
CATCH_SET(oldcatch);
42734349

42744350
if (postpr) {
4351+
/* Post-process the actual answer we received from the overload method
4352+
* given in 'off', when the caller wanted the method 'method'
4353+
*/
42754354
int ans;
4355+
bool negate = false;
4356+
42764357
switch (method) {
42774358
case le_amg:
42784359
case sle_amg:
@@ -4292,6 +4373,27 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
42924373
case ne_amg:
42934374
case sne_amg:
42944375
ans=SvIV(res)!=0; break;
4376+
case neu_amg:
4377+
case sneu_amg:
4378+
negate = true;
4379+
/* FALLTHROUGH */
4380+
case equ_amg:
4381+
case sequ_amg:
4382+
switch(off) {
4383+
case eq_amg:
4384+
case seq_amg:
4385+
ans = SvTRUE_NN(res); break;
4386+
case ne_amg:
4387+
case sne_amg:
4388+
ans = !SvTRUE_NN(res); break;
4389+
case ncmp_amg:
4390+
case scmp_amg:
4391+
ans = SvIV(res) == 0; break;
4392+
default:
4393+
NOT_REACHED;
4394+
}
4395+
if (negate) ans = !ans;
4396+
break;
42954397
case inc_amg:
42964398
case dec_amg:
42974399
SvSetSV(left,res); return left;

‎lib/overload.pm‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -6,9 +6,9 @@ no strict 'refs';
66
our %ops = (
77
with_assign => "+ - * / % ** << >> x .",
88
assign => "+= -= *= /= %= **= <<= >>= x= .=",
9-
num_comparison => "< <= > >= == !=",
9+
num_comparison => "< <= > >= == != === !==",
1010
'3way_comparison' => "<=> cmp",
11-
str_comparison => "lt le gt ge eq ne",
11+
str_comparison => "lt le gt ge eq ne equ neu",
1212
binary => '& &= | |= ^ ^= &. &.= |. |.= ^. ^.=',
1313
unary => "neg ! ~ ~.",
1414
mutators => '++ --',
@@ -362,9 +362,9 @@ hash C<%overload::ops>:
362362
363363
with_assign => '+ - * / % ** << >> x .',
364364
assign => '+= -= *= /= %= **= <<= >>= x= .=',
365-
num_comparison => '< <= > >= == !=',
365+
num_comparison => '< <= > >= == != === !==',
366366
'3way_comparison' => '<=> cmp',
367-
str_comparison => 'lt le gt ge eq ne',
367+
str_comparison => 'lt le gt ge eq ne equ neu',
368368
binary => '& &= | |= ^ ^= &. &.= |. |.= ^. ^.=',
369369
unary => 'neg ! ~ ~.',
370370
mutators => '++ --',

‎lib/overload/numbers.pm‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,12 +37,16 @@ our @names = qw#
3737
(>=
3838
(==
3939
(!=
40+
(===
41+
(!==
4042
(lt
4143
(le
4244
(gt
4345
(ge
4446
(eq
4547
(ne
48+
(equ
49+
(neu
4650
(nomethod
4751
(+
4852
(+=
@@ -115,12 +119,16 @@ our @enums = qw#
115119
ge
116120
eq
117121
ne
122+
equ
123+
neu
118124
slt
119125
sle
120126
sgt
121127
sge
122128
seq
123129
sne
130+
sequ
131+
sneu
124132
nomethod
125133
add
126134
add_ass

‎overload.h‎

Lines changed: 56 additions & 52 deletions
Original file line numberDiff line numberDiff line change
@@ -37,58 +37,62 @@ enum {
3737
ge_amg, /* 0x14 >= */
3838
eq_amg, /* 0x15 == */
3939
ne_amg, /* 0x16 != */
40-
slt_amg, /* 0x17 lt */
41-
sle_amg, /* 0x18 le */
42-
sgt_amg, /* 0x19 gt */
43-
sge_amg, /* 0x1a ge */
44-
seq_amg, /* 0x1b eq */
45-
sne_amg, /* 0x1c ne */
46-
nomethod_amg, /* 0x1d nomethod */
47-
add_amg, /* 0x1e + */
48-
add_ass_amg, /* 0x1f += */
49-
subtr_amg, /* 0x20 - */
50-
subtr_ass_amg, /* 0x21 -= */
51-
mult_amg, /* 0x22 * */
52-
mult_ass_amg, /* 0x23 *= */
53-
div_amg, /* 0x24 / */
54-
div_ass_amg, /* 0x25 /= */
55-
modulo_amg, /* 0x26 % */
56-
modulo_ass_amg, /* 0x27 %= */
57-
pow_amg, /* 0x28 ** */
58-
pow_ass_amg, /* 0x29 **= */
59-
lshift_amg, /* 0x2a << */
60-
lshift_ass_amg, /* 0x2b <<= */
61-
rshift_amg, /* 0x2c >> */
62-
rshift_ass_amg, /* 0x2d >>= */
63-
band_amg, /* 0x2e & */
64-
band_ass_amg, /* 0x2f &= */
65-
sband_amg, /* 0x30 &. */
66-
sband_ass_amg, /* 0x31 &.= */
67-
bor_amg, /* 0x32 | */
68-
bor_ass_amg, /* 0x33 |= */
69-
sbor_amg, /* 0x34 |. */
70-
sbor_ass_amg, /* 0x35 |.= */
71-
bxor_amg, /* 0x36 ^ */
72-
bxor_ass_amg, /* 0x37 ^= */
73-
sbxor_amg, /* 0x38 ^. */
74-
sbxor_ass_amg, /* 0x39 ^.= */
75-
ncmp_amg, /* 0x3a <=> */
76-
scmp_amg, /* 0x3b cmp */
77-
compl_amg, /* 0x3c ~ */
78-
scompl_amg, /* 0x3d ~. */
79-
atan2_amg, /* 0x3e atan2 */
80-
cos_amg, /* 0x3f cos */
81-
sin_amg, /* 0x40 sin */
82-
exp_amg, /* 0x41 exp */
83-
log_amg, /* 0x42 log */
84-
sqrt_amg, /* 0x43 sqrt */
85-
repeat_amg, /* 0x44 x */
86-
repeat_ass_amg, /* 0x45 x= */
87-
concat_amg, /* 0x46 . */
88-
concat_ass_amg, /* 0x47 .= */
89-
smart_amg, /* 0x48 ~~ */
90-
ftest_amg, /* 0x49 -X */
91-
regexp_amg, /* 0x4a qr */
40+
equ_amg, /* 0x17 === */
41+
neu_amg, /* 0x18 !== */
42+
slt_amg, /* 0x19 lt */
43+
sle_amg, /* 0x1a le */
44+
sgt_amg, /* 0x1b gt */
45+
sge_amg, /* 0x1c ge */
46+
seq_amg, /* 0x1d eq */
47+
sne_amg, /* 0x1e ne */
48+
sequ_amg, /* 0x1f equ */
49+
sneu_amg, /* 0x20 neu */
50+
nomethod_amg, /* 0x21 nomethod */
51+
add_amg, /* 0x22 + */
52+
add_ass_amg, /* 0x23 += */
53+
subtr_amg, /* 0x24 - */
54+
subtr_ass_amg, /* 0x25 -= */
55+
mult_amg, /* 0x26 * */
56+
mult_ass_amg, /* 0x27 *= */
57+
div_amg, /* 0x28 / */
58+
div_ass_amg, /* 0x29 /= */
59+
modulo_amg, /* 0x2a % */
60+
modulo_ass_amg, /* 0x2b %= */
61+
pow_amg, /* 0x2c ** */
62+
pow_ass_amg, /* 0x2d **= */
63+
lshift_amg, /* 0x2e << */
64+
lshift_ass_amg, /* 0x2f <<= */
65+
rshift_amg, /* 0x30 >> */
66+
rshift_ass_amg, /* 0x31 >>= */
67+
band_amg, /* 0x32 & */
68+
band_ass_amg, /* 0x33 &= */
69+
sband_amg, /* 0x34 &. */
70+
sband_ass_amg, /* 0x35 &.= */
71+
bor_amg, /* 0x36 | */
72+
bor_ass_amg, /* 0x37 |= */
73+
sbor_amg, /* 0x38 |. */
74+
sbor_ass_amg, /* 0x39 |.= */
75+
bxor_amg, /* 0x3a ^ */
76+
bxor_ass_amg, /* 0x3b ^= */
77+
sbxor_amg, /* 0x3c ^. */
78+
sbxor_ass_amg, /* 0x3d ^.= */
79+
ncmp_amg, /* 0x3e <=> */
80+
scmp_amg, /* 0x3f cmp */
81+
compl_amg, /* 0x40 ~ */
82+
scompl_amg, /* 0x41 ~. */
83+
atan2_amg, /* 0x42 atan2 */
84+
cos_amg, /* 0x43 cos */
85+
sin_amg, /* 0x44 sin */
86+
exp_amg, /* 0x45 exp */
87+
log_amg, /* 0x46 log */
88+
sqrt_amg, /* 0x47 sqrt */
89+
repeat_amg, /* 0x48 x */
90+
repeat_ass_amg, /* 0x49 x= */
91+
concat_amg, /* 0x4a . */
92+
concat_ass_amg, /* 0x4b .= */
93+
smart_amg, /* 0x4c ~~ */
94+
ftest_amg, /* 0x4d -X */
95+
regexp_amg, /* 0x4e qr */
9296
max_amg_code
9397
/* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */
9498
};

‎overload.inc‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -40,12 +40,16 @@ static const U8 PL_AMG_namelens[NofAMmeth] = {
4040
3,
4141
3,
4242
3,
43+
4,
44+
4,
4345
3,
4446
3,
4547
3,
4648
3,
4749
3,
4850
3,
51+
4,
52+
4,
4953
9,
5054
2,
5155
3,
@@ -123,12 +127,16 @@ static const char * const PL_AMG_names[NofAMmeth] = {
123127
"(>=", /* ge */
124128
"(==", /* eq */
125129
"(!=", /* ne */
130+
"(===", /* equ */
131+
"(!==", /* neu */
126132
"(lt", /* slt */
127133
"(le", /* sle */
128134
"(gt", /* sgt */
129135
"(ge", /* sge */
130136
"(eq", /* seq */
131137
"(ne", /* sne */
138+
"(equ", /* sequ */
139+
"(neu", /* sneu */
132140
"(nomethod", /* nomethod */
133141
"(+", /* add */
134142
"(+=", /* add_ass */

0 commit comments

Comments
 (0)