1
# operators defined in the setting
3
multi sub infix:<...> (@lhs, @rhs) {
4
if @rhs == 2 && @rhs[0] ~~ Code {
5
&infix:<...>(@lhs, @rhs[0], :limit(@rhs[1]));
7
die "don't know how to handle a right-hand side of"
9
~ "in series operator";
13
multi sub infix:<...>($lhs, @rhs) {
15
&infix:<...>(@a, @rhs);
18
multi sub infix:<...>($lhs, Whatever $) {
19
die 'Sorry, lazy lists and infinite ranges are not yet implemented';
22
multi sub infix:<...>(@lhs, Whatever $) {
23
die 'Sorry, lazy lists and infinite ranges are not yet implemented';
26
multi sub infix:<...>($lhs, Code $generator) {
28
&infix:<...>(@a, $generator);
31
multi sub infix:<...> (@lhs, Code $generator, :$limit) {
32
my $c = $generator.count;
34
fail 'the closure wants more parameters than given on the LHS';
39
# WhateverCode objects don't have a signature yet (RT #69362),
40
# and we can't simply use a try { ... } block because its result
41
# throws a "Null PMC access in get_bool()" when used in boolean context.
42
# we have to use an ugly special case here.
43
# and we can't even used !~~ for that (RT #69364)
44
if !$generator.^isa(WhateverCode) and any( $generator.signature.params>>.slurpy ) {
45
$argument-indexes = 0..*-1;
47
$argument-indexes = *-$c .. *-1;
50
# XXX work around http://rt.perl.org/rt3/Ticket/Display.html?id=66824
51
# this is a bit ugly.. since @a[1..1] returns a single item and not
52
# an array, |@result[$one-item-range] throws the error
53
# "argument doesn't array"
56
$comp = @lhs[*-1] cmp $limit;
59
while @r = $generator(|@(@result[$argument-indexes])) {
60
if (defined($limit)) {
61
if (@r[*-1] cmp $limit) == 0 {
64
} elsif (@r[*-1] cmp $limit) != $comp {
74
# the magic one that handles stuff like
75
# 'a' ... 'z' and 'z' ... 'a'
76
multi sub infix:<...>($lhs, $rhs where { !($_ ~~ Code|Whatever) }) {
79
if ($lhs cmp $rhs) == 1 {
81
# since my $a = 'a'; $a-- gives
82
# "Decrement out of range" we can't easily
83
# decrement over our target, which is why the
84
# case of going backwards is slighly more complicated
86
while (--$x cmp $rhs) == 1 {
87
# need to make a fresh copy here because of RT #62178
91
take $x if ($x cmp $rhs) == 0;
92
} elsif ($lhs cmp $rhs) == -1 {
94
while (++$x cmp $rhs) <= 0 {
102
multi sub infix:<eqv> (Num $a, Num $b) { $a === $b }
103
multi sub infix:<eqv> (Str $a, Str $b) { $a === $b }
104
multi sub infix:<eqv> (Code $a, Code $b) { $a === $b }
105
multi sub infix:<eqv> (Bool $a, Bool $b) { $a === $b }
106
multi sub infix:<eqv> (Rat $a, Rat $b) {
107
$a.numerator === $b.numerator && $a.denominator == $b.denominator
109
multi sub infix:<eqv> (Positional $a, Positional $b) {
110
return Bool::False unless $a.WHAT === $b.WHAT;
111
return Bool::False unless $a.elems == $b.elems;
112
for @($a) Z @($b) -> $x, $y {
113
return Bool::False unless $x eqv $y;
118
multi sub infix:<eqv>(Pair $a, Pair $b) {
119
$a.key eqv $b.key && $a.value eqv $b.value;
122
multi sub infix:<eqv>(Mapping $a, Mapping $b) {
123
return Bool::False if +$a != +$b;
124
for $a.kv -> $k, $v {
125
return Bool::False unless $b.exists($k);
126
return Bool::False unless $b.{$k} eqv $v;
131
multi sub infix:<eqv>(Failure $a, Failure $b) {
132
# do we have different values of undef yet?
133
# if so, how do I detect them?
137
multi sub infix:<eqv> ($a, $b) {
138
return Bool::False unless $a.WHAT === $b.WHAT;
139
return Bool::True if $a === $b;
140
die "infix:<eqv> is only implemented for certain special cases yet."
141
~"\n You tried to compare two objects of type " ~ $a.WHAT.perl;
144
multi sub infix:<minmax>(@a, @b) {
145
(@a[0] min @b[0], @a[1] max @b[1]);
148
multi sub infix:<leg>($a, $b) {
152
sub prefix:<[//]>(*@a) {
160
sub prefix:<[||]>(*@a) {
168
multi sub infix:<!%>($a, $b) { ! ($a % $b) }
171
multi sub infix:<+>($a, $b) {
182
multi sub infix:<->($a, $b) {
193
multi sub infix:<*>($a, $b) {
204
multi sub infix:</>($a, $b) {
215
multi sub infix:<%>($a, $b) {
226
multi sub infix:<**>($a, $b) {
237
multi sub prefix:<->($a) {
247
multi sub prefix:<~>(Object $a) {
257
multi sub prefix:<~>(Multi $a) { $a.name }
259
multi sub infix:<!=>($a, $b) { !($a == $b) }
260
multi sub infix:<!==>($a, $b) { !($a == $b) }
261
multi sub infix:<ne>($a, $b) { !($a eq $b) }
262
multi sub infix:<!eq>($a, $b) { !($a eq $b) }
264
multi sub infix:<< < >>($a, $b) {
275
multi sub infix:<< > >>($a, $b) {
286
multi sub infix:<< <= >>($a, $b) {
297
multi sub infix:<< >= >>($a, $b) {
308
multi sub infix:<< < >>(Whatever $a, $b) {
312
.tailcall 'WhateverCodeX'('infix:<', $P0, $P1)
316
multi sub infix:<< < >>($a, Whatever $b) {
320
.tailcall 'WhateverCodeX'('infix:<', $P0, $P1)
324
multi sub infix:<< > >>(Whatever $a, $b) {
328
.tailcall 'WhateverCodeX'('infix:>', $P0, $P1)
332
multi sub infix:<< > >>($a, Whatever $b) {
336
.tailcall 'WhateverCodeX'('infix:>', $P0, $P1)
340
multi sub infix:<< <= >>(Whatever $a, $b) {
344
.tailcall 'WhateverCodeX'('infix:<=', $P0, $P1)
348
multi sub infix:<< <= >>($a, Whatever $b) {
352
.tailcall 'WhateverCodeX'('infix:<=', $P0, $P1)
356
multi sub infix:<< >= >>(Whatever $a, $b) {
360
.tailcall 'WhateverCodeX'('infix:>=', $P0, $P1)
364
multi sub infix:<< >= >>($a, Whatever $b) {
368
.tailcall 'WhateverCodeX'('infix:>=', $P0, $P1)
added
removed
src/setting/Operators.pm
