| 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, 2022-2023 -- leonerd@leonerd.org.uk |
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Syntax::Operator::Identical 0.01; |
|
7
|
|
|
|
|
|
|
|
|
8
|
4
|
|
|
4
|
|
727544
|
use v5.14; |
|
|
4
|
|
|
|
|
41
|
|
|
9
|
4
|
|
|
4
|
|
26
|
use warnings; |
|
|
4
|
|
|
|
|
12
|
|
|
|
4
|
|
|
|
|
100
|
|
|
10
|
|
|
|
|
|
|
|
|
11
|
4
|
|
|
4
|
|
22
|
use Carp; |
|
|
4
|
|
|
|
|
7
|
|
|
|
4
|
|
|
|
|
1359
|
|
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
require XSLoader; |
|
14
|
|
|
|
|
|
|
XSLoader::load( __PACKAGE__, our $VERSION ); |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=encoding UTF-8 |
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 NAME |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
C - almost certainly a terrible idea; don't use this |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
You almost certainly don't want to use this. |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
However, if despite all my warnings you still want to, then on Perl v5.38 or |
|
27
|
|
|
|
|
|
|
later: |
|
28
|
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
use v5.38; |
|
30
|
|
|
|
|
|
|
use Syntax::Operator::Identical; |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my $x = ...; |
|
33
|
|
|
|
|
|
|
my $y = ...; |
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
if( $x ≡ $y ) { |
|
36
|
|
|
|
|
|
|
say "x and y are identical"; |
|
37
|
|
|
|
|
|
|
} |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
Or via L on Perl v5.14 or later: |
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
use v5.14; |
|
42
|
|
|
|
|
|
|
use Syntax::Keyword::Match; |
|
43
|
|
|
|
|
|
|
use Syntax::Operator::Identical; |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
my $x = ...; |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
match($x : ≡) { |
|
48
|
|
|
|
|
|
|
case(undef) { say "The value is not defined" } |
|
49
|
|
|
|
|
|
|
case(123) { say "The value is identical to 123" } |
|
50
|
|
|
|
|
|
|
case("abc") { say "The value is identical to abc" } |
|
51
|
|
|
|
|
|
|
} |
|
52
|
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
54
|
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
This module provides an infix operator that implements an identity test |
|
56
|
|
|
|
|
|
|
between two values, in a way somewhat similar to the now-deprecated smartmatch |
|
57
|
|
|
|
|
|
|
(C<~~>) operator, or other similar ideas. |
|
58
|
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
It is probably not a good idea to use this operator; it is written largely as |
|
60
|
|
|
|
|
|
|
a demonstration on how such an operator I be implemented, as well as to |
|
61
|
|
|
|
|
|
|
illustrate how fragile it is, in particular around the "is it a string or a |
|
62
|
|
|
|
|
|
|
number?" part of the logic. |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=head2 Comparison Logic |
|
65
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
This operator acts symmetrically; that is, given any pair of values C<$x> and |
|
67
|
|
|
|
|
|
|
C<$y>, the result of C<$x ≡ $y> will be the same as C<$y ≡ $x>. It uses the |
|
68
|
|
|
|
|
|
|
following rules: |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=over 4 |
|
71
|
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=item * Definedness |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
If both values are C, the operator yields true. Otherwise, if one value |
|
75
|
|
|
|
|
|
|
is defined and the other is not, it yields false. |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=item * Booleans (on Perl v5.36 or later) |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
If both values are booleans (as according to C), then the |
|
80
|
|
|
|
|
|
|
operator returns true or false depending on whether they have the same value. |
|
81
|
|
|
|
|
|
|
Otherwise, if only one is a boolean then it yields false. |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=item * References |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
If both values are references, the operator yields true or false depending on |
|
86
|
|
|
|
|
|
|
whether they both refer to the same thing. Otherwise, if only one is a |
|
87
|
|
|
|
|
|
|
reference it returns false. |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=item * Non-references |
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
For any other pairs of values, if I value has a numerical part, then a |
|
92
|
|
|
|
|
|
|
numerical comparison is made as per the C<==> operator, and if that is false |
|
93
|
|
|
|
|
|
|
then this operator yields false. Then, if I value has a stringy part, |
|
94
|
|
|
|
|
|
|
then a string comparison is made as per the C operator, and if that is |
|
95
|
|
|
|
|
|
|
false then this operator yields false. Because non-defined and reference |
|
96
|
|
|
|
|
|
|
values have already been considered at this point, at least one of these tests |
|
97
|
|
|
|
|
|
|
must necessarily be performed. |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
At this point, if there are no other reasons to reject it, the operator yields |
|
100
|
|
|
|
|
|
|
true. |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=back |
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
As a consequence of the boolean rule, on Perl v5.36 or later, real boolean |
|
105
|
|
|
|
|
|
|
values are not identical to either the numfied or stringified values they |
|
106
|
|
|
|
|
|
|
would yield. |
|
107
|
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
(5 == 5) == 1; # is true |
|
109
|
|
|
|
|
|
|
(5 == 5) ≡ 1; # is false |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
(5 == 5) eq "1"; # is true |
|
112
|
|
|
|
|
|
|
(5 == 5) ≡ "1"; # is false |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
As a consequence of the reference rule, references are not identical to a |
|
115
|
|
|
|
|
|
|
numified or stringified copy of themselves. |
|
116
|
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
my $aref = []; |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
$aref == 0+$aref; # is true |
|
120
|
|
|
|
|
|
|
$aref ≡ 0+$aref; # is false |
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
$aref eq "$aref"; # is true |
|
123
|
|
|
|
|
|
|
$aref ≡ "$aref"; # is false |
|
124
|
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
Also as a consequence of the reference rule, any reference to an object is |
|
126
|
|
|
|
|
|
|
never considered identical to a plain string or number, I that object |
|
127
|
|
|
|
|
|
|
overloads the string or number comparison operators in a way that would |
|
128
|
|
|
|
|
|
|
consider it to be. |
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
As a consequence of the final non-reference rule, comparisons between a |
|
131
|
|
|
|
|
|
|
mixture of pure-number and pure-string values will be more strict than either |
|
132
|
|
|
|
|
|
|
the C<==> or C operator alone would perform. Both operators must consider |
|
133
|
|
|
|
|
|
|
the values equal for it to pass. |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
10 == "10.0"; # is true |
|
136
|
|
|
|
|
|
|
10 ≡ "10.0"; # is false, because eq says so |
|
137
|
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=cut |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub import |
|
141
|
|
|
|
|
|
|
{ |
|
142
|
4
|
|
|
4
|
|
301
|
my $pkg = shift; |
|
143
|
4
|
|
|
|
|
13
|
my $caller = caller; |
|
144
|
|
|
|
|
|
|
|
|
145
|
4
|
|
|
|
|
16
|
$pkg->import_into( $caller, @_ ); |
|
146
|
|
|
|
|
|
|
} |
|
147
|
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub unimport |
|
149
|
|
|
|
|
|
|
{ |
|
150
|
0
|
|
|
0
|
|
0
|
my $pkg = shift; |
|
151
|
0
|
|
|
|
|
0
|
my $caller = caller; |
|
152
|
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
0
|
$pkg->unimport_into( $caller, @_ ); |
|
154
|
|
|
|
|
|
|
} |
|
155
|
|
|
|
|
|
|
|
|
156
|
4
|
|
|
4
|
0
|
11
|
sub import_into { shift->apply( 1, @_ ) } |
|
157
|
0
|
|
|
0
|
0
|
0
|
sub unimport_into { shift->apply( 0, @_ ) } |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub apply |
|
160
|
|
|
|
|
|
|
{ |
|
161
|
4
|
|
|
4
|
0
|
6
|
my $pkg = shift; |
|
162
|
4
|
|
|
|
|
14
|
my ( $on, $caller, @syms ) = @_; |
|
163
|
|
|
|
|
|
|
|
|
164
|
4
|
100
|
|
|
|
23
|
@syms or @syms = qw( identical ); |
|
165
|
|
|
|
|
|
|
|
|
166
|
4
|
|
|
|
|
10
|
my %syms = map { $_ => 1 } @syms; |
|
|
6
|
|
|
|
|
21
|
|
|
167
|
4
|
100
|
|
|
|
21
|
if( delete $syms{identical} ) { |
|
168
|
|
|
|
|
|
|
$on ? $^H{"Syntax::Operator::Identical/identical"}++ |
|
169
|
2
|
50
|
|
|
|
36
|
: delete $^H{"Syntax::Operator::Identical/identical"}; |
|
170
|
|
|
|
|
|
|
} |
|
171
|
|
|
|
|
|
|
|
|
172
|
4
|
|
|
|
|
31
|
foreach (qw( is_identical is_not_identical )) { |
|
173
|
8
|
100
|
|
|
|
32
|
next unless delete $syms{$_}; |
|
174
|
|
|
|
|
|
|
|
|
175
|
4
|
|
|
4
|
|
32
|
no strict 'refs'; |
|
|
4
|
|
|
|
|
15
|
|
|
|
4
|
|
|
|
|
679
|
|
|
176
|
4
|
50
|
|
|
|
11
|
$on ? *{"${caller}::$_"} = \&{$_} |
|
|
4
|
|
|
|
|
21
|
|
|
|
4
|
|
|
|
|
12
|
|
|
177
|
|
|
|
|
|
|
: warn "TODO: implement unimport of package symbol"; |
|
178
|
|
|
|
|
|
|
} |
|
179
|
|
|
|
|
|
|
|
|
180
|
4
|
50
|
|
|
|
4496
|
croak "Unrecognised import symbols @{[ keys %syms ]}" if keys %syms; |
|
|
0
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
} |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head1 OPERATORS |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=head2 ≡, =:= |
|
186
|
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
my $equal = $lhs ≡ $rhs; |
|
188
|
|
|
|
|
|
|
my $equal = $lhs =:= $rhs; |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Yields true if the two operands are identical, using the rules defined above. |
|
191
|
|
|
|
|
|
|
The two different spellings are aliases; the latter is simply an ASCII-safe |
|
192
|
|
|
|
|
|
|
variant to avoid needing to type the C<≡> symbol. |
|
193
|
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=head2 ≢, !:= |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
my $unequal = $lhs ≢ $rhs; |
|
197
|
|
|
|
|
|
|
my $unequal = $lhs !:= $rhs; |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
The complement operator to C<≡>; yielding true where it would yield false, and |
|
200
|
|
|
|
|
|
|
vice versa. The two different spellings are aliases; the latter is simply an |
|
201
|
|
|
|
|
|
|
ASCII-safe variant to avoid needing to type the C<≢> symbol. |
|
202
|
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=head1 FUNCTIONS |
|
204
|
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
As a convenience, the following functions may be imported which implement the |
|
206
|
|
|
|
|
|
|
same behaviour as the infix operators, though are accessed via regular |
|
207
|
|
|
|
|
|
|
function call syntax. |
|
208
|
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
These wrapper functions are implemented using L, and thus |
|
210
|
|
|
|
|
|
|
have an optimising call-checker attached to them. In most cases, code which |
|
211
|
|
|
|
|
|
|
calls them should not in fact have the full runtime overhead of a function |
|
212
|
|
|
|
|
|
|
call because the underlying test operator will get inlined into the calling |
|
213
|
|
|
|
|
|
|
code at compiletime. In effect, code calling these functions should run with |
|
214
|
|
|
|
|
|
|
the same performance as code using the infix operators directly. |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=head2 is_identical |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
my $equal = is_identical( $lhs, $rhs ); |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
A function version of the C<≡> operator. |
|
221
|
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=head2 is_not_identical |
|
223
|
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
my $unequal = is_not_identical( $lhs, $rhs ); |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
A function version of the C<≢> operator. |
|
227
|
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=cut |
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head1 AUTHOR |
|
231
|
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Paul Evans |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=cut |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
0x55AA; |