1N/Apackage overload;
1N/A
1N/Aour $VERSION = '1.01';
1N/A
1N/A$overload::hint_bits = 0x20000; # HINT_LOCALIZE_HH
1N/A
1N/Asub nil {}
1N/A
1N/Asub OVERLOAD {
1N/A $package = shift;
1N/A my %arg = @_;
1N/A my ($sub, $fb);
1N/A $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
1N/A *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
1N/A for (keys %arg) {
1N/A if ($_ eq 'fallback') {
1N/A $fb = $arg{$_};
1N/A } else {
1N/A $sub = $arg{$_};
1N/A if (not ref $sub and $sub !~ /::/) {
1N/A $ {$package . "::(" . $_} = $sub;
1N/A $sub = \&nil;
1N/A }
1N/A #print STDERR "Setting `$ {'package'}::\cO$_' to \\&`$sub'.\n";
1N/A *{$package . "::(" . $_} = \&{ $sub };
1N/A }
1N/A }
1N/A ${$package . "::()"} = $fb; # Make it findable too (fallback only).
1N/A}
1N/A
1N/Asub import {
1N/A $package = (caller())[0];
1N/A # *{$package . "::OVERLOAD"} = \&OVERLOAD;
1N/A shift;
1N/A $package->overload::OVERLOAD(@_);
1N/A}
1N/A
1N/Asub unimport {
1N/A $package = (caller())[0];
1N/A ${$package . "::OVERLOAD"}{dummy}++; # Upgrade the table
1N/A shift;
1N/A for (@_) {
1N/A if ($_ eq 'fallback') {
1N/A undef $ {$package . "::()"};
1N/A } else {
1N/A delete $ {$package . "::"}{"(" . $_};
1N/A }
1N/A }
1N/A}
1N/A
1N/Asub Overloaded {
1N/A my $package = shift;
1N/A $package = ref $package if ref $package;
1N/A $package->can('()');
1N/A}
1N/A
1N/Asub ov_method {
1N/A my $globref = shift;
1N/A return undef unless $globref;
1N/A my $sub = \&{*$globref};
1N/A return $sub if $sub ne \&nil;
1N/A return shift->can($ {*$globref});
1N/A}
1N/A
1N/Asub OverloadedStringify {
1N/A my $package = shift;
1N/A $package = ref $package if ref $package;
1N/A #$package->can('(""')
1N/A ov_method mycan($package, '(""'), $package
1N/A or ov_method mycan($package, '(0+'), $package
1N/A or ov_method mycan($package, '(bool'), $package
1N/A or ov_method mycan($package, '(nomethod'), $package;
1N/A}
1N/A
1N/Asub Method {
1N/A my $package = shift;
1N/A $package = ref $package if ref $package;
1N/A #my $meth = $package->can('(' . shift);
1N/A ov_method mycan($package, '(' . shift), $package;
1N/A #return $meth if $meth ne \&nil;
1N/A #return $ {*{$meth}};
1N/A}
1N/A
1N/Asub AddrRef {
1N/A my $package = ref $_[0];
1N/A return "$_[0]" unless $package;
1N/A
1N/A require Scalar::Util;
1N/A my $class = Scalar::Util::blessed($_[0]);
1N/A my $class_prefix = defined($class) ? "$class=" : "";
1N/A my $type = Scalar::Util::reftype($_[0]);
1N/A my $addr = Scalar::Util::refaddr($_[0]);
1N/A return sprintf("$class_prefix$type(0x%x)", $addr);
1N/A}
1N/A
1N/Asub StrVal {
1N/A (ref $_[0] && OverloadedStringify($_[0]) or ref($_[0]) eq 'Regexp') ?
1N/A (AddrRef(shift)) :
1N/A "$_[0]";
1N/A}
1N/A
1N/Asub mycan { # Real can would leave stubs.
1N/A my ($package, $meth) = @_;
1N/A return \*{$package . "::$meth"} if defined &{$package . "::$meth"};
1N/A my $p;
1N/A foreach $p (@{$package . "::ISA"}) {
1N/A my $out = mycan($p, $meth);
1N/A return $out if $out;
1N/A }
1N/A return undef;
1N/A}
1N/A
1N/A%constants = (
1N/A 'integer' => 0x1000, # HINT_NEW_INTEGER
1N/A 'float' => 0x2000, # HINT_NEW_FLOAT
1N/A 'binary' => 0x4000, # HINT_NEW_BINARY
1N/A 'q' => 0x8000, # HINT_NEW_STRING
1N/A 'qr' => 0x10000, # HINT_NEW_RE
1N/A );
1N/A
1N/A%ops = ( with_assign => "+ - * / % ** << >> x .",
1N/A assign => "+= -= *= /= %= **= <<= >>= x= .=",
1N/A num_comparison => "< <= > >= == !=",
1N/A '3way_comparison'=> "<=> cmp",
1N/A str_comparison => "lt le gt ge eq ne",
1N/A binary => "& | ^",
1N/A unary => "neg ! ~",
1N/A mutators => '++ --',
1N/A func => "atan2 cos sin exp abs log sqrt int",
1N/A conversion => 'bool "" 0+',
1N/A iterators => '<>',
1N/A dereferencing => '${} @{} %{} &{} *{}',
1N/A special => 'nomethod fallback =');
1N/A
1N/Ause warnings::register;
1N/Asub constant {
1N/A # Arguments: what, sub
1N/A while (@_) {
1N/A if (@_ == 1) {
1N/A warnings::warnif ("Odd number of arguments for overload::constant");
1N/A last;
1N/A }
1N/A elsif (!exists $constants {$_ [0]}) {
1N/A warnings::warnif ("`$_[0]' is not an overloadable type");
1N/A }
1N/A elsif (!ref $_ [1] || "$_[1]" !~ /CODE\(0x[\da-f]+\)$/) {
1N/A # Can't use C<ref $_[1] eq "CODE"> above as code references can be
1N/A # blessed, and C<ref> would return the package the ref is blessed into.
1N/A if (warnings::enabled) {
1N/A $_ [1] = "undef" unless defined $_ [1];
1N/A warnings::warn ("`$_[1]' is not a code reference");
1N/A }
1N/A }
1N/A else {
1N/A $^H{$_[0]} = $_[1];
1N/A $^H |= $constants{$_[0]} | $overload::hint_bits;
1N/A }
1N/A shift, shift;
1N/A }
1N/A}
1N/A
1N/Asub remove_constant {
1N/A # Arguments: what, sub
1N/A while (@_) {
1N/A delete $^H{$_[0]};
1N/A $^H &= ~ $constants{$_[0]};
1N/A shift, shift;
1N/A }
1N/A}
1N/A
1N/A1;
1N/A
1N/A__END__
1N/A
1N/A=head1 NAME
1N/A
1N/Aoverload - Package for overloading perl operations
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A package SomeThing;
1N/A
1N/A use overload
1N/A '+' => \&myadd,
1N/A '-' => \&mysub;
1N/A # etc
1N/A ...
1N/A
1N/A package main;
1N/A $a = new SomeThing 57;
1N/A $b=5+$a;
1N/A ...
1N/A if (overload::Overloaded $b) {...}
1N/A ...
1N/A $strval = overload::StrVal $b;
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/A=head2 Declaration of overloaded functions
1N/A
1N/AThe compilation directive
1N/A
1N/A package Number;
1N/A use overload
1N/A "+" => \&add,
1N/A "*=" => "muas";
1N/A
1N/Adeclares function Number::add() for addition, and method muas() in
1N/Athe "class" C<Number> (or one of its base classes)
1N/Afor the assignment form C<*=> of multiplication.
1N/A
1N/AArguments of this directive come in (key, value) pairs. Legal values
1N/Aare values legal inside a C<&{ ... }> call, so the name of a
1N/Asubroutine, a reference to a subroutine, or an anonymous subroutine
1N/Awill all work. Note that values specified as strings are
1N/Ainterpreted as methods, not subroutines. Legal keys are listed below.
1N/A
1N/AThe subroutine C<add> will be called to execute C<$a+$b> if $a
1N/Ais a reference to an object blessed into the package C<Number>, or if $a is
1N/Anot an object from a package with defined mathemagic addition, but $b is a
1N/Areference to a C<Number>. It can also be called in other situations, like
1N/AC<$a+=7>, or C<$a++>. See L<MAGIC AUTOGENERATION>. (Mathemagical
1N/Amethods refer to methods triggered by an overloaded mathematical
1N/Aoperator.)
1N/A
1N/ASince overloading respects inheritance via the @ISA hierarchy, the
1N/Aabove declaration would also trigger overloading of C<+> and C<*=> in
1N/Aall the packages which inherit from C<Number>.
1N/A
1N/A=head2 Calling Conventions for Binary Operations
1N/A
1N/AThe functions specified in the C<use overload ...> directive are called
1N/Awith three (in one particular case with four, see L<Last Resort>)
1N/Aarguments. If the corresponding operation is binary, then the first
1N/Atwo arguments are the two arguments of the operation. However, due to
1N/Ageneral object calling conventions, the first argument should always be
1N/Aan object in the package, so in the situation of C<7+$a>, the
1N/Aorder of the arguments is interchanged. It probably does not matter
1N/Awhen implementing the addition method, but whether the arguments
1N/Aare reversed is vital to the subtraction method. The method can
1N/Aquery this information by examining the third argument, which can take
1N/Athree different values:
1N/A
1N/A=over 7
1N/A
1N/A=item FALSE
1N/A
1N/Athe order of arguments is as in the current operation.
1N/A
1N/A=item TRUE
1N/A
1N/Athe arguments are reversed.
1N/A
1N/A=item C<undef>
1N/A
1N/Athe current operation is an assignment variant (as in
1N/AC<$a+=7>), but the usual function is called instead. This additional
1N/Ainformation can be used to generate some optimizations. Compare
1N/AL<Calling Conventions for Mutators>.
1N/A
1N/A=back
1N/A
1N/A=head2 Calling Conventions for Unary Operations
1N/A
1N/AUnary operation are considered binary operations with the second
1N/Aargument being C<undef>. Thus the functions that overloads C<{"++"}>
1N/Ais called with arguments C<($a,undef,'')> when $a++ is executed.
1N/A
1N/A=head2 Calling Conventions for Mutators
1N/A
1N/ATwo types of mutators have different calling conventions:
1N/A
1N/A=over
1N/A
1N/A=item C<++> and C<-->
1N/A
1N/AThe routines which implement these operators are expected to actually
1N/AI<mutate> their arguments. So, assuming that $obj is a reference to a
1N/Anumber,
1N/A
1N/A sub incr { my $n = $ {$_[0]}; ++$n; $_[0] = bless \$n}
1N/A
1N/Ais an appropriate implementation of overloaded C<++>. Note that
1N/A
1N/A sub incr { ++$ {$_[0]} ; shift }
1N/A
1N/Ais OK if used with preincrement and with postincrement. (In the case
1N/Aof postincrement a copying will be performed, see L<Copy Constructor>.)
1N/A
1N/A=item C<x=> and other assignment versions
1N/A
1N/AThere is nothing special about these methods. They may change the
1N/Avalue of their arguments, and may leave it as is. The result is going
1N/Ato be assigned to the value in the left-hand-side if different from
1N/Athis value.
1N/A
1N/AThis allows for the same method to be used as overloaded C<+=> and
1N/AC<+>. Note that this is I<allowed>, but not recommended, since by the
1N/Asemantic of L<"Fallback"> Perl will call the method for C<+> anyway,
1N/Aif C<+=> is not overloaded.
1N/A
1N/A=back
1N/A
1N/AB<Warning.> Due to the presence of assignment versions of operations,
1N/Aroutines which may be called in assignment context may create
1N/Aself-referential structures. Currently Perl will not free self-referential
1N/Astructures until cycles are C<explicitly> broken. You may get problems
1N/Awhen traversing your structures too.
1N/A
1N/ASay,
1N/A
1N/A use overload '+' => sub { bless [ \$_[0], \$_[1] ] };
1N/A
1N/Ais asking for trouble, since for code C<$obj += $foo> the subroutine
1N/Ais called as C<$obj = add($obj, $foo, undef)>, or C<$obj = [\$obj,
1N/A\$foo]>. If using such a subroutine is an important optimization, one
1N/Acan overload C<+=> explicitly by a non-"optimized" version, or switch
1N/Ato non-optimized version if C<not defined $_[2]> (see
1N/AL<Calling Conventions for Binary Operations>).
1N/A
1N/AEven if no I<explicit> assignment-variants of operators are present in
1N/Athe script, they may be generated by the optimizer. Say, C<",$obj,"> or
1N/AC<',' . $obj . ','> may be both optimized to
1N/A
1N/A my $tmp = ',' . $obj; $tmp .= ',';
1N/A
1N/A=head2 Overloadable Operations
1N/A
1N/AThe following symbols can be specified in C<use overload> directive:
1N/A
1N/A=over 5
1N/A
1N/A=item * I<Arithmetic operations>
1N/A
1N/A "+", "+=", "-", "-=", "*", "*=", "/", "/=", "%", "%=",
1N/A "**", "**=", "<<", "<<=", ">>", ">>=", "x", "x=", ".", ".=",
1N/A
1N/AFor these operations a substituted non-assignment variant can be called if
1N/Athe assignment variant is not available. Methods for operations C<+>,
1N/AC<->, C<+=>, and C<-=> can be called to automatically generate
1N/Aincrement and decrement methods. The operation C<-> can be used to
1N/Aautogenerate missing methods for unary minus or C<abs>.
1N/A
1N/ASee L<"MAGIC AUTOGENERATION">, L<"Calling Conventions for Mutators"> and
1N/AL<"Calling Conventions for Binary Operations">) for details of these
1N/Asubstitutions.
1N/A
1N/A=item * I<Comparison operations>
1N/A
1N/A "<", "<=", ">", ">=", "==", "!=", "<=>",
1N/A "lt", "le", "gt", "ge", "eq", "ne", "cmp",
1N/A
1N/AIf the corresponding "spaceship" variant is available, it can be
1N/Aused to substitute for the missing operation. During C<sort>ing
1N/Aarrays, C<cmp> is used to compare values subject to C<use overload>.
1N/A
1N/A=item * I<Bit operations>
1N/A
1N/A "&", "^", "|", "neg", "!", "~",
1N/A
1N/AC<neg> stands for unary minus. If the method for C<neg> is not
1N/Aspecified, it can be autogenerated using the method for
1N/Asubtraction. If the method for C<!> is not specified, it can be
1N/Aautogenerated using the methods for C<bool>, or C<"">, or C<0+>.
1N/A
1N/A=item * I<Increment and decrement>
1N/A
1N/A "++", "--",
1N/A
1N/AIf undefined, addition and subtraction methods can be
1N/Aused instead. These operations are called both in prefix and
1N/Apostfix form.
1N/A
1N/A=item * I<Transcendental functions>
1N/A
1N/A "atan2", "cos", "sin", "exp", "abs", "log", "sqrt", "int"
1N/A
1N/AIf C<abs> is unavailable, it can be autogenerated using methods
1N/Afor "E<lt>" or "E<lt>=E<gt>" combined with either unary minus or subtraction.
1N/A
1N/ANote that traditionally the Perl function L<int> rounds to 0, thus for
1N/Afloating-point-like types one should follow the same semantic. If
1N/AC<int> is unavailable, it can be autogenerated using the overloading of
1N/AC<0+>.
1N/A
1N/A=item * I<Boolean, string and numeric conversion>
1N/A
1N/A 'bool', '""', '0+',
1N/A
1N/AIf one or two of these operations are not overloaded, the remaining ones can
1N/Abe used instead. C<bool> is used in the flow control operators
1N/A(like C<while>) and for the ternary C<?:> operation. These functions can
1N/Areturn any arbitrary Perl value. If the corresponding operation for this value
1N/Ais overloaded too, that operation will be called again with this value.
1N/A
1N/AAs a special case if the overload returns the object itself then it will
1N/Abe used directly. An overloaded conversion returning the object is
1N/Aprobably a bug, because you're likely to get something that looks like
1N/AC<YourPackage=HASH(0x8172b34)>.
1N/A
1N/A=item * I<Iteration>
1N/A
1N/A "<>"
1N/A
1N/AIf not overloaded, the argument will be converted to a filehandle or
1N/Aglob (which may require a stringification). The same overloading
1N/Ahappens both for the I<read-filehandle> syntax C<E<lt>$varE<gt>> and
1N/AI<globbing> syntax C<E<lt>${var}E<gt>>.
1N/A
1N/AB<BUGS> Even in list context, the iterator is currently called only
1N/Aonce and with scalar context.
1N/A
1N/A=item * I<Dereferencing>
1N/A
1N/A '${}', '@{}', '%{}', '&{}', '*{}'.
1N/A
1N/AIf not overloaded, the argument will be dereferenced I<as is>, thus
1N/Ashould be of correct type. These functions should return a reference
1N/Aof correct type, or another object with overloaded dereferencing.
1N/A
1N/AAs a special case if the overload returns the object itself then it
1N/Awill be used directly (provided it is the correct type).
1N/A
1N/AThe dereference operators must be specified explicitly they will not be passed to
1N/A"nomethod".
1N/A
1N/A=item * I<Special>
1N/A
1N/A "nomethod", "fallback", "=",
1N/A
1N/Asee L<SPECIAL SYMBOLS FOR C<use overload>>.
1N/A
1N/A=back
1N/A
1N/ASee L<"Fallback"> for an explanation of when a missing method can be
1N/Aautogenerated.
1N/A
1N/AA computer-readable form of the above table is available in the hash
1N/A%overload::ops, with values being space-separated lists of names:
1N/A
1N/A with_assign => '+ - * / % ** << >> x .',
1N/A assign => '+= -= *= /= %= **= <<= >>= x= .=',
1N/A num_comparison => '< <= > >= == !=',
1N/A '3way_comparison'=> '<=> cmp',
1N/A str_comparison => 'lt le gt ge eq ne',
1N/A binary => '& | ^',
1N/A unary => 'neg ! ~',
1N/A mutators => '++ --',
1N/A func => 'atan2 cos sin exp abs log sqrt',
1N/A conversion => 'bool "" 0+',
1N/A iterators => '<>',
1N/A dereferencing => '${} @{} %{} &{} *{}',
1N/A special => 'nomethod fallback ='
1N/A
1N/A=head2 Inheritance and overloading
1N/A
1N/AInheritance interacts with overloading in two ways.
1N/A
1N/A=over
1N/A
1N/A=item Strings as values of C<use overload> directive
1N/A
1N/AIf C<value> in
1N/A
1N/A use overload key => value;
1N/A
1N/Ais a string, it is interpreted as a method name.
1N/A
1N/A=item Overloading of an operation is inherited by derived classes
1N/A
1N/AAny class derived from an overloaded class is also overloaded. The
1N/Aset of overloaded methods is the union of overloaded methods of all
1N/Athe ancestors. If some method is overloaded in several ancestor, then
1N/Awhich description will be used is decided by the usual inheritance
1N/Arules:
1N/A
1N/AIf C<A> inherits from C<B> and C<C> (in this order), C<B> overloads
1N/AC<+> with C<\&D::plus_sub>, and C<C> overloads C<+> by C<"plus_meth">,
1N/Athen the subroutine C<D::plus_sub> will be called to implement
1N/Aoperation C<+> for an object in package C<A>.
1N/A
1N/A=back
1N/A
1N/ANote that since the value of the C<fallback> key is not a subroutine,
1N/Aits inheritance is not governed by the above rules. In the current
1N/Aimplementation, the value of C<fallback> in the first overloaded
1N/Aancestor is used, but this is accidental and subject to change.
1N/A
1N/A=head1 SPECIAL SYMBOLS FOR C<use overload>
1N/A
1N/AThree keys are recognized by Perl that are not covered by the above
1N/Adescription.
1N/A
1N/A=head2 Last Resort
1N/A
1N/AC<"nomethod"> should be followed by a reference to a function of four
1N/Aparameters. If defined, it is called when the overloading mechanism
1N/Acannot find a method for some operation. The first three arguments of
1N/Athis function coincide with the arguments for the corresponding method if
1N/Ait were found, the fourth argument is the symbol
1N/Acorresponding to the missing method. If several methods are tried,
1N/Athe last one is used. Say, C<1-$a> can be equivalent to
1N/A
1N/A &nomethodMethod($a,1,1,"-")
1N/A
1N/Aif the pair C<"nomethod" =E<gt> "nomethodMethod"> was specified in the
1N/AC<use overload> directive.
1N/A
1N/AThe C<"nomethod"> mechanism is I<not> used for the dereference operators
1N/A( ${} @{} %{} &{} *{} ).
1N/A
1N/A
1N/AIf some operation cannot be resolved, and there is no function
1N/Aassigned to C<"nomethod">, then an exception will be raised via die()--
1N/Aunless C<"fallback"> was specified as a key in C<use overload> directive.
1N/A
1N/A
1N/A=head2 Fallback
1N/A
1N/AThe key C<"fallback"> governs what to do if a method for a particular
1N/Aoperation is not found. Three different cases are possible depending on
1N/Athe value of C<"fallback">:
1N/A
1N/A=over 16
1N/A
1N/A=item * C<undef>
1N/A
1N/APerl tries to use a
1N/Asubstituted method (see L<MAGIC AUTOGENERATION>). If this fails, it
1N/Athen tries to calls C<"nomethod"> value; if missing, an exception
1N/Awill be raised.
1N/A
1N/A=item * TRUE
1N/A
1N/AThe same as for the C<undef> value, but no exception is raised. Instead,
1N/Ait silently reverts to what it would have done were there no C<use overload>
1N/Apresent.
1N/A
1N/A=item * defined, but FALSE
1N/A
1N/ANo autogeneration is tried. Perl tries to call
1N/AC<"nomethod"> value, and if this is missing, raises an exception.
1N/A
1N/A=back
1N/A
1N/AB<Note.> C<"fallback"> inheritance via @ISA is not carved in stone
1N/Ayet, see L<"Inheritance and overloading">.
1N/A
1N/A=head2 Copy Constructor
1N/A
1N/AThe value for C<"="> is a reference to a function with three
1N/Aarguments, i.e., it looks like the other values in C<use
1N/Aoverload>. However, it does not overload the Perl assignment
1N/Aoperator. This would go against Camel hair.
1N/A
1N/AThis operation is called in the situations when a mutator is applied
1N/Ato a reference that shares its object with some other reference, such
1N/Aas
1N/A
1N/A $a=$b;
1N/A ++$a;
1N/A
1N/ATo make this change $a and not change $b, a copy of C<$$a> is made,
1N/Aand $a is assigned a reference to this new object. This operation is
1N/Adone during execution of the C<++$a>, and not during the assignment,
1N/A(so before the increment C<$$a> coincides with C<$$b>). This is only
1N/Adone if C<++> is expressed via a method for C<'++'> or C<'+='> (or
1N/AC<nomethod>). Note that if this operation is expressed via C<'+'>
1N/Aa nonmutator, i.e., as in
1N/A
1N/A $a=$b;
1N/A $a=$a+1;
1N/A
1N/Athen C<$a> does not reference a new copy of C<$$a>, since $$a does not
1N/Aappear as lvalue when the above code is executed.
1N/A
1N/AIf the copy constructor is required during the execution of some mutator,
1N/Abut a method for C<'='> was not specified, it can be autogenerated as a
1N/Astring copy if the object is a plain scalar.
1N/A
1N/A=over 5
1N/A
1N/A=item B<Example>
1N/A
1N/AThe actually executed code for
1N/A
1N/A $a=$b;
1N/A Something else which does not modify $a or $b....
1N/A ++$a;
1N/A
1N/Amay be
1N/A
1N/A $a=$b;
1N/A Something else which does not modify $a or $b....
1N/A $a = $a->clone(undef,"");
1N/A $a->incr(undef,"");
1N/A
1N/Aif $b was mathemagical, and C<'++'> was overloaded with C<\&incr>,
1N/AC<'='> was overloaded with C<\&clone>.
1N/A
1N/A=back
1N/A
1N/ASame behaviour is triggered by C<$b = $a++>, which is consider a synonym for
1N/AC<$b = $a; ++$a>.
1N/A
1N/A=head1 MAGIC AUTOGENERATION
1N/A
1N/AIf a method for an operation is not found, and the value for C<"fallback"> is
1N/ATRUE or undefined, Perl tries to autogenerate a substitute method for
1N/Athe missing operation based on the defined operations. Autogenerated method
1N/Asubstitutions are possible for the following operations:
1N/A
1N/A=over 16
1N/A
1N/A=item I<Assignment forms of arithmetic operations>
1N/A
1N/AC<$a+=$b> can use the method for C<"+"> if the method for C<"+=">
1N/Ais not defined.
1N/A
1N/A=item I<Conversion operations>
1N/A
1N/AString, numeric, and boolean conversion are calculated in terms of one
1N/Aanother if not all of them are defined.
1N/A
1N/A=item I<Increment and decrement>
1N/A
1N/AThe C<++$a> operation can be expressed in terms of C<$a+=1> or C<$a+1>,
1N/Aand C<$a--> in terms of C<$a-=1> and C<$a-1>.
1N/A
1N/A=item C<abs($a)>
1N/A
1N/Acan be expressed in terms of C<$aE<lt>0> and C<-$a> (or C<0-$a>).
1N/A
1N/A=item I<Unary minus>
1N/A
1N/Acan be expressed in terms of subtraction.
1N/A
1N/A=item I<Negation>
1N/A
1N/AC<!> and C<not> can be expressed in terms of boolean conversion, or
1N/Astring or numerical conversion.
1N/A
1N/A=item I<Concatenation>
1N/A
1N/Acan be expressed in terms of string conversion.
1N/A
1N/A=item I<Comparison operations>
1N/A
1N/Acan be expressed in terms of its "spaceship" counterpart: either
1N/AC<E<lt>=E<gt>> or C<cmp>:
1N/A
1N/A <, >, <=, >=, ==, != in terms of <=>
1N/A lt, gt, le, ge, eq, ne in terms of cmp
1N/A
1N/A=item I<Iterator>
1N/A
1N/A <> in terms of builtin operations
1N/A
1N/A=item I<Dereferencing>
1N/A
1N/A ${} @{} %{} &{} *{} in terms of builtin operations
1N/A
1N/A=item I<Copy operator>
1N/A
1N/Acan be expressed in terms of an assignment to the dereferenced value, if this
1N/Avalue is a scalar and not a reference.
1N/A
1N/A=back
1N/A
1N/A=head1 Losing overloading
1N/A
1N/AThe restriction for the comparison operation is that even if, for example,
1N/A`C<cmp>' should return a blessed reference, the autogenerated `C<lt>'
1N/Afunction will produce only a standard logical value based on the
1N/Anumerical value of the result of `C<cmp>'. In particular, a working
1N/Anumeric conversion is needed in this case (possibly expressed in terms of
1N/Aother conversions).
1N/A
1N/ASimilarly, C<.=> and C<x=> operators lose their mathemagical properties
1N/Aif the string conversion substitution is applied.
1N/A
1N/AWhen you chop() a mathemagical object it is promoted to a string and its
1N/Amathemagical properties are lost. The same can happen with other
1N/Aoperations as well.
1N/A
1N/A=head1 Run-time Overloading
1N/A
1N/ASince all C<use> directives are executed at compile-time, the only way to
1N/Achange overloading during run-time is to
1N/A
1N/A eval 'use overload "+" => \&addmethod';
1N/A
1N/AYou can also use
1N/A
1N/A eval 'no overload "+", "--", "<="';
1N/A
1N/Athough the use of these constructs during run-time is questionable.
1N/A
1N/A=head1 Public functions
1N/A
1N/APackage C<overload.pm> provides the following public functions:
1N/A
1N/A=over 5
1N/A
1N/A=item overload::StrVal(arg)
1N/A
1N/AGives string value of C<arg> as in absence of stringify overloading.
1N/A
1N/A=item overload::Overloaded(arg)
1N/A
1N/AReturns true if C<arg> is subject to overloading of some operations.
1N/A
1N/A=item overload::Method(obj,op)
1N/A
1N/AReturns C<undef> or a reference to the method that implements C<op>.
1N/A
1N/A=back
1N/A
1N/A=head1 Overloading constants
1N/A
1N/AFor some application Perl parser mangles constants too much. It is possible
1N/Ato hook into this process via overload::constant() and overload::remove_constant()
1N/Afunctions.
1N/A
1N/AThese functions take a hash as an argument. The recognized keys of this hash
1N/Aare
1N/A
1N/A=over 8
1N/A
1N/A=item integer
1N/A
1N/Ato overload integer constants,
1N/A
1N/A=item float
1N/A
1N/Ato overload floating point constants,
1N/A
1N/A=item binary
1N/A
1N/Ato overload octal and hexadecimal constants,
1N/A
1N/A=item q
1N/A
1N/Ato overload C<q>-quoted strings, constant pieces of C<qq>- and C<qx>-quoted
1N/Astrings and here-documents,
1N/A
1N/A=item qr
1N/A
1N/Ato overload constant pieces of regular expressions.
1N/A
1N/A=back
1N/A
1N/AThe corresponding values are references to functions which take three arguments:
1N/Athe first one is the I<initial> string form of the constant, the second one
1N/Ais how Perl interprets this constant, the third one is how the constant is used.
1N/ANote that the initial string form does not
1N/Acontain string delimiters, and has backslashes in backslash-delimiter
1N/Acombinations stripped (thus the value of delimiter is not relevant for
1N/Aprocessing of this string). The return value of this function is how this
1N/Aconstant is going to be interpreted by Perl. The third argument is undefined
1N/Aunless for overloaded C<q>- and C<qr>- constants, it is C<q> in single-quote
1N/Acontext (comes from strings, regular expressions, and single-quote HERE
1N/Adocuments), it is C<tr> for arguments of C<tr>/C<y> operators,
1N/Ait is C<s> for right-hand side of C<s>-operator, and it is C<qq> otherwise.
1N/A
1N/ASince an expression C<"ab$cd,,"> is just a shortcut for C<'ab' . $cd . ',,'>,
1N/Ait is expected that overloaded constant strings are equipped with reasonable
1N/Aoverloaded catenation operator, otherwise absurd results will result.
1N/ASimilarly, negative numbers are considered as negations of positive constants.
1N/A
1N/ANote that it is probably meaningless to call the functions overload::constant()
1N/Aand overload::remove_constant() from anywhere but import() and unimport() methods.
1N/AFrom these methods they may be called as
1N/A
1N/A sub import {
1N/A shift;
1N/A return unless @_;
1N/A die "unknown import: @_" unless @_ == 1 and $_[0] eq ':constant';
1N/A overload::constant integer => sub {Math::BigInt->new(shift)};
1N/A }
1N/A
1N/AB<BUGS> Currently overloaded-ness of constants does not propagate
1N/Ainto C<eval '...'>.
1N/A
1N/A=head1 IMPLEMENTATION
1N/A
1N/AWhat follows is subject to change RSN.
1N/A
1N/AThe table of methods for all operations is cached in magic for the
1N/Asymbol table hash for the package. The cache is invalidated during
1N/Aprocessing of C<use overload>, C<no overload>, new function
1N/Adefinitions, and changes in @ISA. However, this invalidation remains
1N/Aunprocessed until the next C<bless>ing into the package. Hence if you
1N/Awant to change overloading structure dynamically, you'll need an
1N/Aadditional (fake) C<bless>ing to update the table.
1N/A
1N/A(Every SVish thing has a magic queue, and magic is an entry in that
1N/Aqueue. This is how a single variable may participate in multiple
1N/Aforms of magic simultaneously. For instance, environment variables
1N/Aregularly have two forms at once: their %ENV magic and their taint
1N/Amagic. However, the magic which implements overloading is applied to
1N/Athe stashes, which are rarely used directly, thus should not slow down
1N/APerl.)
1N/A
1N/AIf an object belongs to a package using overload, it carries a special
1N/Aflag. Thus the only speed penalty during arithmetic operations without
1N/Aoverloading is the checking of this flag.
1N/A
1N/AIn fact, if C<use overload> is not present, there is almost no overhead
1N/Afor overloadable operations, so most programs should not suffer
1N/Ameasurable performance penalties. A considerable effort was made to
1N/Aminimize the overhead when overload is used in some package, but the
1N/Aarguments in question do not belong to packages using overload. When
1N/Ain doubt, test your speed with C<use overload> and without it. So far
1N/Athere have been no reports of substantial speed degradation if Perl is
1N/Acompiled with optimization turned on.
1N/A
1N/AThere is no size penalty for data if overload is not used. The only
1N/Asize penalty if overload is used in some package is that I<all> the
1N/Apackages acquire a magic during the next C<bless>ing into the
1N/Apackage. This magic is three-words-long for packages without
1N/Aoverloading, and carries the cache table if the package is overloaded.
1N/A
1N/ACopying (C<$a=$b>) is shallow; however, a one-level-deep copying is
1N/Acarried out before any operation that can imply an assignment to the
1N/Aobject $a (or $b) refers to, like C<$a++>. You can override this
1N/Abehavior by defining your own copy constructor (see L<"Copy Constructor">).
1N/A
1N/AIt is expected that arguments to methods that are not explicitly supposed
1N/Ato be changed are constant (but this is not enforced).
1N/A
1N/A=head1 Metaphor clash
1N/A
1N/AOne may wonder why the semantic of overloaded C<=> is so counter intuitive.
1N/AIf it I<looks> counter intuitive to you, you are subject to a metaphor
1N/Aclash.
1N/A
1N/AHere is a Perl object metaphor:
1N/A
1N/AI< object is a reference to blessed data>
1N/A
1N/Aand an arithmetic metaphor:
1N/A
1N/AI< object is a thing by itself>.
1N/A
1N/AThe I<main> problem of overloading C<=> is the fact that these metaphors
1N/Aimply different actions on the assignment C<$a = $b> if $a and $b are
1N/Aobjects. Perl-think implies that $a becomes a reference to whatever
1N/A$b was referencing. Arithmetic-think implies that the value of "object"
1N/A$a is changed to become the value of the object $b, preserving the fact
1N/Athat $a and $b are separate entities.
1N/A
1N/AThe difference is not relevant in the absence of mutators. After
1N/Aa Perl-way assignment an operation which mutates the data referenced by $a
1N/Awould change the data referenced by $b too. Effectively, after
1N/AC<$a = $b> values of $a and $b become I<indistinguishable>.
1N/A
1N/AOn the other hand, anyone who has used algebraic notation knows the
1N/Aexpressive power of the arithmetic metaphor. Overloading works hard
1N/Ato enable this metaphor while preserving the Perlian way as far as
1N/Apossible. Since it is not possible to freely mix two contradicting
1N/Ametaphors, overloading allows the arithmetic way to write things I<as
1N/Afar as all the mutators are called via overloaded access only>. The
1N/Away it is done is described in L<Copy Constructor>.
1N/A
1N/AIf some mutator methods are directly applied to the overloaded values,
1N/Aone may need to I<explicitly unlink> other values which references the
1N/Asame value:
1N/A
1N/A $a = new Data 23;
1N/A ...
1N/A $b = $a; # $b is "linked" to $a
1N/A ...
1N/A $a = $a->clone; # Unlink $b from $a
1N/A $a->increment_by(4);
1N/A
1N/ANote that overloaded access makes this transparent:
1N/A
1N/A $a = new Data 23;
1N/A $b = $a; # $b is "linked" to $a
1N/A $a += 4; # would unlink $b automagically
1N/A
1N/AHowever, it would not make
1N/A
1N/A $a = new Data 23;
1N/A $a = 4; # Now $a is a plain 4, not 'Data'
1N/A
1N/Apreserve "objectness" of $a. But Perl I<has> a way to make assignments
1N/Ato an object do whatever you want. It is just not the overload, but
1N/Atie()ing interface (see L<perlfunc/tie>). Adding a FETCH() method
1N/Awhich returns the object itself, and STORE() method which changes the
1N/Avalue of the object, one can reproduce the arithmetic metaphor in its
1N/Acompleteness, at least for variables which were tie()d from the start.
1N/A
1N/A(Note that a workaround for a bug may be needed, see L<"BUGS">.)
1N/A
1N/A=head1 Cookbook
1N/A
1N/APlease add examples to what follows!
1N/A
1N/A=head2 Two-face scalars
1N/A
1N/APut this in F<two_face.pm> in your Perl library directory:
1N/A
1N/A package two_face; # Scalars with separate string and
1N/A # numeric values.
1N/A sub new { my $p = shift; bless [@_], $p }
1N/A use overload '""' => \&str, '0+' => \&num, fallback => 1;
1N/A sub num {shift->[1]}
1N/A sub str {shift->[0]}
1N/A
1N/AUse it as follows:
1N/A
1N/A require two_face;
1N/A my $seven = new two_face ("vii", 7);
1N/A printf "seven=$seven, seven=%d, eight=%d\n", $seven, $seven+1;
1N/A print "seven contains `i'\n" if $seven =~ /i/;
1N/A
1N/A(The second line creates a scalar which has both a string value, and a
1N/Anumeric value.) This prints:
1N/A
1N/A seven=vii, seven=7, eight=8
1N/A seven contains `i'
1N/A
1N/A=head2 Two-face references
1N/A
1N/ASuppose you want to create an object which is accessible as both an
1N/Aarray reference and a hash reference, similar to the
1N/AL<pseudo-hash|perlref/"Pseudo-hashes: Using an array as a hash">
1N/Abuiltin Perl type. Let's make it better than a pseudo-hash by
1N/Aallowing index 0 to be treated as a normal element.
1N/A
1N/A package two_refs;
1N/A use overload '%{}' => \&gethash, '@{}' => sub { $ {shift()} };
1N/A sub new {
1N/A my $p = shift;
1N/A bless \ [@_], $p;
1N/A }
1N/A sub gethash {
1N/A my %h;
1N/A my $self = shift;
1N/A tie %h, ref $self, $self;
1N/A \%h;
1N/A }
1N/A
1N/A sub TIEHASH { my $p = shift; bless \ shift, $p }
1N/A my %fields;
1N/A my $i = 0;
1N/A $fields{$_} = $i++ foreach qw{zero one two three};
1N/A sub STORE {
1N/A my $self = ${shift()};
1N/A my $key = $fields{shift()};
1N/A defined $key or die "Out of band access";
1N/A $$self->[$key] = shift;
1N/A }
1N/A sub FETCH {
1N/A my $self = ${shift()};
1N/A my $key = $fields{shift()};
1N/A defined $key or die "Out of band access";
1N/A $$self->[$key];
1N/A }
1N/A
1N/ANow one can access an object using both the array and hash syntax:
1N/A
1N/A my $bar = new two_refs 3,4,5,6;
1N/A $bar->[2] = 11;
1N/A $bar->{two} == 11 or die 'bad hash fetch';
1N/A
1N/ANote several important features of this example. First of all, the
1N/AI<actual> type of $bar is a scalar reference, and we do not overload
1N/Athe scalar dereference. Thus we can get the I<actual> non-overloaded
1N/Acontents of $bar by just using C<$$bar> (what we do in functions which
1N/Aoverload dereference). Similarly, the object returned by the
1N/ATIEHASH() method is a scalar reference.
1N/A
1N/ASecond, we create a new tied hash each time the hash syntax is used.
1N/AThis allows us not to worry about a possibility of a reference loop,
1N/Awhich would lead to a memory leak.
1N/A
1N/ABoth these problems can be cured. Say, if we want to overload hash
1N/Adereference on a reference to an object which is I<implemented> as a
1N/Ahash itself, the only problem one has to circumvent is how to access
1N/Athis I<actual> hash (as opposed to the I<virtual> hash exhibited by the
1N/Aoverloaded dereference operator). Here is one possible fetching routine:
1N/A
1N/A sub access_hash {
1N/A my ($self, $key) = (shift, shift);
1N/A my $class = ref $self;
1N/A bless $self, 'overload::dummy'; # Disable overloading of %{}
1N/A my $out = $self->{$key};
1N/A bless $self, $class; # Restore overloading
1N/A $out;
1N/A }
1N/A
1N/ATo remove creation of the tied hash on each access, one may an extra
1N/Alevel of indirection which allows a non-circular structure of references:
1N/A
1N/A package two_refs1;
1N/A use overload '%{}' => sub { ${shift()}->[1] },
1N/A '@{}' => sub { ${shift()}->[0] };
1N/A sub new {
1N/A my $p = shift;
1N/A my $a = [@_];
1N/A my %h;
1N/A tie %h, $p, $a;
1N/A bless \ [$a, \%h], $p;
1N/A }
1N/A sub gethash {
1N/A my %h;
1N/A my $self = shift;
1N/A tie %h, ref $self, $self;
1N/A \%h;
1N/A }
1N/A
1N/A sub TIEHASH { my $p = shift; bless \ shift, $p }
1N/A my %fields;
1N/A my $i = 0;
1N/A $fields{$_} = $i++ foreach qw{zero one two three};
1N/A sub STORE {
1N/A my $a = ${shift()};
1N/A my $key = $fields{shift()};
1N/A defined $key or die "Out of band access";
1N/A $a->[$key] = shift;
1N/A }
1N/A sub FETCH {
1N/A my $a = ${shift()};
1N/A my $key = $fields{shift()};
1N/A defined $key or die "Out of band access";
1N/A $a->[$key];
1N/A }
1N/A
1N/ANow if $baz is overloaded like this, then C<$baz> is a reference to a
1N/Areference to the intermediate array, which keeps a reference to an
1N/Aactual array, and the access hash. The tie()ing object for the access
1N/Ahash is a reference to a reference to the actual array, so
1N/A
1N/A=over
1N/A
1N/A=item *
1N/A
1N/AThere are no loops of references.
1N/A
1N/A=item *
1N/A
1N/ABoth "objects" which are blessed into the class C<two_refs1> are
1N/Areferences to a reference to an array, thus references to a I<scalar>.
1N/AThus the accessor expression C<$$foo-E<gt>[$ind]> involves no
1N/Aoverloaded operations.
1N/A
1N/A=back
1N/A
1N/A=head2 Symbolic calculator
1N/A
1N/APut this in F<symbolic.pm> in your Perl library directory:
1N/A
1N/A package symbolic; # Primitive symbolic calculator
1N/A use overload nomethod => \&wrap;
1N/A
1N/A sub new { shift; bless ['n', @_] }
1N/A sub wrap {
1N/A my ($obj, $other, $inv, $meth) = @_;
1N/A ($obj, $other) = ($other, $obj) if $inv;
1N/A bless [$meth, $obj, $other];
1N/A }
1N/A
1N/AThis module is very unusual as overloaded modules go: it does not
1N/Aprovide any usual overloaded operators, instead it provides the L<Last
1N/AResort> operator C<nomethod>. In this example the corresponding
1N/Asubroutine returns an object which encapsulates operations done over
1N/Athe objects: C<new symbolic 3> contains C<['n', 3]>, C<2 + new
1N/Asymbolic 3> contains C<['+', 2, ['n', 3]]>.
1N/A
1N/AHere is an example of the script which "calculates" the side of
1N/Acircumscribed octagon using the above package:
1N/A
1N/A require symbolic;
1N/A my $iter = 1; # 2**($iter+2) = 8
1N/A my $side = new symbolic 1;
1N/A my $cnt = $iter;
1N/A
1N/A while ($cnt--) {
1N/A $side = (sqrt(1 + $side**2) - 1)/$side;
1N/A }
1N/A print "OK\n";
1N/A
1N/AThe value of $side is
1N/A
1N/A ['/', ['-', ['sqrt', ['+', 1, ['**', ['n', 1], 2]],
1N/A undef], 1], ['n', 1]]
1N/A
1N/ANote that while we obtained this value using a nice little script,
1N/Athere is no simple way to I<use> this value. In fact this value may
1N/Abe inspected in debugger (see L<perldebug>), but ony if
1N/AC<bareStringify> B<O>ption is set, and not via C<p> command.
1N/A
1N/AIf one attempts to print this value, then the overloaded operator
1N/AC<""> will be called, which will call C<nomethod> operator. The
1N/Aresult of this operator will be stringified again, but this result is
1N/Aagain of type C<symbolic>, which will lead to an infinite loop.
1N/A
1N/AAdd a pretty-printer method to the module F<symbolic.pm>:
1N/A
1N/A sub pretty {
1N/A my ($meth, $a, $b) = @{+shift};
1N/A $a = 'u' unless defined $a;
1N/A $b = 'u' unless defined $b;
1N/A $a = $a->pretty if ref $a;
1N/A $b = $b->pretty if ref $b;
1N/A "[$meth $a $b]";
1N/A }
1N/A
1N/ANow one can finish the script by
1N/A
1N/A print "side = ", $side->pretty, "\n";
1N/A
1N/AThe method C<pretty> is doing object-to-string conversion, so it
1N/Ais natural to overload the operator C<""> using this method. However,
1N/Ainside such a method it is not necessary to pretty-print the
1N/AI<components> $a and $b of an object. In the above subroutine
1N/AC<"[$meth $a $b]"> is a catenation of some strings and components $a
1N/Aand $b. If these components use overloading, the catenation operator
1N/Awill look for an overloaded operator C<.>; if not present, it will
1N/Alook for an overloaded operator C<"">. Thus it is enough to use
1N/A
1N/A use overload nomethod => \&wrap, '""' => \&str;
1N/A sub str {
1N/A my ($meth, $a, $b) = @{+shift};
1N/A $a = 'u' unless defined $a;
1N/A $b = 'u' unless defined $b;
1N/A "[$meth $a $b]";
1N/A }
1N/A
1N/ANow one can change the last line of the script to
1N/A
1N/A print "side = $side\n";
1N/A
1N/Awhich outputs
1N/A
1N/A side = [/ [- [sqrt [+ 1 [** [n 1 u] 2]] u] 1] [n 1 u]]
1N/A
1N/Aand one can inspect the value in debugger using all the possible
1N/Amethods.
1N/A
1N/ASomething is still amiss: consider the loop variable $cnt of the
1N/Ascript. It was a number, not an object. We cannot make this value of
1N/Atype C<symbolic>, since then the loop will not terminate.
1N/A
1N/AIndeed, to terminate the cycle, the $cnt should become false.
1N/AHowever, the operator C<bool> for checking falsity is overloaded (this
1N/Atime via overloaded C<"">), and returns a long string, thus any object
1N/Aof type C<symbolic> is true. To overcome this, we need a way to
1N/Acompare an object to 0. In fact, it is easier to write a numeric
1N/Aconversion routine.
1N/A
1N/AHere is the text of F<symbolic.pm> with such a routine added (and
1N/Aslightly modified str()):
1N/A
1N/A package symbolic; # Primitive symbolic calculator
1N/A use overload
1N/A nomethod => \&wrap, '""' => \&str, '0+' => \&num;
1N/A
1N/A sub new { shift; bless ['n', @_] }
1N/A sub wrap {
1N/A my ($obj, $other, $inv, $meth) = @_;
1N/A ($obj, $other) = ($other, $obj) if $inv;
1N/A bless [$meth, $obj, $other];
1N/A }
1N/A sub str {
1N/A my ($meth, $a, $b) = @{+shift};
1N/A $a = 'u' unless defined $a;
1N/A if (defined $b) {
1N/A "[$meth $a $b]";
1N/A } else {
1N/A "[$meth $a]";
1N/A }
1N/A }
1N/A my %subr = ( n => sub {$_[0]},
1N/A sqrt => sub {sqrt $_[0]},
1N/A '-' => sub {shift() - shift()},
1N/A '+' => sub {shift() + shift()},
1N/A '/' => sub {shift() / shift()},
1N/A '*' => sub {shift() * shift()},
1N/A '**' => sub {shift() ** shift()},
1N/A );
1N/A sub num {
1N/A my ($meth, $a, $b) = @{+shift};
1N/A my $subr = $subr{$meth}
1N/A or die "Do not know how to ($meth) in symbolic";
1N/A $a = $a->num if ref $a eq __PACKAGE__;
1N/A $b = $b->num if ref $b eq __PACKAGE__;
1N/A $subr->($a,$b);
1N/A }
1N/A
1N/AAll the work of numeric conversion is done in %subr and num(). Of
1N/Acourse, %subr is not complete, it contains only operators used in the
1N/Aexample below. Here is the extra-credit question: why do we need an
1N/Aexplicit recursion in num()? (Answer is at the end of this section.)
1N/A
1N/AUse this module like this:
1N/A
1N/A require symbolic;
1N/A my $iter = new symbolic 2; # 16-gon
1N/A my $side = new symbolic 1;
1N/A my $cnt = $iter;
1N/A
1N/A while ($cnt) {
1N/A $cnt = $cnt - 1; # Mutator `--' not implemented
1N/A $side = (sqrt(1 + $side**2) - 1)/$side;
1N/A }
1N/A printf "%s=%f\n", $side, $side;
1N/A printf "pi=%f\n", $side*(2**($iter+2));
1N/A
1N/AIt prints (without so many line breaks)
1N/A
1N/A [/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1]
1N/A [n 1]] 2]]] 1]
1N/A [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]=0.198912
1N/A pi=3.182598
1N/A
1N/AThe above module is very primitive. It does not implement
1N/Amutator methods (C<++>, C<-=> and so on), does not do deep copying
1N/A(not required without mutators!), and implements only those arithmetic
1N/Aoperations which are used in the example.
1N/A
1N/ATo implement most arithmetic operations is easy; one should just use
1N/Athe tables of operations, and change the code which fills %subr to
1N/A
1N/A my %subr = ( 'n' => sub {$_[0]} );
1N/A foreach my $op (split " ", $overload::ops{with_assign}) {
1N/A $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
1N/A }
1N/A my @bins = qw(binary 3way_comparison num_comparison str_comparison);
1N/A foreach my $op (split " ", "@overload::ops{ @bins }") {
1N/A $subr{$op} = eval "sub {shift() $op shift()}";
1N/A }
1N/A foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
1N/A print "defining `$op'\n";
1N/A $subr{$op} = eval "sub {$op shift()}";
1N/A }
1N/A
1N/ADue to L<Calling Conventions for Mutators>, we do not need anything
1N/Aspecial to make C<+=> and friends work, except filling C<+=> entry of
1N/A%subr, and defining a copy constructor (needed since Perl has no
1N/Away to know that the implementation of C<'+='> does not mutate
1N/Athe argument, compare L<Copy Constructor>).
1N/A
1N/ATo implement a copy constructor, add C<< '=' => \&cpy >> to C<use overload>
1N/Aline, and code (this code assumes that mutators change things one level
1N/Adeep only, so recursive copying is not needed):
1N/A
1N/A sub cpy {
1N/A my $self = shift;
1N/A bless [@$self], ref $self;
1N/A }
1N/A
1N/ATo make C<++> and C<--> work, we need to implement actual mutators,
1N/Aeither directly, or in C<nomethod>. We continue to do things inside
1N/AC<nomethod>, thus add
1N/A
1N/A if ($meth eq '++' or $meth eq '--') {
1N/A @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
1N/A return $obj;
1N/A }
1N/A
1N/Aafter the first line of wrap(). This is not a most effective
1N/Aimplementation, one may consider
1N/A
1N/A sub inc { $_[0] = bless ['++', shift, 1]; }
1N/A
1N/Ainstead.
1N/A
1N/AAs a final remark, note that one can fill %subr by
1N/A
1N/A my %subr = ( 'n' => sub {$_[0]} );
1N/A foreach my $op (split " ", $overload::ops{with_assign}) {
1N/A $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
1N/A }
1N/A my @bins = qw(binary 3way_comparison num_comparison str_comparison);
1N/A foreach my $op (split " ", "@overload::ops{ @bins }") {
1N/A $subr{$op} = eval "sub {shift() $op shift()}";
1N/A }
1N/A foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
1N/A $subr{$op} = eval "sub {$op shift()}";
1N/A }
1N/A $subr{'++'} = $subr{'+'};
1N/A $subr{'--'} = $subr{'-'};
1N/A
1N/AThis finishes implementation of a primitive symbolic calculator in
1N/A50 lines of Perl code. Since the numeric values of subexpressions
1N/Aare not cached, the calculator is very slow.
1N/A
1N/AHere is the answer for the exercise: In the case of str(), we need no
1N/Aexplicit recursion since the overloaded C<.>-operator will fall back
1N/Ato an existing overloaded operator C<"">. Overloaded arithmetic
1N/Aoperators I<do not> fall back to numeric conversion if C<fallback> is
1N/Anot explicitly requested. Thus without an explicit recursion num()
1N/Awould convert C<['+', $a, $b]> to C<$a + $b>, which would just rebuild
1N/Athe argument of num().
1N/A
1N/AIf you wonder why defaults for conversion are different for str() and
1N/Anum(), note how easy it was to write the symbolic calculator. This
1N/Asimplicity is due to an appropriate choice of defaults. One extra
1N/Anote: due to the explicit recursion num() is more fragile than sym():
1N/Awe need to explicitly check for the type of $a and $b. If components
1N/A$a and $b happen to be of some related type, this may lead to problems.
1N/A
1N/A=head2 I<Really> symbolic calculator
1N/A
1N/AOne may wonder why we call the above calculator symbolic. The reason
1N/Ais that the actual calculation of the value of expression is postponed
1N/Auntil the value is I<used>.
1N/A
1N/ATo see it in action, add a method
1N/A
1N/A sub STORE {
1N/A my $obj = shift;
1N/A $#$obj = 1;
1N/A @$obj->[0,1] = ('=', shift);
1N/A }
1N/A
1N/Ato the package C<symbolic>. After this change one can do
1N/A
1N/A my $a = new symbolic 3;
1N/A my $b = new symbolic 4;
1N/A my $c = sqrt($a**2 + $b**2);
1N/A
1N/Aand the numeric value of $c becomes 5. However, after calling
1N/A
1N/A $a->STORE(12); $b->STORE(5);
1N/A
1N/Athe numeric value of $c becomes 13. There is no doubt now that the module
1N/Asymbolic provides a I<symbolic> calculator indeed.
1N/A
1N/ATo hide the rough edges under the hood, provide a tie()d interface to the
1N/Apackage C<symbolic> (compare with L<Metaphor clash>). Add methods
1N/A
1N/A sub TIESCALAR { my $pack = shift; $pack->new(@_) }
1N/A sub FETCH { shift }
1N/A sub nop { } # Around a bug
1N/A
1N/A(the bug is described in L<"BUGS">). One can use this new interface as
1N/A
1N/A tie $a, 'symbolic', 3;
1N/A tie $b, 'symbolic', 4;
1N/A $a->nop; $b->nop; # Around a bug
1N/A
1N/A my $c = sqrt($a**2 + $b**2);
1N/A
1N/ANow numeric value of $c is 5. After C<$a = 12; $b = 5> the numeric value
1N/Aof $c becomes 13. To insulate the user of the module add a method
1N/A
1N/A sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
1N/A
1N/ANow
1N/A
1N/A my ($a, $b);
1N/A symbolic->vars($a, $b);
1N/A my $c = sqrt($a**2 + $b**2);
1N/A
1N/A $a = 3; $b = 4;
1N/A printf "c5 %s=%f\n", $c, $c;
1N/A
1N/A $a = 12; $b = 5;
1N/A printf "c13 %s=%f\n", $c, $c;
1N/A
1N/Ashows that the numeric value of $c follows changes to the values of $a
1N/Aand $b.
1N/A
1N/A=head1 AUTHOR
1N/A
1N/AIlya Zakharevich E<lt>F<ilya@math.mps.ohio-state.edu>E<gt>.
1N/A
1N/A=head1 DIAGNOSTICS
1N/A
1N/AWhen Perl is run with the B<-Do> switch or its equivalent, overloading
1N/Ainduces diagnostic messages.
1N/A
1N/AUsing the C<m> command of Perl debugger (see L<perldebug>) one can
1N/Adeduce which operations are overloaded (and which ancestor triggers
1N/Athis overloading). Say, if C<eq> is overloaded, then the method C<(eq>
1N/Ais shown by debugger. The method C<()> corresponds to the C<fallback>
1N/Akey (in fact a presence of this method shows that this package has
1N/Aoverloading enabled, and it is what is used by the C<Overloaded>
1N/Afunction of module C<overload>).
1N/A
1N/AThe module might issue the following warnings:
1N/A
1N/A=over 4
1N/A
1N/A=item Odd number of arguments for overload::constant
1N/A
1N/A(W) The call to overload::constant contained an odd number of arguments.
1N/AThe arguments should come in pairs.
1N/A
1N/A=item `%s' is not an overloadable type
1N/A
1N/A(W) You tried to overload a constant type the overload package is unaware of.
1N/A
1N/A=item `%s' is not a code reference
1N/A
1N/A(W) The second (fourth, sixth, ...) argument of overload::constant needs
1N/Ato be a code reference. Either an anonymous subroutine, or a reference
1N/Ato a subroutine.
1N/A
1N/A=back
1N/A
1N/A=head1 BUGS
1N/A
1N/ABecause it is used for overloading, the per-package hash %OVERLOAD now
1N/Ahas a special meaning in Perl. The symbol table is filled with names
1N/Alooking like line-noise.
1N/A
1N/AFor the purpose of inheritance every overloaded package behaves as if
1N/AC<fallback> is present (possibly undefined). This may create
1N/Ainteresting effects if some package is not overloaded, but inherits
1N/Afrom two overloaded packages.
1N/A
1N/ARelation between overloading and tie()ing is broken. Overloading is
1N/Atriggered or not basing on the I<previous> class of tie()d value.
1N/A
1N/AThis happens because the presence of overloading is checked too early,
1N/Abefore any tie()d access is attempted. If the FETCH()ed class of the
1N/Atie()d value does not change, a simple workaround is to access the value
1N/Aimmediately after tie()ing, so that after this call the I<previous> class
1N/Acoincides with the current one.
1N/A
1N/AB<Needed:> a way to fix this without a speed penalty.
1N/A
1N/ABarewords are not covered by overloaded string constants.
1N/A
1N/AThis document is confusing. There are grammos and misleading language
1N/Aused in places. It would seem a total rewrite is needed.
1N/A
1N/A=cut
1N/A