1 | package overload;
|
---|
2 |
|
---|
3 | our $VERSION = '1.04';
|
---|
4 |
|
---|
5 | $overload::hint_bits = 0x20000; # HINT_LOCALIZE_HH
|
---|
6 |
|
---|
7 | sub nil {}
|
---|
8 |
|
---|
9 | sub OVERLOAD {
|
---|
10 | $package = shift;
|
---|
11 | my %arg = @_;
|
---|
12 | my ($sub, $fb);
|
---|
13 | $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
|
---|
14 | *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
|
---|
15 | for (keys %arg) {
|
---|
16 | if ($_ eq 'fallback') {
|
---|
17 | $fb = $arg{$_};
|
---|
18 | } else {
|
---|
19 | $sub = $arg{$_};
|
---|
20 | if (not ref $sub and $sub !~ /::/) {
|
---|
21 | $ {$package . "::(" . $_} = $sub;
|
---|
22 | $sub = \&nil;
|
---|
23 | }
|
---|
24 | #print STDERR "Setting `$ {'package'}::\cO$_' to \\&`$sub'.\n";
|
---|
25 | *{$package . "::(" . $_} = \&{ $sub };
|
---|
26 | }
|
---|
27 | }
|
---|
28 | ${$package . "::()"} = $fb; # Make it findable too (fallback only).
|
---|
29 | }
|
---|
30 |
|
---|
31 | sub import {
|
---|
32 | $package = (caller())[0];
|
---|
33 | # *{$package . "::OVERLOAD"} = \&OVERLOAD;
|
---|
34 | shift;
|
---|
35 | $package->overload::OVERLOAD(@_);
|
---|
36 | }
|
---|
37 |
|
---|
38 | sub unimport {
|
---|
39 | $package = (caller())[0];
|
---|
40 | ${$package . "::OVERLOAD"}{dummy}++; # Upgrade the table
|
---|
41 | shift;
|
---|
42 | for (@_) {
|
---|
43 | if ($_ eq 'fallback') {
|
---|
44 | undef $ {$package . "::()"};
|
---|
45 | } else {
|
---|
46 | delete $ {$package . "::"}{"(" . $_};
|
---|
47 | }
|
---|
48 | }
|
---|
49 | }
|
---|
50 |
|
---|
51 | sub Overloaded {
|
---|
52 | my $package = shift;
|
---|
53 | $package = ref $package if ref $package;
|
---|
54 | $package->can('()');
|
---|
55 | }
|
---|
56 |
|
---|
57 | sub ov_method {
|
---|
58 | my $globref = shift;
|
---|
59 | return undef unless $globref;
|
---|
60 | my $sub = \&{*$globref};
|
---|
61 | return $sub if $sub ne \&nil;
|
---|
62 | return shift->can($ {*$globref});
|
---|
63 | }
|
---|
64 |
|
---|
65 | sub OverloadedStringify {
|
---|
66 | my $package = shift;
|
---|
67 | $package = ref $package if ref $package;
|
---|
68 | #$package->can('(""')
|
---|
69 | ov_method mycan($package, '(""'), $package
|
---|
70 | or ov_method mycan($package, '(0+'), $package
|
---|
71 | or ov_method mycan($package, '(bool'), $package
|
---|
72 | or ov_method mycan($package, '(nomethod'), $package;
|
---|
73 | }
|
---|
74 |
|
---|
75 | sub Method {
|
---|
76 | my $package = shift;
|
---|
77 | $package = ref $package if ref $package;
|
---|
78 | #my $meth = $package->can('(' . shift);
|
---|
79 | ov_method mycan($package, '(' . shift), $package;
|
---|
80 | #return $meth if $meth ne \&nil;
|
---|
81 | #return $ {*{$meth}};
|
---|
82 | }
|
---|
83 |
|
---|
84 | sub AddrRef {
|
---|
85 | my $package = ref $_[0];
|
---|
86 | return "$_[0]" unless $package;
|
---|
87 |
|
---|
88 | require Scalar::Util;
|
---|
89 | my $class = Scalar::Util::blessed($_[0]);
|
---|
90 | my $class_prefix = defined($class) ? "$class=" : "";
|
---|
91 | my $type = Scalar::Util::reftype($_[0]);
|
---|
92 | my $addr = Scalar::Util::refaddr($_[0]);
|
---|
93 | return sprintf("$class_prefix$type(0x%x)", $addr);
|
---|
94 | }
|
---|
95 |
|
---|
96 | *StrVal = *AddrRef;
|
---|
97 |
|
---|
98 | sub mycan { # Real can would leave stubs.
|
---|
99 | my ($package, $meth) = @_;
|
---|
100 | return \*{$package . "::$meth"} if defined &{$package . "::$meth"};
|
---|
101 | my $p;
|
---|
102 | foreach $p (@{$package . "::ISA"}) {
|
---|
103 | my $out = mycan($p, $meth);
|
---|
104 | return $out if $out;
|
---|
105 | }
|
---|
106 | return undef;
|
---|
107 | }
|
---|
108 |
|
---|
109 | %constants = (
|
---|
110 | 'integer' => 0x1000, # HINT_NEW_INTEGER
|
---|
111 | 'float' => 0x2000, # HINT_NEW_FLOAT
|
---|
112 | 'binary' => 0x4000, # HINT_NEW_BINARY
|
---|
113 | 'q' => 0x8000, # HINT_NEW_STRING
|
---|
114 | 'qr' => 0x10000, # HINT_NEW_RE
|
---|
115 | );
|
---|
116 |
|
---|
117 | %ops = ( with_assign => "+ - * / % ** << >> x .",
|
---|
118 | assign => "+= -= *= /= %= **= <<= >>= x= .=",
|
---|
119 | num_comparison => "< <= > >= == !=",
|
---|
120 | '3way_comparison'=> "<=> cmp",
|
---|
121 | str_comparison => "lt le gt ge eq ne",
|
---|
122 | binary => "& | ^",
|
---|
123 | unary => "neg ! ~",
|
---|
124 | mutators => '++ --',
|
---|
125 | func => "atan2 cos sin exp abs log sqrt int",
|
---|
126 | conversion => 'bool "" 0+',
|
---|
127 | iterators => '<>',
|
---|
128 | dereferencing => '${} @{} %{} &{} *{}',
|
---|
129 | special => 'nomethod fallback =');
|
---|
130 |
|
---|
131 | use warnings::register;
|
---|
132 | sub constant {
|
---|
133 | # Arguments: what, sub
|
---|
134 | while (@_) {
|
---|
135 | if (@_ == 1) {
|
---|
136 | warnings::warnif ("Odd number of arguments for overload::constant");
|
---|
137 | last;
|
---|
138 | }
|
---|
139 | elsif (!exists $constants {$_ [0]}) {
|
---|
140 | warnings::warnif ("`$_[0]' is not an overloadable type");
|
---|
141 | }
|
---|
142 | elsif (!ref $_ [1] || "$_[1]" !~ /CODE\(0x[\da-f]+\)$/) {
|
---|
143 | # Can't use C<ref $_[1] eq "CODE"> above as code references can be
|
---|
144 | # blessed, and C<ref> would return the package the ref is blessed into.
|
---|
145 | if (warnings::enabled) {
|
---|
146 | $_ [1] = "undef" unless defined $_ [1];
|
---|
147 | warnings::warn ("`$_[1]' is not a code reference");
|
---|
148 | }
|
---|
149 | }
|
---|
150 | else {
|
---|
151 | $^H{$_[0]} = $_[1];
|
---|
152 | $^H |= $constants{$_[0]} | $overload::hint_bits;
|
---|
153 | }
|
---|
154 | shift, shift;
|
---|
155 | }
|
---|
156 | }
|
---|
157 |
|
---|
158 | sub remove_constant {
|
---|
159 | # Arguments: what, sub
|
---|
160 | while (@_) {
|
---|
161 | delete $^H{$_[0]};
|
---|
162 | $^H &= ~ $constants{$_[0]};
|
---|
163 | shift, shift;
|
---|
164 | }
|
---|
165 | }
|
---|
166 |
|
---|
167 | 1;
|
---|
168 |
|
---|
169 | __END__
|
---|
170 |
|
---|
171 | =head1 NAME
|
---|
172 |
|
---|
173 | overload - Package for overloading Perl operations
|
---|
174 |
|
---|
175 | =head1 SYNOPSIS
|
---|
176 |
|
---|
177 | package SomeThing;
|
---|
178 |
|
---|
179 | use overload
|
---|
180 | '+' => \&myadd,
|
---|
181 | '-' => \&mysub;
|
---|
182 | # etc
|
---|
183 | ...
|
---|
184 |
|
---|
185 | package main;
|
---|
186 | $a = new SomeThing 57;
|
---|
187 | $b=5+$a;
|
---|
188 | ...
|
---|
189 | if (overload::Overloaded $b) {...}
|
---|
190 | ...
|
---|
191 | $strval = overload::StrVal $b;
|
---|
192 |
|
---|
193 | =head1 DESCRIPTION
|
---|
194 |
|
---|
195 | =head2 Declaration of overloaded functions
|
---|
196 |
|
---|
197 | The compilation directive
|
---|
198 |
|
---|
199 | package Number;
|
---|
200 | use overload
|
---|
201 | "+" => \&add,
|
---|
202 | "*=" => "muas";
|
---|
203 |
|
---|
204 | declares function Number::add() for addition, and method muas() in
|
---|
205 | the "class" C<Number> (or one of its base classes)
|
---|
206 | for the assignment form C<*=> of multiplication.
|
---|
207 |
|
---|
208 | Arguments of this directive come in (key, value) pairs. Legal values
|
---|
209 | are values legal inside a C<&{ ... }> call, so the name of a
|
---|
210 | subroutine, a reference to a subroutine, or an anonymous subroutine
|
---|
211 | will all work. Note that values specified as strings are
|
---|
212 | interpreted as methods, not subroutines. Legal keys are listed below.
|
---|
213 |
|
---|
214 | The subroutine C<add> will be called to execute C<$a+$b> if $a
|
---|
215 | is a reference to an object blessed into the package C<Number>, or if $a is
|
---|
216 | not an object from a package with defined mathemagic addition, but $b is a
|
---|
217 | reference to a C<Number>. It can also be called in other situations, like
|
---|
218 | C<$a+=7>, or C<$a++>. See L<MAGIC AUTOGENERATION>. (Mathemagical
|
---|
219 | methods refer to methods triggered by an overloaded mathematical
|
---|
220 | operator.)
|
---|
221 |
|
---|
222 | Since overloading respects inheritance via the @ISA hierarchy, the
|
---|
223 | above declaration would also trigger overloading of C<+> and C<*=> in
|
---|
224 | all the packages which inherit from C<Number>.
|
---|
225 |
|
---|
226 | =head2 Calling Conventions for Binary Operations
|
---|
227 |
|
---|
228 | The functions specified in the C<use overload ...> directive are called
|
---|
229 | with three (in one particular case with four, see L<Last Resort>)
|
---|
230 | arguments. If the corresponding operation is binary, then the first
|
---|
231 | two arguments are the two arguments of the operation. However, due to
|
---|
232 | general object calling conventions, the first argument should always be
|
---|
233 | an object in the package, so in the situation of C<7+$a>, the
|
---|
234 | order of the arguments is interchanged. It probably does not matter
|
---|
235 | when implementing the addition method, but whether the arguments
|
---|
236 | are reversed is vital to the subtraction method. The method can
|
---|
237 | query this information by examining the third argument, which can take
|
---|
238 | three different values:
|
---|
239 |
|
---|
240 | =over 7
|
---|
241 |
|
---|
242 | =item FALSE
|
---|
243 |
|
---|
244 | the order of arguments is as in the current operation.
|
---|
245 |
|
---|
246 | =item TRUE
|
---|
247 |
|
---|
248 | the arguments are reversed.
|
---|
249 |
|
---|
250 | =item C<undef>
|
---|
251 |
|
---|
252 | the current operation is an assignment variant (as in
|
---|
253 | C<$a+=7>), but the usual function is called instead. This additional
|
---|
254 | information can be used to generate some optimizations. Compare
|
---|
255 | L<Calling Conventions for Mutators>.
|
---|
256 |
|
---|
257 | =back
|
---|
258 |
|
---|
259 | =head2 Calling Conventions for Unary Operations
|
---|
260 |
|
---|
261 | Unary operation are considered binary operations with the second
|
---|
262 | argument being C<undef>. Thus the functions that overloads C<{"++"}>
|
---|
263 | is called with arguments C<($a,undef,'')> when $a++ is executed.
|
---|
264 |
|
---|
265 | =head2 Calling Conventions for Mutators
|
---|
266 |
|
---|
267 | Two types of mutators have different calling conventions:
|
---|
268 |
|
---|
269 | =over
|
---|
270 |
|
---|
271 | =item C<++> and C<-->
|
---|
272 |
|
---|
273 | The routines which implement these operators are expected to actually
|
---|
274 | I<mutate> their arguments. So, assuming that $obj is a reference to a
|
---|
275 | number,
|
---|
276 |
|
---|
277 | sub incr { my $n = $ {$_[0]}; ++$n; $_[0] = bless \$n}
|
---|
278 |
|
---|
279 | is an appropriate implementation of overloaded C<++>. Note that
|
---|
280 |
|
---|
281 | sub incr { ++$ {$_[0]} ; shift }
|
---|
282 |
|
---|
283 | is OK if used with preincrement and with postincrement. (In the case
|
---|
284 | of postincrement a copying will be performed, see L<Copy Constructor>.)
|
---|
285 |
|
---|
286 | =item C<x=> and other assignment versions
|
---|
287 |
|
---|
288 | There is nothing special about these methods. They may change the
|
---|
289 | value of their arguments, and may leave it as is. The result is going
|
---|
290 | to be assigned to the value in the left-hand-side if different from
|
---|
291 | this value.
|
---|
292 |
|
---|
293 | This allows for the same method to be used as overloaded C<+=> and
|
---|
294 | C<+>. Note that this is I<allowed>, but not recommended, since by the
|
---|
295 | semantic of L<"Fallback"> Perl will call the method for C<+> anyway,
|
---|
296 | if C<+=> is not overloaded.
|
---|
297 |
|
---|
298 | =back
|
---|
299 |
|
---|
300 | B<Warning.> Due to the presence of assignment versions of operations,
|
---|
301 | routines which may be called in assignment context may create
|
---|
302 | self-referential structures. Currently Perl will not free self-referential
|
---|
303 | structures until cycles are C<explicitly> broken. You may get problems
|
---|
304 | when traversing your structures too.
|
---|
305 |
|
---|
306 | Say,
|
---|
307 |
|
---|
308 | use overload '+' => sub { bless [ \$_[0], \$_[1] ] };
|
---|
309 |
|
---|
310 | is asking for trouble, since for code C<$obj += $foo> the subroutine
|
---|
311 | is called as C<$obj = add($obj, $foo, undef)>, or C<$obj = [\$obj,
|
---|
312 | \$foo]>. If using such a subroutine is an important optimization, one
|
---|
313 | can overload C<+=> explicitly by a non-"optimized" version, or switch
|
---|
314 | to non-optimized version if C<not defined $_[2]> (see
|
---|
315 | L<Calling Conventions for Binary Operations>).
|
---|
316 |
|
---|
317 | Even if no I<explicit> assignment-variants of operators are present in
|
---|
318 | the script, they may be generated by the optimizer. Say, C<",$obj,"> or
|
---|
319 | C<',' . $obj . ','> may be both optimized to
|
---|
320 |
|
---|
321 | my $tmp = ',' . $obj; $tmp .= ',';
|
---|
322 |
|
---|
323 | =head2 Overloadable Operations
|
---|
324 |
|
---|
325 | The following symbols can be specified in C<use overload> directive:
|
---|
326 |
|
---|
327 | =over 5
|
---|
328 |
|
---|
329 | =item * I<Arithmetic operations>
|
---|
330 |
|
---|
331 | "+", "+=", "-", "-=", "*", "*=", "/", "/=", "%", "%=",
|
---|
332 | "**", "**=", "<<", "<<=", ">>", ">>=", "x", "x=", ".", ".=",
|
---|
333 |
|
---|
334 | For these operations a substituted non-assignment variant can be called if
|
---|
335 | the assignment variant is not available. Methods for operations C<+>,
|
---|
336 | C<->, C<+=>, and C<-=> can be called to automatically generate
|
---|
337 | increment and decrement methods. The operation C<-> can be used to
|
---|
338 | autogenerate missing methods for unary minus or C<abs>.
|
---|
339 |
|
---|
340 | See L<"MAGIC AUTOGENERATION">, L<"Calling Conventions for Mutators"> and
|
---|
341 | L<"Calling Conventions for Binary Operations">) for details of these
|
---|
342 | substitutions.
|
---|
343 |
|
---|
344 | =item * I<Comparison operations>
|
---|
345 |
|
---|
346 | "<", "<=", ">", ">=", "==", "!=", "<=>",
|
---|
347 | "lt", "le", "gt", "ge", "eq", "ne", "cmp",
|
---|
348 |
|
---|
349 | If the corresponding "spaceship" variant is available, it can be
|
---|
350 | used to substitute for the missing operation. During C<sort>ing
|
---|
351 | arrays, C<cmp> is used to compare values subject to C<use overload>.
|
---|
352 |
|
---|
353 | =item * I<Bit operations>
|
---|
354 |
|
---|
355 | "&", "^", "|", "neg", "!", "~",
|
---|
356 |
|
---|
357 | C<neg> stands for unary minus. If the method for C<neg> is not
|
---|
358 | specified, it can be autogenerated using the method for
|
---|
359 | subtraction. If the method for C<!> is not specified, it can be
|
---|
360 | autogenerated using the methods for C<bool>, or C<"">, or C<0+>.
|
---|
361 |
|
---|
362 | =item * I<Increment and decrement>
|
---|
363 |
|
---|
364 | "++", "--",
|
---|
365 |
|
---|
366 | If undefined, addition and subtraction methods can be
|
---|
367 | used instead. These operations are called both in prefix and
|
---|
368 | postfix form.
|
---|
369 |
|
---|
370 | =item * I<Transcendental functions>
|
---|
371 |
|
---|
372 | "atan2", "cos", "sin", "exp", "abs", "log", "sqrt", "int"
|
---|
373 |
|
---|
374 | If C<abs> is unavailable, it can be autogenerated using methods
|
---|
375 | for "E<lt>" or "E<lt>=E<gt>" combined with either unary minus or subtraction.
|
---|
376 |
|
---|
377 | Note that traditionally the Perl function L<int> rounds to 0, thus for
|
---|
378 | floating-point-like types one should follow the same semantic. If
|
---|
379 | C<int> is unavailable, it can be autogenerated using the overloading of
|
---|
380 | C<0+>.
|
---|
381 |
|
---|
382 | =item * I<Boolean, string and numeric conversion>
|
---|
383 |
|
---|
384 | 'bool', '""', '0+',
|
---|
385 |
|
---|
386 | If one or two of these operations are not overloaded, the remaining ones can
|
---|
387 | be used instead. C<bool> is used in the flow control operators
|
---|
388 | (like C<while>) and for the ternary C<?:> operation. These functions can
|
---|
389 | return any arbitrary Perl value. If the corresponding operation for this value
|
---|
390 | is overloaded too, that operation will be called again with this value.
|
---|
391 |
|
---|
392 | As a special case if the overload returns the object itself then it will
|
---|
393 | be used directly. An overloaded conversion returning the object is
|
---|
394 | probably a bug, because you're likely to get something that looks like
|
---|
395 | C<YourPackage=HASH(0x8172b34)>.
|
---|
396 |
|
---|
397 | =item * I<Iteration>
|
---|
398 |
|
---|
399 | "<>"
|
---|
400 |
|
---|
401 | If not overloaded, the argument will be converted to a filehandle or
|
---|
402 | glob (which may require a stringification). The same overloading
|
---|
403 | happens both for the I<read-filehandle> syntax C<E<lt>$varE<gt>> and
|
---|
404 | I<globbing> syntax C<E<lt>${var}E<gt>>.
|
---|
405 |
|
---|
406 | B<BUGS> Even in list context, the iterator is currently called only
|
---|
407 | once and with scalar context.
|
---|
408 |
|
---|
409 | =item * I<Dereferencing>
|
---|
410 |
|
---|
411 | '${}', '@{}', '%{}', '&{}', '*{}'.
|
---|
412 |
|
---|
413 | If not overloaded, the argument will be dereferenced I<as is>, thus
|
---|
414 | should be of correct type. These functions should return a reference
|
---|
415 | of correct type, or another object with overloaded dereferencing.
|
---|
416 |
|
---|
417 | As a special case if the overload returns the object itself then it
|
---|
418 | will be used directly (provided it is the correct type).
|
---|
419 |
|
---|
420 | The dereference operators must be specified explicitly they will not be passed to
|
---|
421 | "nomethod".
|
---|
422 |
|
---|
423 | =item * I<Special>
|
---|
424 |
|
---|
425 | "nomethod", "fallback", "=",
|
---|
426 |
|
---|
427 | see L<SPECIAL SYMBOLS FOR C<use overload>>.
|
---|
428 |
|
---|
429 | =back
|
---|
430 |
|
---|
431 | See L<"Fallback"> for an explanation of when a missing method can be
|
---|
432 | autogenerated.
|
---|
433 |
|
---|
434 | A computer-readable form of the above table is available in the hash
|
---|
435 | %overload::ops, with values being space-separated lists of names:
|
---|
436 |
|
---|
437 | with_assign => '+ - * / % ** << >> x .',
|
---|
438 | assign => '+= -= *= /= %= **= <<= >>= x= .=',
|
---|
439 | num_comparison => '< <= > >= == !=',
|
---|
440 | '3way_comparison'=> '<=> cmp',
|
---|
441 | str_comparison => 'lt le gt ge eq ne',
|
---|
442 | binary => '& | ^',
|
---|
443 | unary => 'neg ! ~',
|
---|
444 | mutators => '++ --',
|
---|
445 | func => 'atan2 cos sin exp abs log sqrt',
|
---|
446 | conversion => 'bool "" 0+',
|
---|
447 | iterators => '<>',
|
---|
448 | dereferencing => '${} @{} %{} &{} *{}',
|
---|
449 | special => 'nomethod fallback ='
|
---|
450 |
|
---|
451 | =head2 Inheritance and overloading
|
---|
452 |
|
---|
453 | Inheritance interacts with overloading in two ways.
|
---|
454 |
|
---|
455 | =over
|
---|
456 |
|
---|
457 | =item Strings as values of C<use overload> directive
|
---|
458 |
|
---|
459 | If C<value> in
|
---|
460 |
|
---|
461 | use overload key => value;
|
---|
462 |
|
---|
463 | is a string, it is interpreted as a method name.
|
---|
464 |
|
---|
465 | =item Overloading of an operation is inherited by derived classes
|
---|
466 |
|
---|
467 | Any class derived from an overloaded class is also overloaded. The
|
---|
468 | set of overloaded methods is the union of overloaded methods of all
|
---|
469 | the ancestors. If some method is overloaded in several ancestor, then
|
---|
470 | which description will be used is decided by the usual inheritance
|
---|
471 | rules:
|
---|
472 |
|
---|
473 | If C<A> inherits from C<B> and C<C> (in this order), C<B> overloads
|
---|
474 | C<+> with C<\&D::plus_sub>, and C<C> overloads C<+> by C<"plus_meth">,
|
---|
475 | then the subroutine C<D::plus_sub> will be called to implement
|
---|
476 | operation C<+> for an object in package C<A>.
|
---|
477 |
|
---|
478 | =back
|
---|
479 |
|
---|
480 | Note that since the value of the C<fallback> key is not a subroutine,
|
---|
481 | its inheritance is not governed by the above rules. In the current
|
---|
482 | implementation, the value of C<fallback> in the first overloaded
|
---|
483 | ancestor is used, but this is accidental and subject to change.
|
---|
484 |
|
---|
485 | =head1 SPECIAL SYMBOLS FOR C<use overload>
|
---|
486 |
|
---|
487 | Three keys are recognized by Perl that are not covered by the above
|
---|
488 | description.
|
---|
489 |
|
---|
490 | =head2 Last Resort
|
---|
491 |
|
---|
492 | C<"nomethod"> should be followed by a reference to a function of four
|
---|
493 | parameters. If defined, it is called when the overloading mechanism
|
---|
494 | cannot find a method for some operation. The first three arguments of
|
---|
495 | this function coincide with the arguments for the corresponding method if
|
---|
496 | it were found, the fourth argument is the symbol
|
---|
497 | corresponding to the missing method. If several methods are tried,
|
---|
498 | the last one is used. Say, C<1-$a> can be equivalent to
|
---|
499 |
|
---|
500 | &nomethodMethod($a,1,1,"-")
|
---|
501 |
|
---|
502 | if the pair C<"nomethod" =E<gt> "nomethodMethod"> was specified in the
|
---|
503 | C<use overload> directive.
|
---|
504 |
|
---|
505 | The C<"nomethod"> mechanism is I<not> used for the dereference operators
|
---|
506 | ( ${} @{} %{} &{} *{} ).
|
---|
507 |
|
---|
508 |
|
---|
509 | If some operation cannot be resolved, and there is no function
|
---|
510 | assigned to C<"nomethod">, then an exception will be raised via die()--
|
---|
511 | unless C<"fallback"> was specified as a key in C<use overload> directive.
|
---|
512 |
|
---|
513 |
|
---|
514 | =head2 Fallback
|
---|
515 |
|
---|
516 | The key C<"fallback"> governs what to do if a method for a particular
|
---|
517 | operation is not found. Three different cases are possible depending on
|
---|
518 | the value of C<"fallback">:
|
---|
519 |
|
---|
520 | =over 16
|
---|
521 |
|
---|
522 | =item * C<undef>
|
---|
523 |
|
---|
524 | Perl tries to use a
|
---|
525 | substituted method (see L<MAGIC AUTOGENERATION>). If this fails, it
|
---|
526 | then tries to calls C<"nomethod"> value; if missing, an exception
|
---|
527 | will be raised.
|
---|
528 |
|
---|
529 | =item * TRUE
|
---|
530 |
|
---|
531 | The same as for the C<undef> value, but no exception is raised. Instead,
|
---|
532 | it silently reverts to what it would have done were there no C<use overload>
|
---|
533 | present.
|
---|
534 |
|
---|
535 | =item * defined, but FALSE
|
---|
536 |
|
---|
537 | No autogeneration is tried. Perl tries to call
|
---|
538 | C<"nomethod"> value, and if this is missing, raises an exception.
|
---|
539 |
|
---|
540 | =back
|
---|
541 |
|
---|
542 | B<Note.> C<"fallback"> inheritance via @ISA is not carved in stone
|
---|
543 | yet, see L<"Inheritance and overloading">.
|
---|
544 |
|
---|
545 | =head2 Copy Constructor
|
---|
546 |
|
---|
547 | The value for C<"="> is a reference to a function with three
|
---|
548 | arguments, i.e., it looks like the other values in C<use
|
---|
549 | overload>. However, it does not overload the Perl assignment
|
---|
550 | operator. This would go against Camel hair.
|
---|
551 |
|
---|
552 | This operation is called in the situations when a mutator is applied
|
---|
553 | to a reference that shares its object with some other reference, such
|
---|
554 | as
|
---|
555 |
|
---|
556 | $a=$b;
|
---|
557 | ++$a;
|
---|
558 |
|
---|
559 | To make this change $a and not change $b, a copy of C<$$a> is made,
|
---|
560 | and $a is assigned a reference to this new object. This operation is
|
---|
561 | done during execution of the C<++$a>, and not during the assignment,
|
---|
562 | (so before the increment C<$$a> coincides with C<$$b>). This is only
|
---|
563 | done if C<++> is expressed via a method for C<'++'> or C<'+='> (or
|
---|
564 | C<nomethod>). Note that if this operation is expressed via C<'+'>
|
---|
565 | a nonmutator, i.e., as in
|
---|
566 |
|
---|
567 | $a=$b;
|
---|
568 | $a=$a+1;
|
---|
569 |
|
---|
570 | then C<$a> does not reference a new copy of C<$$a>, since $$a does not
|
---|
571 | appear as lvalue when the above code is executed.
|
---|
572 |
|
---|
573 | If the copy constructor is required during the execution of some mutator,
|
---|
574 | but a method for C<'='> was not specified, it can be autogenerated as a
|
---|
575 | string copy if the object is a plain scalar.
|
---|
576 |
|
---|
577 | =over 5
|
---|
578 |
|
---|
579 | =item B<Example>
|
---|
580 |
|
---|
581 | The actually executed code for
|
---|
582 |
|
---|
583 | $a=$b;
|
---|
584 | Something else which does not modify $a or $b....
|
---|
585 | ++$a;
|
---|
586 |
|
---|
587 | may be
|
---|
588 |
|
---|
589 | $a=$b;
|
---|
590 | Something else which does not modify $a or $b....
|
---|
591 | $a = $a->clone(undef,"");
|
---|
592 | $a->incr(undef,"");
|
---|
593 |
|
---|
594 | if $b was mathemagical, and C<'++'> was overloaded with C<\&incr>,
|
---|
595 | C<'='> was overloaded with C<\&clone>.
|
---|
596 |
|
---|
597 | =back
|
---|
598 |
|
---|
599 | Same behaviour is triggered by C<$b = $a++>, which is consider a synonym for
|
---|
600 | C<$b = $a; ++$a>.
|
---|
601 |
|
---|
602 | =head1 MAGIC AUTOGENERATION
|
---|
603 |
|
---|
604 | If a method for an operation is not found, and the value for C<"fallback"> is
|
---|
605 | TRUE or undefined, Perl tries to autogenerate a substitute method for
|
---|
606 | the missing operation based on the defined operations. Autogenerated method
|
---|
607 | substitutions are possible for the following operations:
|
---|
608 |
|
---|
609 | =over 16
|
---|
610 |
|
---|
611 | =item I<Assignment forms of arithmetic operations>
|
---|
612 |
|
---|
613 | C<$a+=$b> can use the method for C<"+"> if the method for C<"+=">
|
---|
614 | is not defined.
|
---|
615 |
|
---|
616 | =item I<Conversion operations>
|
---|
617 |
|
---|
618 | String, numeric, and boolean conversion are calculated in terms of one
|
---|
619 | another if not all of them are defined.
|
---|
620 |
|
---|
621 | =item I<Increment and decrement>
|
---|
622 |
|
---|
623 | The C<++$a> operation can be expressed in terms of C<$a+=1> or C<$a+1>,
|
---|
624 | and C<$a--> in terms of C<$a-=1> and C<$a-1>.
|
---|
625 |
|
---|
626 | =item C<abs($a)>
|
---|
627 |
|
---|
628 | can be expressed in terms of C<$aE<lt>0> and C<-$a> (or C<0-$a>).
|
---|
629 |
|
---|
630 | =item I<Unary minus>
|
---|
631 |
|
---|
632 | can be expressed in terms of subtraction.
|
---|
633 |
|
---|
634 | =item I<Negation>
|
---|
635 |
|
---|
636 | C<!> and C<not> can be expressed in terms of boolean conversion, or
|
---|
637 | string or numerical conversion.
|
---|
638 |
|
---|
639 | =item I<Concatenation>
|
---|
640 |
|
---|
641 | can be expressed in terms of string conversion.
|
---|
642 |
|
---|
643 | =item I<Comparison operations>
|
---|
644 |
|
---|
645 | can be expressed in terms of its "spaceship" counterpart: either
|
---|
646 | C<E<lt>=E<gt>> or C<cmp>:
|
---|
647 |
|
---|
648 | <, >, <=, >=, ==, != in terms of <=>
|
---|
649 | lt, gt, le, ge, eq, ne in terms of cmp
|
---|
650 |
|
---|
651 | =item I<Iterator>
|
---|
652 |
|
---|
653 | <> in terms of builtin operations
|
---|
654 |
|
---|
655 | =item I<Dereferencing>
|
---|
656 |
|
---|
657 | ${} @{} %{} &{} *{} in terms of builtin operations
|
---|
658 |
|
---|
659 | =item I<Copy operator>
|
---|
660 |
|
---|
661 | can be expressed in terms of an assignment to the dereferenced value, if this
|
---|
662 | value is a scalar and not a reference.
|
---|
663 |
|
---|
664 | =back
|
---|
665 |
|
---|
666 | =head1 Losing overloading
|
---|
667 |
|
---|
668 | The restriction for the comparison operation is that even if, for example,
|
---|
669 | `C<cmp>' should return a blessed reference, the autogenerated `C<lt>'
|
---|
670 | function will produce only a standard logical value based on the
|
---|
671 | numerical value of the result of `C<cmp>'. In particular, a working
|
---|
672 | numeric conversion is needed in this case (possibly expressed in terms of
|
---|
673 | other conversions).
|
---|
674 |
|
---|
675 | Similarly, C<.=> and C<x=> operators lose their mathemagical properties
|
---|
676 | if the string conversion substitution is applied.
|
---|
677 |
|
---|
678 | When you chop() a mathemagical object it is promoted to a string and its
|
---|
679 | mathemagical properties are lost. The same can happen with other
|
---|
680 | operations as well.
|
---|
681 |
|
---|
682 | =head1 Run-time Overloading
|
---|
683 |
|
---|
684 | Since all C<use> directives are executed at compile-time, the only way to
|
---|
685 | change overloading during run-time is to
|
---|
686 |
|
---|
687 | eval 'use overload "+" => \&addmethod';
|
---|
688 |
|
---|
689 | You can also use
|
---|
690 |
|
---|
691 | eval 'no overload "+", "--", "<="';
|
---|
692 |
|
---|
693 | though the use of these constructs during run-time is questionable.
|
---|
694 |
|
---|
695 | =head1 Public functions
|
---|
696 |
|
---|
697 | Package C<overload.pm> provides the following public functions:
|
---|
698 |
|
---|
699 | =over 5
|
---|
700 |
|
---|
701 | =item overload::StrVal(arg)
|
---|
702 |
|
---|
703 | Gives string value of C<arg> as in absence of stringify overloading. If you
|
---|
704 | are using this to get the address of a reference (useful for checking if two
|
---|
705 | references point to the same thing) then you may be better off using
|
---|
706 | C<Scalar::Util::refaddr()>, which is faster.
|
---|
707 |
|
---|
708 | =item overload::Overloaded(arg)
|
---|
709 |
|
---|
710 | Returns true if C<arg> is subject to overloading of some operations.
|
---|
711 |
|
---|
712 | =item overload::Method(obj,op)
|
---|
713 |
|
---|
714 | Returns C<undef> or a reference to the method that implements C<op>.
|
---|
715 |
|
---|
716 | =back
|
---|
717 |
|
---|
718 | =head1 Overloading constants
|
---|
719 |
|
---|
720 | For some applications, the Perl parser mangles constants too much.
|
---|
721 | It is possible to hook into this process via C<overload::constant()>
|
---|
722 | and C<overload::remove_constant()> functions.
|
---|
723 |
|
---|
724 | These functions take a hash as an argument. The recognized keys of this hash
|
---|
725 | are:
|
---|
726 |
|
---|
727 | =over 8
|
---|
728 |
|
---|
729 | =item integer
|
---|
730 |
|
---|
731 | to overload integer constants,
|
---|
732 |
|
---|
733 | =item float
|
---|
734 |
|
---|
735 | to overload floating point constants,
|
---|
736 |
|
---|
737 | =item binary
|
---|
738 |
|
---|
739 | to overload octal and hexadecimal constants,
|
---|
740 |
|
---|
741 | =item q
|
---|
742 |
|
---|
743 | to overload C<q>-quoted strings, constant pieces of C<qq>- and C<qx>-quoted
|
---|
744 | strings and here-documents,
|
---|
745 |
|
---|
746 | =item qr
|
---|
747 |
|
---|
748 | to overload constant pieces of regular expressions.
|
---|
749 |
|
---|
750 | =back
|
---|
751 |
|
---|
752 | The corresponding values are references to functions which take three arguments:
|
---|
753 | the first one is the I<initial> string form of the constant, the second one
|
---|
754 | is how Perl interprets this constant, the third one is how the constant is used.
|
---|
755 | Note that the initial string form does not
|
---|
756 | contain string delimiters, and has backslashes in backslash-delimiter
|
---|
757 | combinations stripped (thus the value of delimiter is not relevant for
|
---|
758 | processing of this string). The return value of this function is how this
|
---|
759 | constant is going to be interpreted by Perl. The third argument is undefined
|
---|
760 | unless for overloaded C<q>- and C<qr>- constants, it is C<q> in single-quote
|
---|
761 | context (comes from strings, regular expressions, and single-quote HERE
|
---|
762 | documents), it is C<tr> for arguments of C<tr>/C<y> operators,
|
---|
763 | it is C<s> for right-hand side of C<s>-operator, and it is C<qq> otherwise.
|
---|
764 |
|
---|
765 | Since an expression C<"ab$cd,,"> is just a shortcut for C<'ab' . $cd . ',,'>,
|
---|
766 | it is expected that overloaded constant strings are equipped with reasonable
|
---|
767 | overloaded catenation operator, otherwise absurd results will result.
|
---|
768 | Similarly, negative numbers are considered as negations of positive constants.
|
---|
769 |
|
---|
770 | Note that it is probably meaningless to call the functions overload::constant()
|
---|
771 | and overload::remove_constant() from anywhere but import() and unimport() methods.
|
---|
772 | From these methods they may be called as
|
---|
773 |
|
---|
774 | sub import {
|
---|
775 | shift;
|
---|
776 | return unless @_;
|
---|
777 | die "unknown import: @_" unless @_ == 1 and $_[0] eq ':constant';
|
---|
778 | overload::constant integer => sub {Math::BigInt->new(shift)};
|
---|
779 | }
|
---|
780 |
|
---|
781 | B<BUGS> Currently overloaded-ness of constants does not propagate
|
---|
782 | into C<eval '...'>.
|
---|
783 |
|
---|
784 | =head1 IMPLEMENTATION
|
---|
785 |
|
---|
786 | What follows is subject to change RSN.
|
---|
787 |
|
---|
788 | The table of methods for all operations is cached in magic for the
|
---|
789 | symbol table hash for the package. The cache is invalidated during
|
---|
790 | processing of C<use overload>, C<no overload>, new function
|
---|
791 | definitions, and changes in @ISA. However, this invalidation remains
|
---|
792 | unprocessed until the next C<bless>ing into the package. Hence if you
|
---|
793 | want to change overloading structure dynamically, you'll need an
|
---|
794 | additional (fake) C<bless>ing to update the table.
|
---|
795 |
|
---|
796 | (Every SVish thing has a magic queue, and magic is an entry in that
|
---|
797 | queue. This is how a single variable may participate in multiple
|
---|
798 | forms of magic simultaneously. For instance, environment variables
|
---|
799 | regularly have two forms at once: their %ENV magic and their taint
|
---|
800 | magic. However, the magic which implements overloading is applied to
|
---|
801 | the stashes, which are rarely used directly, thus should not slow down
|
---|
802 | Perl.)
|
---|
803 |
|
---|
804 | If an object belongs to a package using overload, it carries a special
|
---|
805 | flag. Thus the only speed penalty during arithmetic operations without
|
---|
806 | overloading is the checking of this flag.
|
---|
807 |
|
---|
808 | In fact, if C<use overload> is not present, there is almost no overhead
|
---|
809 | for overloadable operations, so most programs should not suffer
|
---|
810 | measurable performance penalties. A considerable effort was made to
|
---|
811 | minimize the overhead when overload is used in some package, but the
|
---|
812 | arguments in question do not belong to packages using overload. When
|
---|
813 | in doubt, test your speed with C<use overload> and without it. So far
|
---|
814 | there have been no reports of substantial speed degradation if Perl is
|
---|
815 | compiled with optimization turned on.
|
---|
816 |
|
---|
817 | There is no size penalty for data if overload is not used. The only
|
---|
818 | size penalty if overload is used in some package is that I<all> the
|
---|
819 | packages acquire a magic during the next C<bless>ing into the
|
---|
820 | package. This magic is three-words-long for packages without
|
---|
821 | overloading, and carries the cache table if the package is overloaded.
|
---|
822 |
|
---|
823 | Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is
|
---|
824 | carried out before any operation that can imply an assignment to the
|
---|
825 | object $a (or $b) refers to, like C<$a++>. You can override this
|
---|
826 | behavior by defining your own copy constructor (see L<"Copy Constructor">).
|
---|
827 |
|
---|
828 | It is expected that arguments to methods that are not explicitly supposed
|
---|
829 | to be changed are constant (but this is not enforced).
|
---|
830 |
|
---|
831 | =head1 Metaphor clash
|
---|
832 |
|
---|
833 | One may wonder why the semantic of overloaded C<=> is so counter intuitive.
|
---|
834 | If it I<looks> counter intuitive to you, you are subject to a metaphor
|
---|
835 | clash.
|
---|
836 |
|
---|
837 | Here is a Perl object metaphor:
|
---|
838 |
|
---|
839 | I< object is a reference to blessed data>
|
---|
840 |
|
---|
841 | and an arithmetic metaphor:
|
---|
842 |
|
---|
843 | I< object is a thing by itself>.
|
---|
844 |
|
---|
845 | The I<main> problem of overloading C<=> is the fact that these metaphors
|
---|
846 | imply different actions on the assignment C<$a = $b> if $a and $b are
|
---|
847 | objects. Perl-think implies that $a becomes a reference to whatever
|
---|
848 | $b was referencing. Arithmetic-think implies that the value of "object"
|
---|
849 | $a is changed to become the value of the object $b, preserving the fact
|
---|
850 | that $a and $b are separate entities.
|
---|
851 |
|
---|
852 | The difference is not relevant in the absence of mutators. After
|
---|
853 | a Perl-way assignment an operation which mutates the data referenced by $a
|
---|
854 | would change the data referenced by $b too. Effectively, after
|
---|
855 | C<$a = $b> values of $a and $b become I<indistinguishable>.
|
---|
856 |
|
---|
857 | On the other hand, anyone who has used algebraic notation knows the
|
---|
858 | expressive power of the arithmetic metaphor. Overloading works hard
|
---|
859 | to enable this metaphor while preserving the Perlian way as far as
|
---|
860 | possible. Since it is not possible to freely mix two contradicting
|
---|
861 | metaphors, overloading allows the arithmetic way to write things I<as
|
---|
862 | far as all the mutators are called via overloaded access only>. The
|
---|
863 | way it is done is described in L<Copy Constructor>.
|
---|
864 |
|
---|
865 | If some mutator methods are directly applied to the overloaded values,
|
---|
866 | one may need to I<explicitly unlink> other values which references the
|
---|
867 | same value:
|
---|
868 |
|
---|
869 | $a = new Data 23;
|
---|
870 | ...
|
---|
871 | $b = $a; # $b is "linked" to $a
|
---|
872 | ...
|
---|
873 | $a = $a->clone; # Unlink $b from $a
|
---|
874 | $a->increment_by(4);
|
---|
875 |
|
---|
876 | Note that overloaded access makes this transparent:
|
---|
877 |
|
---|
878 | $a = new Data 23;
|
---|
879 | $b = $a; # $b is "linked" to $a
|
---|
880 | $a += 4; # would unlink $b automagically
|
---|
881 |
|
---|
882 | However, it would not make
|
---|
883 |
|
---|
884 | $a = new Data 23;
|
---|
885 | $a = 4; # Now $a is a plain 4, not 'Data'
|
---|
886 |
|
---|
887 | preserve "objectness" of $a. But Perl I<has> a way to make assignments
|
---|
888 | to an object do whatever you want. It is just not the overload, but
|
---|
889 | tie()ing interface (see L<perlfunc/tie>). Adding a FETCH() method
|
---|
890 | which returns the object itself, and STORE() method which changes the
|
---|
891 | value of the object, one can reproduce the arithmetic metaphor in its
|
---|
892 | completeness, at least for variables which were tie()d from the start.
|
---|
893 |
|
---|
894 | (Note that a workaround for a bug may be needed, see L<"BUGS">.)
|
---|
895 |
|
---|
896 | =head1 Cookbook
|
---|
897 |
|
---|
898 | Please add examples to what follows!
|
---|
899 |
|
---|
900 | =head2 Two-face scalars
|
---|
901 |
|
---|
902 | Put this in F<two_face.pm> in your Perl library directory:
|
---|
903 |
|
---|
904 | package two_face; # Scalars with separate string and
|
---|
905 | # numeric values.
|
---|
906 | sub new { my $p = shift; bless [@_], $p }
|
---|
907 | use overload '""' => \&str, '0+' => \&num, fallback => 1;
|
---|
908 | sub num {shift->[1]}
|
---|
909 | sub str {shift->[0]}
|
---|
910 |
|
---|
911 | Use it as follows:
|
---|
912 |
|
---|
913 | require two_face;
|
---|
914 | my $seven = new two_face ("vii", 7);
|
---|
915 | printf "seven=$seven, seven=%d, eight=%d\n", $seven, $seven+1;
|
---|
916 | print "seven contains `i'\n" if $seven =~ /i/;
|
---|
917 |
|
---|
918 | (The second line creates a scalar which has both a string value, and a
|
---|
919 | numeric value.) This prints:
|
---|
920 |
|
---|
921 | seven=vii, seven=7, eight=8
|
---|
922 | seven contains `i'
|
---|
923 |
|
---|
924 | =head2 Two-face references
|
---|
925 |
|
---|
926 | Suppose you want to create an object which is accessible as both an
|
---|
927 | array reference and a hash reference, similar to the
|
---|
928 | L<pseudo-hash|perlref/"Pseudo-hashes: Using an array as a hash">
|
---|
929 | builtin Perl type. Let's make it better than a pseudo-hash by
|
---|
930 | allowing index 0 to be treated as a normal element.
|
---|
931 |
|
---|
932 | package two_refs;
|
---|
933 | use overload '%{}' => \&gethash, '@{}' => sub { $ {shift()} };
|
---|
934 | sub new {
|
---|
935 | my $p = shift;
|
---|
936 | bless \ [@_], $p;
|
---|
937 | }
|
---|
938 | sub gethash {
|
---|
939 | my %h;
|
---|
940 | my $self = shift;
|
---|
941 | tie %h, ref $self, $self;
|
---|
942 | \%h;
|
---|
943 | }
|
---|
944 |
|
---|
945 | sub TIEHASH { my $p = shift; bless \ shift, $p }
|
---|
946 | my %fields;
|
---|
947 | my $i = 0;
|
---|
948 | $fields{$_} = $i++ foreach qw{zero one two three};
|
---|
949 | sub STORE {
|
---|
950 | my $self = ${shift()};
|
---|
951 | my $key = $fields{shift()};
|
---|
952 | defined $key or die "Out of band access";
|
---|
953 | $$self->[$key] = shift;
|
---|
954 | }
|
---|
955 | sub FETCH {
|
---|
956 | my $self = ${shift()};
|
---|
957 | my $key = $fields{shift()};
|
---|
958 | defined $key or die "Out of band access";
|
---|
959 | $$self->[$key];
|
---|
960 | }
|
---|
961 |
|
---|
962 | Now one can access an object using both the array and hash syntax:
|
---|
963 |
|
---|
964 | my $bar = new two_refs 3,4,5,6;
|
---|
965 | $bar->[2] = 11;
|
---|
966 | $bar->{two} == 11 or die 'bad hash fetch';
|
---|
967 |
|
---|
968 | Note several important features of this example. First of all, the
|
---|
969 | I<actual> type of $bar is a scalar reference, and we do not overload
|
---|
970 | the scalar dereference. Thus we can get the I<actual> non-overloaded
|
---|
971 | contents of $bar by just using C<$$bar> (what we do in functions which
|
---|
972 | overload dereference). Similarly, the object returned by the
|
---|
973 | TIEHASH() method is a scalar reference.
|
---|
974 |
|
---|
975 | Second, we create a new tied hash each time the hash syntax is used.
|
---|
976 | This allows us not to worry about a possibility of a reference loop,
|
---|
977 | which would lead to a memory leak.
|
---|
978 |
|
---|
979 | Both these problems can be cured. Say, if we want to overload hash
|
---|
980 | dereference on a reference to an object which is I<implemented> as a
|
---|
981 | hash itself, the only problem one has to circumvent is how to access
|
---|
982 | this I<actual> hash (as opposed to the I<virtual> hash exhibited by the
|
---|
983 | overloaded dereference operator). Here is one possible fetching routine:
|
---|
984 |
|
---|
985 | sub access_hash {
|
---|
986 | my ($self, $key) = (shift, shift);
|
---|
987 | my $class = ref $self;
|
---|
988 | bless $self, 'overload::dummy'; # Disable overloading of %{}
|
---|
989 | my $out = $self->{$key};
|
---|
990 | bless $self, $class; # Restore overloading
|
---|
991 | $out;
|
---|
992 | }
|
---|
993 |
|
---|
994 | To remove creation of the tied hash on each access, one may an extra
|
---|
995 | level of indirection which allows a non-circular structure of references:
|
---|
996 |
|
---|
997 | package two_refs1;
|
---|
998 | use overload '%{}' => sub { ${shift()}->[1] },
|
---|
999 | '@{}' => sub { ${shift()}->[0] };
|
---|
1000 | sub new {
|
---|
1001 | my $p = shift;
|
---|
1002 | my $a = [@_];
|
---|
1003 | my %h;
|
---|
1004 | tie %h, $p, $a;
|
---|
1005 | bless \ [$a, \%h], $p;
|
---|
1006 | }
|
---|
1007 | sub gethash {
|
---|
1008 | my %h;
|
---|
1009 | my $self = shift;
|
---|
1010 | tie %h, ref $self, $self;
|
---|
1011 | \%h;
|
---|
1012 | }
|
---|
1013 |
|
---|
1014 | sub TIEHASH { my $p = shift; bless \ shift, $p }
|
---|
1015 | my %fields;
|
---|
1016 | my $i = 0;
|
---|
1017 | $fields{$_} = $i++ foreach qw{zero one two three};
|
---|
1018 | sub STORE {
|
---|
1019 | my $a = ${shift()};
|
---|
1020 | my $key = $fields{shift()};
|
---|
1021 | defined $key or die "Out of band access";
|
---|
1022 | $a->[$key] = shift;
|
---|
1023 | }
|
---|
1024 | sub FETCH {
|
---|
1025 | my $a = ${shift()};
|
---|
1026 | my $key = $fields{shift()};
|
---|
1027 | defined $key or die "Out of band access";
|
---|
1028 | $a->[$key];
|
---|
1029 | }
|
---|
1030 |
|
---|
1031 | Now if $baz is overloaded like this, then C<$baz> is a reference to a
|
---|
1032 | reference to the intermediate array, which keeps a reference to an
|
---|
1033 | actual array, and the access hash. The tie()ing object for the access
|
---|
1034 | hash is a reference to a reference to the actual array, so
|
---|
1035 |
|
---|
1036 | =over
|
---|
1037 |
|
---|
1038 | =item *
|
---|
1039 |
|
---|
1040 | There are no loops of references.
|
---|
1041 |
|
---|
1042 | =item *
|
---|
1043 |
|
---|
1044 | Both "objects" which are blessed into the class C<two_refs1> are
|
---|
1045 | references to a reference to an array, thus references to a I<scalar>.
|
---|
1046 | Thus the accessor expression C<$$foo-E<gt>[$ind]> involves no
|
---|
1047 | overloaded operations.
|
---|
1048 |
|
---|
1049 | =back
|
---|
1050 |
|
---|
1051 | =head2 Symbolic calculator
|
---|
1052 |
|
---|
1053 | Put this in F<symbolic.pm> in your Perl library directory:
|
---|
1054 |
|
---|
1055 | package symbolic; # Primitive symbolic calculator
|
---|
1056 | use overload nomethod => \&wrap;
|
---|
1057 |
|
---|
1058 | sub new { shift; bless ['n', @_] }
|
---|
1059 | sub wrap {
|
---|
1060 | my ($obj, $other, $inv, $meth) = @_;
|
---|
1061 | ($obj, $other) = ($other, $obj) if $inv;
|
---|
1062 | bless [$meth, $obj, $other];
|
---|
1063 | }
|
---|
1064 |
|
---|
1065 | This module is very unusual as overloaded modules go: it does not
|
---|
1066 | provide any usual overloaded operators, instead it provides the L<Last
|
---|
1067 | Resort> operator C<nomethod>. In this example the corresponding
|
---|
1068 | subroutine returns an object which encapsulates operations done over
|
---|
1069 | the objects: C<new symbolic 3> contains C<['n', 3]>, C<2 + new
|
---|
1070 | symbolic 3> contains C<['+', 2, ['n', 3]]>.
|
---|
1071 |
|
---|
1072 | Here is an example of the script which "calculates" the side of
|
---|
1073 | circumscribed octagon using the above package:
|
---|
1074 |
|
---|
1075 | require symbolic;
|
---|
1076 | my $iter = 1; # 2**($iter+2) = 8
|
---|
1077 | my $side = new symbolic 1;
|
---|
1078 | my $cnt = $iter;
|
---|
1079 |
|
---|
1080 | while ($cnt--) {
|
---|
1081 | $side = (sqrt(1 + $side**2) - 1)/$side;
|
---|
1082 | }
|
---|
1083 | print "OK\n";
|
---|
1084 |
|
---|
1085 | The value of $side is
|
---|
1086 |
|
---|
1087 | ['/', ['-', ['sqrt', ['+', 1, ['**', ['n', 1], 2]],
|
---|
1088 | undef], 1], ['n', 1]]
|
---|
1089 |
|
---|
1090 | Note that while we obtained this value using a nice little script,
|
---|
1091 | there is no simple way to I<use> this value. In fact this value may
|
---|
1092 | be inspected in debugger (see L<perldebug>), but ony if
|
---|
1093 | C<bareStringify> B<O>ption is set, and not via C<p> command.
|
---|
1094 |
|
---|
1095 | If one attempts to print this value, then the overloaded operator
|
---|
1096 | C<""> will be called, which will call C<nomethod> operator. The
|
---|
1097 | result of this operator will be stringified again, but this result is
|
---|
1098 | again of type C<symbolic>, which will lead to an infinite loop.
|
---|
1099 |
|
---|
1100 | Add a pretty-printer method to the module F<symbolic.pm>:
|
---|
1101 |
|
---|
1102 | sub pretty {
|
---|
1103 | my ($meth, $a, $b) = @{+shift};
|
---|
1104 | $a = 'u' unless defined $a;
|
---|
1105 | $b = 'u' unless defined $b;
|
---|
1106 | $a = $a->pretty if ref $a;
|
---|
1107 | $b = $b->pretty if ref $b;
|
---|
1108 | "[$meth $a $b]";
|
---|
1109 | }
|
---|
1110 |
|
---|
1111 | Now one can finish the script by
|
---|
1112 |
|
---|
1113 | print "side = ", $side->pretty, "\n";
|
---|
1114 |
|
---|
1115 | The method C<pretty> is doing object-to-string conversion, so it
|
---|
1116 | is natural to overload the operator C<""> using this method. However,
|
---|
1117 | inside such a method it is not necessary to pretty-print the
|
---|
1118 | I<components> $a and $b of an object. In the above subroutine
|
---|
1119 | C<"[$meth $a $b]"> is a catenation of some strings and components $a
|
---|
1120 | and $b. If these components use overloading, the catenation operator
|
---|
1121 | will look for an overloaded operator C<.>; if not present, it will
|
---|
1122 | look for an overloaded operator C<"">. Thus it is enough to use
|
---|
1123 |
|
---|
1124 | use overload nomethod => \&wrap, '""' => \&str;
|
---|
1125 | sub str {
|
---|
1126 | my ($meth, $a, $b) = @{+shift};
|
---|
1127 | $a = 'u' unless defined $a;
|
---|
1128 | $b = 'u' unless defined $b;
|
---|
1129 | "[$meth $a $b]";
|
---|
1130 | }
|
---|
1131 |
|
---|
1132 | Now one can change the last line of the script to
|
---|
1133 |
|
---|
1134 | print "side = $side\n";
|
---|
1135 |
|
---|
1136 | which outputs
|
---|
1137 |
|
---|
1138 | side = [/ [- [sqrt [+ 1 [** [n 1 u] 2]] u] 1] [n 1 u]]
|
---|
1139 |
|
---|
1140 | and one can inspect the value in debugger using all the possible
|
---|
1141 | methods.
|
---|
1142 |
|
---|
1143 | Something is still amiss: consider the loop variable $cnt of the
|
---|
1144 | script. It was a number, not an object. We cannot make this value of
|
---|
1145 | type C<symbolic>, since then the loop will not terminate.
|
---|
1146 |
|
---|
1147 | Indeed, to terminate the cycle, the $cnt should become false.
|
---|
1148 | However, the operator C<bool> for checking falsity is overloaded (this
|
---|
1149 | time via overloaded C<"">), and returns a long string, thus any object
|
---|
1150 | of type C<symbolic> is true. To overcome this, we need a way to
|
---|
1151 | compare an object to 0. In fact, it is easier to write a numeric
|
---|
1152 | conversion routine.
|
---|
1153 |
|
---|
1154 | Here is the text of F<symbolic.pm> with such a routine added (and
|
---|
1155 | slightly modified str()):
|
---|
1156 |
|
---|
1157 | package symbolic; # Primitive symbolic calculator
|
---|
1158 | use overload
|
---|
1159 | nomethod => \&wrap, '""' => \&str, '0+' => \#
|
---|
1160 |
|
---|
1161 | sub new { shift; bless ['n', @_] }
|
---|
1162 | sub wrap {
|
---|
1163 | my ($obj, $other, $inv, $meth) = @_;
|
---|
1164 | ($obj, $other) = ($other, $obj) if $inv;
|
---|
1165 | bless [$meth, $obj, $other];
|
---|
1166 | }
|
---|
1167 | sub str {
|
---|
1168 | my ($meth, $a, $b) = @{+shift};
|
---|
1169 | $a = 'u' unless defined $a;
|
---|
1170 | if (defined $b) {
|
---|
1171 | "[$meth $a $b]";
|
---|
1172 | } else {
|
---|
1173 | "[$meth $a]";
|
---|
1174 | }
|
---|
1175 | }
|
---|
1176 | my %subr = ( n => sub {$_[0]},
|
---|
1177 | sqrt => sub {sqrt $_[0]},
|
---|
1178 | '-' => sub {shift() - shift()},
|
---|
1179 | '+' => sub {shift() + shift()},
|
---|
1180 | '/' => sub {shift() / shift()},
|
---|
1181 | '*' => sub {shift() * shift()},
|
---|
1182 | '**' => sub {shift() ** shift()},
|
---|
1183 | );
|
---|
1184 | sub num {
|
---|
1185 | my ($meth, $a, $b) = @{+shift};
|
---|
1186 | my $subr = $subr{$meth}
|
---|
1187 | or die "Do not know how to ($meth) in symbolic";
|
---|
1188 | $a = $a->num if ref $a eq __PACKAGE__;
|
---|
1189 | $b = $b->num if ref $b eq __PACKAGE__;
|
---|
1190 | $subr->($a,$b);
|
---|
1191 | }
|
---|
1192 |
|
---|
1193 | All the work of numeric conversion is done in %subr and num(). Of
|
---|
1194 | course, %subr is not complete, it contains only operators used in the
|
---|
1195 | example below. Here is the extra-credit question: why do we need an
|
---|
1196 | explicit recursion in num()? (Answer is at the end of this section.)
|
---|
1197 |
|
---|
1198 | Use this module like this:
|
---|
1199 |
|
---|
1200 | require symbolic;
|
---|
1201 | my $iter = new symbolic 2; # 16-gon
|
---|
1202 | my $side = new symbolic 1;
|
---|
1203 | my $cnt = $iter;
|
---|
1204 |
|
---|
1205 | while ($cnt) {
|
---|
1206 | $cnt = $cnt - 1; # Mutator `--' not implemented
|
---|
1207 | $side = (sqrt(1 + $side**2) - 1)/$side;
|
---|
1208 | }
|
---|
1209 | printf "%s=%f\n", $side, $side;
|
---|
1210 | printf "pi=%f\n", $side*(2**($iter+2));
|
---|
1211 |
|
---|
1212 | It prints (without so many line breaks)
|
---|
1213 |
|
---|
1214 | [/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1]
|
---|
1215 | [n 1]] 2]]] 1]
|
---|
1216 | [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]=0.198912
|
---|
1217 | pi=3.182598
|
---|
1218 |
|
---|
1219 | The above module is very primitive. It does not implement
|
---|
1220 | mutator methods (C<++>, C<-=> and so on), does not do deep copying
|
---|
1221 | (not required without mutators!), and implements only those arithmetic
|
---|
1222 | operations which are used in the example.
|
---|
1223 |
|
---|
1224 | To implement most arithmetic operations is easy; one should just use
|
---|
1225 | the tables of operations, and change the code which fills %subr to
|
---|
1226 |
|
---|
1227 | my %subr = ( 'n' => sub {$_[0]} );
|
---|
1228 | foreach my $op (split " ", $overload::ops{with_assign}) {
|
---|
1229 | $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
|
---|
1230 | }
|
---|
1231 | my @bins = qw(binary 3way_comparison num_comparison str_comparison);
|
---|
1232 | foreach my $op (split " ", "@overload::ops{ @bins }") {
|
---|
1233 | $subr{$op} = eval "sub {shift() $op shift()}";
|
---|
1234 | }
|
---|
1235 | foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
|
---|
1236 | print "defining `$op'\n";
|
---|
1237 | $subr{$op} = eval "sub {$op shift()}";
|
---|
1238 | }
|
---|
1239 |
|
---|
1240 | Due to L<Calling Conventions for Mutators>, we do not need anything
|
---|
1241 | special to make C<+=> and friends work, except filling C<+=> entry of
|
---|
1242 | %subr, and defining a copy constructor (needed since Perl has no
|
---|
1243 | way to know that the implementation of C<'+='> does not mutate
|
---|
1244 | the argument, compare L<Copy Constructor>).
|
---|
1245 |
|
---|
1246 | To implement a copy constructor, add C<< '=' => \&cpy >> to C<use overload>
|
---|
1247 | line, and code (this code assumes that mutators change things one level
|
---|
1248 | deep only, so recursive copying is not needed):
|
---|
1249 |
|
---|
1250 | sub cpy {
|
---|
1251 | my $self = shift;
|
---|
1252 | bless [@$self], ref $self;
|
---|
1253 | }
|
---|
1254 |
|
---|
1255 | To make C<++> and C<--> work, we need to implement actual mutators,
|
---|
1256 | either directly, or in C<nomethod>. We continue to do things inside
|
---|
1257 | C<nomethod>, thus add
|
---|
1258 |
|
---|
1259 | if ($meth eq '++' or $meth eq '--') {
|
---|
1260 | @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
|
---|
1261 | return $obj;
|
---|
1262 | }
|
---|
1263 |
|
---|
1264 | after the first line of wrap(). This is not a most effective
|
---|
1265 | implementation, one may consider
|
---|
1266 |
|
---|
1267 | sub inc { $_[0] = bless ['++', shift, 1]; }
|
---|
1268 |
|
---|
1269 | instead.
|
---|
1270 |
|
---|
1271 | As a final remark, note that one can fill %subr by
|
---|
1272 |
|
---|
1273 | my %subr = ( 'n' => sub {$_[0]} );
|
---|
1274 | foreach my $op (split " ", $overload::ops{with_assign}) {
|
---|
1275 | $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
|
---|
1276 | }
|
---|
1277 | my @bins = qw(binary 3way_comparison num_comparison str_comparison);
|
---|
1278 | foreach my $op (split " ", "@overload::ops{ @bins }") {
|
---|
1279 | $subr{$op} = eval "sub {shift() $op shift()}";
|
---|
1280 | }
|
---|
1281 | foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
|
---|
1282 | $subr{$op} = eval "sub {$op shift()}";
|
---|
1283 | }
|
---|
1284 | $subr{'++'} = $subr{'+'};
|
---|
1285 | $subr{'--'} = $subr{'-'};
|
---|
1286 |
|
---|
1287 | This finishes implementation of a primitive symbolic calculator in
|
---|
1288 | 50 lines of Perl code. Since the numeric values of subexpressions
|
---|
1289 | are not cached, the calculator is very slow.
|
---|
1290 |
|
---|
1291 | Here is the answer for the exercise: In the case of str(), we need no
|
---|
1292 | explicit recursion since the overloaded C<.>-operator will fall back
|
---|
1293 | to an existing overloaded operator C<"">. Overloaded arithmetic
|
---|
1294 | operators I<do not> fall back to numeric conversion if C<fallback> is
|
---|
1295 | not explicitly requested. Thus without an explicit recursion num()
|
---|
1296 | would convert C<['+', $a, $b]> to C<$a + $b>, which would just rebuild
|
---|
1297 | the argument of num().
|
---|
1298 |
|
---|
1299 | If you wonder why defaults for conversion are different for str() and
|
---|
1300 | num(), note how easy it was to write the symbolic calculator. This
|
---|
1301 | simplicity is due to an appropriate choice of defaults. One extra
|
---|
1302 | note: due to the explicit recursion num() is more fragile than sym():
|
---|
1303 | we need to explicitly check for the type of $a and $b. If components
|
---|
1304 | $a and $b happen to be of some related type, this may lead to problems.
|
---|
1305 |
|
---|
1306 | =head2 I<Really> symbolic calculator
|
---|
1307 |
|
---|
1308 | One may wonder why we call the above calculator symbolic. The reason
|
---|
1309 | is that the actual calculation of the value of expression is postponed
|
---|
1310 | until the value is I<used>.
|
---|
1311 |
|
---|
1312 | To see it in action, add a method
|
---|
1313 |
|
---|
1314 | sub STORE {
|
---|
1315 | my $obj = shift;
|
---|
1316 | $#$obj = 1;
|
---|
1317 | @$obj->[0,1] = ('=', shift);
|
---|
1318 | }
|
---|
1319 |
|
---|
1320 | to the package C<symbolic>. After this change one can do
|
---|
1321 |
|
---|
1322 | my $a = new symbolic 3;
|
---|
1323 | my $b = new symbolic 4;
|
---|
1324 | my $c = sqrt($a**2 + $b**2);
|
---|
1325 |
|
---|
1326 | and the numeric value of $c becomes 5. However, after calling
|
---|
1327 |
|
---|
1328 | $a->STORE(12); $b->STORE(5);
|
---|
1329 |
|
---|
1330 | the numeric value of $c becomes 13. There is no doubt now that the module
|
---|
1331 | symbolic provides a I<symbolic> calculator indeed.
|
---|
1332 |
|
---|
1333 | To hide the rough edges under the hood, provide a tie()d interface to the
|
---|
1334 | package C<symbolic> (compare with L<Metaphor clash>). Add methods
|
---|
1335 |
|
---|
1336 | sub TIESCALAR { my $pack = shift; $pack->new(@_) }
|
---|
1337 | sub FETCH { shift }
|
---|
1338 | sub nop { } # Around a bug
|
---|
1339 |
|
---|
1340 | (the bug is described in L<"BUGS">). One can use this new interface as
|
---|
1341 |
|
---|
1342 | tie $a, 'symbolic', 3;
|
---|
1343 | tie $b, 'symbolic', 4;
|
---|
1344 | $a->nop; $b->nop; # Around a bug
|
---|
1345 |
|
---|
1346 | my $c = sqrt($a**2 + $b**2);
|
---|
1347 |
|
---|
1348 | Now numeric value of $c is 5. After C<$a = 12; $b = 5> the numeric value
|
---|
1349 | of $c becomes 13. To insulate the user of the module add a method
|
---|
1350 |
|
---|
1351 | sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
|
---|
1352 |
|
---|
1353 | Now
|
---|
1354 |
|
---|
1355 | my ($a, $b);
|
---|
1356 | symbolic->vars($a, $b);
|
---|
1357 | my $c = sqrt($a**2 + $b**2);
|
---|
1358 |
|
---|
1359 | $a = 3; $b = 4;
|
---|
1360 | printf "c5 %s=%f\n", $c, $c;
|
---|
1361 |
|
---|
1362 | $a = 12; $b = 5;
|
---|
1363 | printf "c13 %s=%f\n", $c, $c;
|
---|
1364 |
|
---|
1365 | shows that the numeric value of $c follows changes to the values of $a
|
---|
1366 | and $b.
|
---|
1367 |
|
---|
1368 | =head1 AUTHOR
|
---|
1369 |
|
---|
1370 | Ilya Zakharevich E<lt>F<[email protected]>E<gt>.
|
---|
1371 |
|
---|
1372 | =head1 DIAGNOSTICS
|
---|
1373 |
|
---|
1374 | When Perl is run with the B<-Do> switch or its equivalent, overloading
|
---|
1375 | induces diagnostic messages.
|
---|
1376 |
|
---|
1377 | Using the C<m> command of Perl debugger (see L<perldebug>) one can
|
---|
1378 | deduce which operations are overloaded (and which ancestor triggers
|
---|
1379 | this overloading). Say, if C<eq> is overloaded, then the method C<(eq>
|
---|
1380 | is shown by debugger. The method C<()> corresponds to the C<fallback>
|
---|
1381 | key (in fact a presence of this method shows that this package has
|
---|
1382 | overloading enabled, and it is what is used by the C<Overloaded>
|
---|
1383 | function of module C<overload>).
|
---|
1384 |
|
---|
1385 | The module might issue the following warnings:
|
---|
1386 |
|
---|
1387 | =over 4
|
---|
1388 |
|
---|
1389 | =item Odd number of arguments for overload::constant
|
---|
1390 |
|
---|
1391 | (W) The call to overload::constant contained an odd number of arguments.
|
---|
1392 | The arguments should come in pairs.
|
---|
1393 |
|
---|
1394 | =item `%s' is not an overloadable type
|
---|
1395 |
|
---|
1396 | (W) You tried to overload a constant type the overload package is unaware of.
|
---|
1397 |
|
---|
1398 | =item `%s' is not a code reference
|
---|
1399 |
|
---|
1400 | (W) The second (fourth, sixth, ...) argument of overload::constant needs
|
---|
1401 | to be a code reference. Either an anonymous subroutine, or a reference
|
---|
1402 | to a subroutine.
|
---|
1403 |
|
---|
1404 | =back
|
---|
1405 |
|
---|
1406 | =head1 BUGS
|
---|
1407 |
|
---|
1408 | Because it is used for overloading, the per-package hash %OVERLOAD now
|
---|
1409 | has a special meaning in Perl. The symbol table is filled with names
|
---|
1410 | looking like line-noise.
|
---|
1411 |
|
---|
1412 | For the purpose of inheritance every overloaded package behaves as if
|
---|
1413 | C<fallback> is present (possibly undefined). This may create
|
---|
1414 | interesting effects if some package is not overloaded, but inherits
|
---|
1415 | from two overloaded packages.
|
---|
1416 |
|
---|
1417 | Relation between overloading and tie()ing is broken. Overloading is
|
---|
1418 | triggered or not basing on the I<previous> class of tie()d value.
|
---|
1419 |
|
---|
1420 | This happens because the presence of overloading is checked too early,
|
---|
1421 | before any tie()d access is attempted. If the FETCH()ed class of the
|
---|
1422 | tie()d value does not change, a simple workaround is to access the value
|
---|
1423 | immediately after tie()ing, so that after this call the I<previous> class
|
---|
1424 | coincides with the current one.
|
---|
1425 |
|
---|
1426 | B<Needed:> a way to fix this without a speed penalty.
|
---|
1427 |
|
---|
1428 | Barewords are not covered by overloaded string constants.
|
---|
1429 |
|
---|
1430 | This document is confusing. There are grammos and misleading language
|
---|
1431 | used in places. It would seem a total rewrite is needed.
|
---|
1432 |
|
---|
1433 | =cut
|
---|
1434 |
|
---|