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; |