X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/aa6893958c2bfb6fa4ab923c8466c188c65748fd..4cabf874ee37b27dc1844a78d68b2cacf5caaae8:/lib/overload.pm diff --git a/lib/overload.pm b/lib/overload.pm index c9044db..7d09d69 100644 --- a/lib/overload.pm +++ b/lib/overload.pm @@ -1,5 +1,7 @@ package overload; +our $VERSION = '1.10'; + sub nil {} sub OVERLOAD { @@ -7,6 +9,7 @@ sub OVERLOAD { my %arg = @_; my ($sub, $fb); $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching. + $fb = ${$package . "::()"}; # preserve old fallback value RT#68196 *{$package . "::()"} = \&nil; # Make it findable via fetchmethod. for (keys %arg) { if ($_ eq 'fallback') { @@ -62,12 +65,21 @@ sub OverloadedStringify { my $package = shift; $package = ref $package if ref $package; #$package->can('(""') - ov_method mycan($package, '(""'), $package; + ov_method mycan($package, '(""'), $package + or ov_method mycan($package, '(0+'), $package + or ov_method mycan($package, '(bool'), $package + or ov_method mycan($package, '(nomethod'), $package; } sub Method { my $package = shift; - $package = ref $package if ref $package; + if(ref $package) { + local $@; + local $!; + require Scalar::Util; + $package = Scalar::Util::blessed($package); + return undef if !defined $package; + } #my $meth = $package->can('(' . shift); ov_method mycan($package, '(' . shift), $package; #return $meth if $meth ne \&nil; @@ -77,76 +89,138 @@ sub Method { sub AddrRef { my $package = ref $_[0]; return "$_[0]" unless $package; - bless $_[0], overload::Fake; # Non-overloaded package - my $str = "$_[0]"; - bless $_[0], $package; # Back - $package . substr $str, index $str, '='; -} -sub StrVal { - (OverloadedStringify($_[0])) ? - (AddrRef(shift)) : - "$_[0]"; + local $@; + local $!; + require Scalar::Util; + my $class = Scalar::Util::blessed($_[0]); + my $class_prefix = defined($class) ? "$class=" : ""; + my $type = Scalar::Util::reftype($_[0]); + my $addr = Scalar::Util::refaddr($_[0]); + return sprintf("$class_prefix$type(0x%x)", $addr); } +*StrVal = *AddrRef; + sub mycan { # Real can would leave stubs. my ($package, $meth) = @_; - return \*{$package . "::$meth"} if defined &{$package . "::$meth"}; - my $p; - foreach $p (@{$package . "::ISA"}) { - my $out = mycan($p, $meth); - return $out if $out; + + local $@; + local $!; + require mro; + + my $mro = mro::get_linear_isa($package); + foreach my $p (@$mro) { + my $fqmeth = $p . q{::} . $meth; + return \*{$fqmeth} if defined &{$fqmeth}; } + return undef; } +%constants = ( + 'integer' => 0x1000, # HINT_NEW_INTEGER + 'float' => 0x2000, # HINT_NEW_FLOAT + 'binary' => 0x4000, # HINT_NEW_BINARY + 'q' => 0x8000, # HINT_NEW_STRING + 'qr' => 0x10000, # HINT_NEW_RE + ); + +%ops = ( with_assign => "+ - * / % ** << >> x .", + assign => "+= -= *= /= %= **= <<= >>= x= .=", + num_comparison => "< <= > >= == !=", + '3way_comparison'=> "<=> cmp", + str_comparison => "lt le gt ge eq ne", + binary => '& &= | |= ^ ^=', + unary => "neg ! ~", + mutators => '++ --', + func => "atan2 cos sin exp abs log sqrt int", + conversion => 'bool "" 0+ qr', + iterators => '<>', + filetest => "-X", + dereferencing => '${} @{} %{} &{} *{}', + matching => '~~', + special => 'nomethod fallback ='); + +use warnings::register; +sub constant { + # Arguments: what, sub + while (@_) { + if (@_ == 1) { + warnings::warnif ("Odd number of arguments for overload::constant"); + last; + } + elsif (!exists $constants {$_ [0]}) { + warnings::warnif ("`$_[0]' is not an overloadable type"); + } + elsif (!ref $_ [1] || "$_[1]" !~ /(^|=)CODE\(0x[0-9a-f]+\)$/) { + # Can't use C above as code references can be + # blessed, and C would return the package the ref is blessed into. + if (warnings::enabled) { + $_ [1] = "undef" unless defined $_ [1]; + warnings::warn ("`$_[1]' is not a code reference"); + } + } + else { + $^H{$_[0]} = $_[1]; + $^H |= $constants{$_[0]}; + } + shift, shift; + } +} + +sub remove_constant { + # Arguments: what, sub + while (@_) { + delete $^H{$_[0]}; + $^H &= ~ $constants{$_[0]}; + shift, shift; + } +} + 1; __END__ -=head1 NAME +=head1 NAME -overload - Package for overloading perl operations +overload - Package for overloading Perl operations =head1 SYNOPSIS package SomeThing; - use overload + use overload '+' => \&myadd, '-' => \&mysub; # etc ... package main; - $a = new SomeThing 57; + $a = SomeThing->new( 57 ); $b=5+$a; ... if (overload::Overloaded $b) {...} ... $strval = overload::StrVal $b; -=head1 CAVEAT SCRIPTOR - -Overloading of operators is a subject not to be taken lightly. -Neither its precise implementation, syntax, nor semantics are -100% endorsed by Larry Wall. So any of these may be changed -at some point in the future. - =head1 DESCRIPTION +This pragma allows overloading of Perl's operators for a class. +To overload built-in functions, see L instead. + =head2 Declaration of overloaded functions The compilation directive package Number; use overload - "+" => \&add, + "+" => \&add, "*=" => "muas"; declares function Number::add() for addition, and method muas() in the "class" C (or one of its base classes) -for the assignment form C<*=> of multiplication. +for the assignment form C<*=> of multiplication. Arguments of this directive come in (key, value) pairs. Legal values are values legal inside a C<&{ ... }> call, so the name of a @@ -194,7 +268,8 @@ the arguments are reversed. the current operation is an assignment variant (as in C<$a+=7>), but the usual function is called instead. This additional -information can be used to generate some optimizations. +information can be used to generate some optimizations. Compare +L. =back @@ -204,9 +279,67 @@ Unary operation are considered binary operations with the second argument being C. Thus the functions that overloads C<{"++"}> is called with arguments C<($a,undef,'')> when $a++ is executed. +=head2 Calling Conventions for Mutators + +Two types of mutators have different calling conventions: + +=over + +=item C<++> and C<--> + +The routines which implement these operators are expected to actually +I their arguments. So, assuming that $obj is a reference to a +number, + + sub incr { my $n = $ {$_[0]}; ++$n; $_[0] = bless \$n} + +is an appropriate implementation of overloaded C<++>. Note that + + sub incr { ++$ {$_[0]} ; shift } + +is OK if used with preincrement and with postincrement. (In the case +of postincrement a copying will be performed, see L.) + +=item C and other assignment versions + +There is nothing special about these methods. They may change the +value of their arguments, and may leave it as is. The result is going +to be assigned to the value in the left-hand-side if different from +this value. + +This allows for the same method to be used as overloaded C<+=> and +C<+>. Note that this is I, but not recommended, since by the +semantic of L<"Fallback"> Perl will call the method for C<+> anyway, +if C<+=> is not overloaded. + +=back + +B Due to the presence of assignment versions of operations, +routines which may be called in assignment context may create +self-referential structures. Currently Perl will not free self-referential +structures until cycles are C broken. You may get problems +when traversing your structures too. + +Say, + + use overload '+' => sub { bless [ \$_[0], \$_[1] ] }; + +is asking for trouble, since for code C<$obj += $foo> the subroutine +is called as C<$obj = add($obj, $foo, undef)>, or C<$obj = [\$obj, +\$foo]>. If using such a subroutine is an important optimization, one +can overload C<+=> explicitly by a non-"optimized" version, or switch +to non-optimized version if C (see +L). + +Even if no I assignment-variants of operators are present in +the script, they may be generated by the optimizer. Say, C<",$obj,"> or +C<',' . $obj . ','> may be both optimized to + + my $tmp = ',' . $obj; $tmp .= ','; + =head2 Overloadable Operations -The following symbols can be specified in C: +The following symbols can be specified in C directive: =over 5 @@ -216,11 +349,15 @@ The following symbols can be specified in C: "**", "**=", "<<", "<<=", ">>", ">>=", "x", "x=", ".", ".=", For these operations a substituted non-assignment variant can be called if -the assignment variant is not available. Methods for operations "C<+>", -"C<->", "C<+=>", and "C<-=>" can be called to automatically generate -increment and decrement methods. The operation "C<->" can be used to +the assignment variant is not available. Methods for operations C<+>, +C<->, C<+=>, and C<-=> can be called to automatically generate +increment and decrement methods. The operation C<-> can be used to autogenerate missing methods for unary minus or C. +See L<"MAGIC AUTOGENERATION">, L<"Calling Conventions for Mutators"> and +L<"Calling Conventions for Binary Operations">) for details of these +substitutions. + =item * I "<", "<=", ">", ">=", "==", "!=", "<=>", @@ -232,12 +369,16 @@ arrays, C is used to compare values subject to C. =item * I - "&", "^", "|", "neg", "!", "~", + "&", "&=", "^", "^=", "|", "|=", "neg", "!", "~", -"C" stands for unary minus. If the method for C is not +C stands for unary minus. If the method for C is not specified, it can be autogenerated using the method for -subtraction. If the method for "C" is not specified, it can be -autogenerated using the methods for "C", or "C<\"\">", or "C<0+>". +subtraction. If the method for C is not specified, it can be +autogenerated using the methods for C, or C<"">, or C<0+>. + +The same remarks in L<"Arithmetic operations"> about +assignment-variants and autogeneration apply for +bit operations C<"&">, C<"^">, and C<"|"> as well. =item * I @@ -249,30 +390,145 @@ postfix form. =item * I - "atan2", "cos", "sin", "exp", "abs", "log", "sqrt", + "atan2", "cos", "sin", "exp", "abs", "log", "sqrt", "int" If C is unavailable, it can be autogenerated using methods for "E" or "E=E" combined with either unary minus or subtraction. -=item * I +Note that traditionally the Perl function L rounds to 0, thus for +floating-point-like types one should follow the same semantic. If +C is unavailable, it can be autogenerated using the overloading of +C<0+>. + +=item * I + + 'bool', '""', '0+', 'qr' + +If one or two of these operations are not overloaded, the remaining ones +can be used instead. C is used in the flow control operators +(like C) and for the ternary C operation; C is used for +the RHS of C<=~> and when an object is interpolated into a regexp. + +C, C<"">, and C<0+> can return any arbitrary Perl value. If the +corresponding operation for this value is overloaded too, that operation +will be called again with this value. C must return a compiled +regexp, or a ref to a compiled regexp (such as C returns), and any +further overloading on the return value will be ignored. + +As a special case if the overload returns the object itself then it will +be used directly. An overloaded conversion returning the object is +probably a bug, because you're likely to get something that looks like +C. + +=item * I + + "<>" + +If not overloaded, the argument will be converted to a filehandle or +glob (which may require a stringification). The same overloading +happens both for the I syntax C$varE> and +I syntax C${var}E>. + +B Even in list context, the iterator is currently called only +once and with scalar context. + +=item * I + + "-X" + +This overload is used for all the filetest operators (C<-f>, C<-x> and +so on: see L for the full list). Even though these are +unary operators, the method will be called with a second argument which +is a single letter indicating which test was performed. Note that the +overload key is the literal string C<"-X">: you can't provide separate +overloads for the different tests. + +Calling an overloaded filetest operator does not affect the stat value +associated with the special filehandle C<_>. It still refers to the +result of the last C, C or unoverloaded filetest. + +If not overloaded, these operators will fall back to the default +behaviour even without C<< fallback => 1 >>. This means that if the +object is a blessed glob or blessed IO ref it will be treated as a +filehandle, otherwise string overloading will be invoked and the result +treated as a filename. + +This overload was introduced in perl 5.12. + +=item * I + +The key C<"~~"> allows you to override the smart matching logic used by +the C<~~> operator and the switch construct (C/C). See +L and L. + +Unusually, overloading of the smart match operator does not automatically +take precedence over normal smart match behaviour. In particular, in the +following code: - "bool", "\"\"", "0+", + package Foo; + use overload '~~' => 'match'; -If one or two of these operations are unavailable, the remaining ones can -be used instead. C is used in the flow control operators -(like C) and for the ternary "C" operation. These functions can -return any arbitrary Perl value. If the corresponding operation for this value -is overloaded too, that operation will be called again with this value. + my $obj = Foo->new(); + $obj ~~ [ 1,2,3 ]; + +the smart match does I invoke the method call like this: + + $obj->match([1,2,3],0); + +rather, the smart match distributive rule takes precedence, so $obj is +smart matched against each array element in turn until a match is found, +so you may see between one and three of these calls instead: + + $obj->match(1,0); + $obj->match(2,0); + $obj->match(3,0); + +Consult the match table in L for +details of when overloading is invoked. + +=item * I + + '${}', '@{}', '%{}', '&{}', '*{}'. + +If not overloaded, the argument will be dereferenced I, thus +should be of correct type. These functions should return a reference +of correct type, or another object with overloaded dereferencing. + +As a special case if the overload returns the object itself then it +will be used directly (provided it is the correct type). + +The dereference operators must be specified explicitly they will not be passed to +"nomethod". =item * I - "nomethod", "fallback", "=", + "nomethod", "fallback", "=". see L>. =back -See L<"Fallback"> for an explanation of when a missing method can be autogenerated. +See L<"Fallback"> for an explanation of when a missing method can be +autogenerated. + +A computer-readable form of the above table is available in the hash +%overload::ops, with values being space-separated lists of names: + + with_assign => '+ - * / % ** << >> x .', + assign => '+= -= *= /= %= **= <<= >>= x= .=', + num_comparison => '< <= > >= == !=', + '3way_comparison'=> '<=> cmp', + str_comparison => 'lt le gt ge eq ne', + binary => '& &= | |= ^ ^=', + unary => 'neg ! ~', + mutators => '++ --', + func => 'atan2 cos sin exp abs log sqrt', + conversion => 'bool "" 0+ qr', + iterators => '<>', + filetest => '-X', + dereferencing => '${} @{} %{} &{} *{}', + matching => '~~', + special => 'nomethod fallback =' =head2 Inheritance and overloading @@ -328,11 +584,16 @@ the last one is used. Say, C<1-$a> can be equivalent to if the pair C<"nomethod" =E "nomethodMethod"> was specified in the C directive. +The C<"nomethod"> mechanism is I used for the dereference operators +( ${} @{} %{} &{} *{} ). + + If some operation cannot be resolved, and there is no function assigned to C<"nomethod">, then an exception will be raised via die()-- unless C<"fallback"> was specified as a key in C directive. -=head2 Fallback + +=head2 Fallback The key C<"fallback"> governs what to do if a method for a particular operation is not found. Three different cases are possible depending on @@ -356,7 +617,7 @@ present. =item * defined, but FALSE No autogeneration is tried. Perl tries to call -C<"nomethod"> value, and if this is missing, raises an exception. +C<"nomethod"> value, and if this is missing, raises an exception. =back @@ -374,18 +635,18 @@ This operation is called in the situations when a mutator is applied to a reference that shares its object with some other reference, such as - $a=$b; - $a++; + $a=$b; + ++$a; To make this change $a and not change $b, a copy of C<$$a> is made, and $a is assigned a reference to this new object. This operation is -done during execution of the C<$a++>, and not during the assignment, +done during execution of the C<++$a>, and not during the assignment, (so before the increment C<$$a> coincides with C<$$b>). This is only -done if C<++> is expressed via a method for C<'++'> or C<'+='>. Note -that if this operation is expressed via C<'+'> a nonmutator, i.e., as -in +done if C<++> is expressed via a method for C<'++'> or C<'+='> (or +C). Note that if this operation is expressed via C<'+'> +a nonmutator, i.e., as in - $a=$b; + $a=$b; $a=$a+1; then C<$a> does not reference a new copy of C<$$a>, since $$a does not @@ -393,21 +654,22 @@ appear as lvalue when the above code is executed. If the copy constructor is required during the execution of some mutator, but a method for C<'='> was not specified, it can be autogenerated as a -string copy if the object is a plain scalar. +string copy if the object is a plain scalar or a simple assignment if it +is not. =over 5 =item B -The actually executed code for +The actually executed code for - $a=$b; + $a=$b; Something else which does not modify $a or $b.... ++$a; may be - $a=$b; + $a=$b; Something else which does not modify $a or $b.... $a = $a->clone(undef,""); $a->incr(undef,""); @@ -417,6 +679,9 @@ C<'='> was overloaded with C<\&clone>. =back +Same behaviour is triggered by C<$b = $a++>, which is consider a synonym for +C<$b = $a; ++$a>. + =head1 MAGIC AUTOGENERATION If a method for an operation is not found, and the value for C<"fallback"> is @@ -431,10 +696,10 @@ substitutions are possible for the following operations: C<$a+=$b> can use the method for C<"+"> if the method for C<"+="> is not defined. -=item I +=item I -String, numeric, and boolean conversion are calculated in terms of one -another if not all of them are defined. +String, numeric, boolean and regexp conversions are calculated in terms +of one another if not all of them are defined. =item I @@ -458,7 +723,7 @@ string or numerical conversion. can be expressed in terms of string conversion. -=item I +=item I can be expressed in terms of its "spaceship" counterpart: either C=E> or C: @@ -466,14 +731,40 @@ C=E> or C: <, >, <=, >=, ==, != in terms of <=> lt, gt, le, ge, eq, ne in terms of cmp +=item I + + <> in terms of builtin operations + +=item I + + ${} @{} %{} &{} *{} in terms of builtin operations + =item I can be expressed in terms of an assignment to the dereferenced value, if this -value is a scalar and not a reference. +value is a scalar and not a reference, or simply a reference assignment +otherwise. =back -=head1 WARNING +=head1 Minimal set of overloaded operations + +Since some operations can be automatically generated from others, there is +a minimal set of operations that need to be overloaded in order to have +the complete set of overloaded operations at one's disposal. +Of course, the autogenerated operations may not do exactly what the user +expects. See L above. The minimal set is: + + + - * / % ** << >> x + <=> cmp + & | ^ ~ + atan2 cos sin exp log sqrt int + +Additionally, you need to define at least one of string, boolean or +numeric conversions because any one can be used to emulate the others. +The string conversion can also be used to emulate concatenation. + +=head1 Losing overloading The restriction for the comparison operation is that even if, for example, `C' should return a blessed reference, the autogenerated `C' @@ -510,7 +801,10 @@ Package C provides the following public functions: =item overload::StrVal(arg) -Gives string value of C as in absence of stringify overloading. +Gives string value of C as in absence of stringify overloading. If you +are using this to get the address of a reference (useful for checking if two +references point to the same thing) then you may be better off using +C, which is faster. =item overload::Overloaded(arg) @@ -522,6 +816,69 @@ Returns C or a reference to the method that implements C. =back +=head1 Overloading constants + +For some applications, the Perl parser mangles constants too much. +It is possible to hook into this process via C +and C functions. + +These functions take a hash as an argument. The recognized keys of this hash +are: + +=over 8 + +=item integer + +to overload integer constants, + +=item float + +to overload floating point constants, + +=item binary + +to overload octal and hexadecimal constants, + +=item q + +to overload C-quoted strings, constant pieces of C- and C-quoted +strings and here-documents, + +=item qr + +to overload constant pieces of regular expressions. + +=back + +The corresponding values are references to functions which take three arguments: +the first one is the I string form of the constant, the second one +is how Perl interprets this constant, the third one is how the constant is used. +Note that the initial string form does not +contain string delimiters, and has backslashes in backslash-delimiter +combinations stripped (thus the value of delimiter is not relevant for +processing of this string). The return value of this function is how this +constant is going to be interpreted by Perl. The third argument is undefined +unless for overloaded C- and C- constants, it is C in single-quote +context (comes from strings, regular expressions, and single-quote HERE +documents), it is C for arguments of C/C operators, +it is C for right-hand side of C-operator, and it is C otherwise. + +Since an expression C<"ab$cd,,"> is just a shortcut for C<'ab' . $cd . ',,'>, +it is expected that overloaded constant strings are equipped with reasonable +overloaded catenation operator, otherwise absurd results will result. +Similarly, negative numbers are considered as negations of positive constants. + +Note that it is probably meaningless to call the functions overload::constant() +and overload::remove_constant() from anywhere but import() and unimport() methods. +From these methods they may be called as + + sub import { + shift; + return unless @_; + die "unknown import: @_" unless @_ == 1 and $_[0] eq ':constant'; + overload::constant integer => sub {Math::BigInt->new(shift)}; + } + =head1 IMPLEMENTATION What follows is subject to change RSN. @@ -559,9 +916,9 @@ There is no size penalty for data if overload is not used. The only size penalty if overload is used in some package is that I the packages acquire a magic during the next Cing into the package. This magic is three-words-long for packages without -overloading, and carries the cache tabel if the package is overloaded. +overloading, and carries the cache table if the package is overloaded. -Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is +Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is carried out before any operation that can imply an assignment to the object $a (or $b) refers to, like C<$a++>. You can override this behavior by defining your own copy constructor (see L<"Copy Constructor">). @@ -569,10 +926,549 @@ behavior by defining your own copy constructor (see L<"Copy Constructor">). It is expected that arguments to methods that are not explicitly supposed to be changed are constant (but this is not enforced). +=head1 Metaphor clash + +One may wonder why the semantic of overloaded C<=> is so counter intuitive. +If it I counter intuitive to you, you are subject to a metaphor +clash. + +Here is a Perl object metaphor: + +I< object is a reference to blessed data> + +and an arithmetic metaphor: + +I< object is a thing by itself>. + +The I
problem of overloading C<=> is the fact that these metaphors +imply different actions on the assignment C<$a = $b> if $a and $b are +objects. Perl-think implies that $a becomes a reference to whatever +$b was referencing. Arithmetic-think implies that the value of "object" +$a is changed to become the value of the object $b, preserving the fact +that $a and $b are separate entities. + +The difference is not relevant in the absence of mutators. After +a Perl-way assignment an operation which mutates the data referenced by $a +would change the data referenced by $b too. Effectively, after +C<$a = $b> values of $a and $b become I. + +On the other hand, anyone who has used algebraic notation knows the +expressive power of the arithmetic metaphor. Overloading works hard +to enable this metaphor while preserving the Perlian way as far as +possible. Since it is not possible to freely mix two contradicting +metaphors, overloading allows the arithmetic way to write things I. The +way it is done is described in L. + +If some mutator methods are directly applied to the overloaded values, +one may need to I other values which references the +same value: + + $a = Data->new(23); + ... + $b = $a; # $b is "linked" to $a + ... + $a = $a->clone; # Unlink $b from $a + $a->increment_by(4); + +Note that overloaded access makes this transparent: + + $a = Data->new(23); + $b = $a; # $b is "linked" to $a + $a += 4; # would unlink $b automagically + +However, it would not make + + $a = Data->new(23); + $a = 4; # Now $a is a plain 4, not 'Data' + +preserve "objectness" of $a. But Perl I a way to make assignments +to an object do whatever you want. It is just not the overload, but +tie()ing interface (see L). Adding a FETCH() method +which returns the object itself, and STORE() method which changes the +value of the object, one can reproduce the arithmetic metaphor in its +completeness, at least for variables which were tie()d from the start. + +(Note that a workaround for a bug may be needed, see L<"BUGS">.) + +=head1 Cookbook + +Please add examples to what follows! + +=head2 Two-face scalars + +Put this in F in your Perl library directory: + + package two_face; # Scalars with separate string and + # numeric values. + sub new { my $p = shift; bless [@_], $p } + use overload '""' => \&str, '0+' => \&num, fallback => 1; + sub num {shift->[1]} + sub str {shift->[0]} + +Use it as follows: + + require two_face; + my $seven = two_face->new("vii", 7); + printf "seven=$seven, seven=%d, eight=%d\n", $seven, $seven+1; + print "seven contains `i'\n" if $seven =~ /i/; + +(The second line creates a scalar which has both a string value, and a +numeric value.) This prints: + + seven=vii, seven=7, eight=8 + seven contains `i' + +=head2 Two-face references + +Suppose you want to create an object which is accessible as both an +array reference and a hash reference. + + package two_refs; + use overload '%{}' => \&gethash, '@{}' => sub { $ {shift()} }; + sub new { + my $p = shift; + bless \ [@_], $p; + } + sub gethash { + my %h; + my $self = shift; + tie %h, ref $self, $self; + \%h; + } + + sub TIEHASH { my $p = shift; bless \ shift, $p } + my %fields; + my $i = 0; + $fields{$_} = $i++ foreach qw{zero one two three}; + sub STORE { + my $self = ${shift()}; + my $key = $fields{shift()}; + defined $key or die "Out of band access"; + $$self->[$key] = shift; + } + sub FETCH { + my $self = ${shift()}; + my $key = $fields{shift()}; + defined $key or die "Out of band access"; + $$self->[$key]; + } + +Now one can access an object using both the array and hash syntax: + + my $bar = two_refs->new(3,4,5,6); + $bar->[2] = 11; + $bar->{two} == 11 or die 'bad hash fetch'; + +Note several important features of this example. First of all, the +I type of $bar is a scalar reference, and we do not overload +the scalar dereference. Thus we can get the I non-overloaded +contents of $bar by just using C<$$bar> (what we do in functions which +overload dereference). Similarly, the object returned by the +TIEHASH() method is a scalar reference. + +Second, we create a new tied hash each time the hash syntax is used. +This allows us not to worry about a possibility of a reference loop, +which would lead to a memory leak. + +Both these problems can be cured. Say, if we want to overload hash +dereference on a reference to an object which is I as a +hash itself, the only problem one has to circumvent is how to access +this I hash (as opposed to the I hash exhibited by the +overloaded dereference operator). Here is one possible fetching routine: + + sub access_hash { + my ($self, $key) = (shift, shift); + my $class = ref $self; + bless $self, 'overload::dummy'; # Disable overloading of %{} + my $out = $self->{$key}; + bless $self, $class; # Restore overloading + $out; + } + +To remove creation of the tied hash on each access, one may an extra +level of indirection which allows a non-circular structure of references: + + package two_refs1; + use overload '%{}' => sub { ${shift()}->[1] }, + '@{}' => sub { ${shift()}->[0] }; + sub new { + my $p = shift; + my $a = [@_]; + my %h; + tie %h, $p, $a; + bless \ [$a, \%h], $p; + } + sub gethash { + my %h; + my $self = shift; + tie %h, ref $self, $self; + \%h; + } + + sub TIEHASH { my $p = shift; bless \ shift, $p } + my %fields; + my $i = 0; + $fields{$_} = $i++ foreach qw{zero one two three}; + sub STORE { + my $a = ${shift()}; + my $key = $fields{shift()}; + defined $key or die "Out of band access"; + $a->[$key] = shift; + } + sub FETCH { + my $a = ${shift()}; + my $key = $fields{shift()}; + defined $key or die "Out of band access"; + $a->[$key]; + } + +Now if $baz is overloaded like this, then C<$baz> is a reference to a +reference to the intermediate array, which keeps a reference to an +actual array, and the access hash. The tie()ing object for the access +hash is a reference to a reference to the actual array, so + +=over + +=item * + +There are no loops of references. + +=item * + +Both "objects" which are blessed into the class C are +references to a reference to an array, thus references to a I. +Thus the accessor expression C<$$foo-E[$ind]> involves no +overloaded operations. + +=back + +=head2 Symbolic calculator + +Put this in F in your Perl library directory: + + package symbolic; # Primitive symbolic calculator + use overload nomethod => \&wrap; + + sub new { shift; bless ['n', @_] } + sub wrap { + my ($obj, $other, $inv, $meth) = @_; + ($obj, $other) = ($other, $obj) if $inv; + bless [$meth, $obj, $other]; + } + +This module is very unusual as overloaded modules go: it does not +provide any usual overloaded operators, instead it provides the L operator C. In this example the corresponding +subroutine returns an object which encapsulates operations done over +the objects: C<< symbolic->new(3) >> contains C<['n', 3]>, C<< 2 + +symbolic->new(3) >> contains C<['+', 2, ['n', 3]]>. + +Here is an example of the script which "calculates" the side of +circumscribed octagon using the above package: + + require symbolic; + my $iter = 1; # 2**($iter+2) = 8 + my $side = symbolic->new(1); + my $cnt = $iter; + + while ($cnt--) { + $side = (sqrt(1 + $side**2) - 1)/$side; + } + print "OK\n"; + +The value of $side is + + ['/', ['-', ['sqrt', ['+', 1, ['**', ['n', 1], 2]], + undef], 1], ['n', 1]] + +Note that while we obtained this value using a nice little script, +there is no simple way to I this value. In fact this value may +be inspected in debugger (see L), but only if +C Bption is set, and not via C

command. + +If one attempts to print this value, then the overloaded operator +C<""> will be called, which will call C operator. The +result of this operator will be stringified again, but this result is +again of type C, which will lead to an infinite loop. + +Add a pretty-printer method to the module F: + + sub pretty { + my ($meth, $a, $b) = @{+shift}; + $a = 'u' unless defined $a; + $b = 'u' unless defined $b; + $a = $a->pretty if ref $a; + $b = $b->pretty if ref $b; + "[$meth $a $b]"; + } + +Now one can finish the script by + + print "side = ", $side->pretty, "\n"; + +The method C is doing object-to-string conversion, so it +is natural to overload the operator C<""> using this method. However, +inside such a method it is not necessary to pretty-print the +I $a and $b of an object. In the above subroutine +C<"[$meth $a $b]"> is a catenation of some strings and components $a +and $b. If these components use overloading, the catenation operator +will look for an overloaded operator C<.>; if not present, it will +look for an overloaded operator C<"">. Thus it is enough to use + + use overload nomethod => \&wrap, '""' => \&str; + sub str { + my ($meth, $a, $b) = @{+shift}; + $a = 'u' unless defined $a; + $b = 'u' unless defined $b; + "[$meth $a $b]"; + } + +Now one can change the last line of the script to + + print "side = $side\n"; + +which outputs + + side = [/ [- [sqrt [+ 1 [** [n 1 u] 2]] u] 1] [n 1 u]] + +and one can inspect the value in debugger using all the possible +methods. + +Something is still amiss: consider the loop variable $cnt of the +script. It was a number, not an object. We cannot make this value of +type C, since then the loop will not terminate. + +Indeed, to terminate the cycle, the $cnt should become false. +However, the operator C for checking falsity is overloaded (this +time via overloaded C<"">), and returns a long string, thus any object +of type C is true. To overcome this, we need a way to +compare an object to 0. In fact, it is easier to write a numeric +conversion routine. + +Here is the text of F with such a routine added (and +slightly modified str()): + + package symbolic; # Primitive symbolic calculator + use overload + nomethod => \&wrap, '""' => \&str, '0+' => \# + + sub new { shift; bless ['n', @_] } + sub wrap { + my ($obj, $other, $inv, $meth) = @_; + ($obj, $other) = ($other, $obj) if $inv; + bless [$meth, $obj, $other]; + } + sub str { + my ($meth, $a, $b) = @{+shift}; + $a = 'u' unless defined $a; + if (defined $b) { + "[$meth $a $b]"; + } else { + "[$meth $a]"; + } + } + my %subr = ( n => sub {$_[0]}, + sqrt => sub {sqrt $_[0]}, + '-' => sub {shift() - shift()}, + '+' => sub {shift() + shift()}, + '/' => sub {shift() / shift()}, + '*' => sub {shift() * shift()}, + '**' => sub {shift() ** shift()}, + ); + sub num { + my ($meth, $a, $b) = @{+shift}; + my $subr = $subr{$meth} + or die "Do not know how to ($meth) in symbolic"; + $a = $a->num if ref $a eq __PACKAGE__; + $b = $b->num if ref $b eq __PACKAGE__; + $subr->($a,$b); + } + +All the work of numeric conversion is done in %subr and num(). Of +course, %subr is not complete, it contains only operators used in the +example below. Here is the extra-credit question: why do we need an +explicit recursion in num()? (Answer is at the end of this section.) + +Use this module like this: + + require symbolic; + my $iter = symbolic->new(2); # 16-gon + my $side = symbolic->new(1); + my $cnt = $iter; + + while ($cnt) { + $cnt = $cnt - 1; # Mutator `--' not implemented + $side = (sqrt(1 + $side**2) - 1)/$side; + } + printf "%s=%f\n", $side, $side; + printf "pi=%f\n", $side*(2**($iter+2)); + +It prints (without so many line breaks) + + [/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] + [n 1]] 2]]] 1] + [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]=0.198912 + pi=3.182598 + +The above module is very primitive. It does not implement +mutator methods (C<++>, C<-=> and so on), does not do deep copying +(not required without mutators!), and implements only those arithmetic +operations which are used in the example. + +To implement most arithmetic operations is easy; one should just use +the tables of operations, and change the code which fills %subr to + + my %subr = ( 'n' => sub {$_[0]} ); + foreach my $op (split " ", $overload::ops{with_assign}) { + $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}"; + } + my @bins = qw(binary 3way_comparison num_comparison str_comparison); + foreach my $op (split " ", "@overload::ops{ @bins }") { + $subr{$op} = eval "sub {shift() $op shift()}"; + } + foreach my $op (split " ", "@overload::ops{qw(unary func)}") { + print "defining `$op'\n"; + $subr{$op} = eval "sub {$op shift()}"; + } + +Due to L, we do not need anything +special to make C<+=> and friends work, except filling C<+=> entry of +%subr, and defining a copy constructor (needed since Perl has no +way to know that the implementation of C<'+='> does not mutate +the argument, compare L). + +To implement a copy constructor, add C<< '=' => \&cpy >> to C +line, and code (this code assumes that mutators change things one level +deep only, so recursive copying is not needed): + + sub cpy { + my $self = shift; + bless [@$self], ref $self; + } + +To make C<++> and C<--> work, we need to implement actual mutators, +either directly, or in C. We continue to do things inside +C, thus add + + if ($meth eq '++' or $meth eq '--') { + @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference + return $obj; + } + +after the first line of wrap(). This is not a most effective +implementation, one may consider + + sub inc { $_[0] = bless ['++', shift, 1]; } + +instead. + +As a final remark, note that one can fill %subr by + + my %subr = ( 'n' => sub {$_[0]} ); + foreach my $op (split " ", $overload::ops{with_assign}) { + $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}"; + } + my @bins = qw(binary 3way_comparison num_comparison str_comparison); + foreach my $op (split " ", "@overload::ops{ @bins }") { + $subr{$op} = eval "sub {shift() $op shift()}"; + } + foreach my $op (split " ", "@overload::ops{qw(unary func)}") { + $subr{$op} = eval "sub {$op shift()}"; + } + $subr{'++'} = $subr{'+'}; + $subr{'--'} = $subr{'-'}; + +This finishes implementation of a primitive symbolic calculator in +50 lines of Perl code. Since the numeric values of subexpressions +are not cached, the calculator is very slow. + +Here is the answer for the exercise: In the case of str(), we need no +explicit recursion since the overloaded C<.>-operator will fall back +to an existing overloaded operator C<"">. Overloaded arithmetic +operators I fall back to numeric conversion if C is +not explicitly requested. Thus without an explicit recursion num() +would convert C<['+', $a, $b]> to C<$a + $b>, which would just rebuild +the argument of num(). + +If you wonder why defaults for conversion are different for str() and +num(), note how easy it was to write the symbolic calculator. This +simplicity is due to an appropriate choice of defaults. One extra +note: due to the explicit recursion num() is more fragile than sym(): +we need to explicitly check for the type of $a and $b. If components +$a and $b happen to be of some related type, this may lead to problems. + +=head2 I symbolic calculator + +One may wonder why we call the above calculator symbolic. The reason +is that the actual calculation of the value of expression is postponed +until the value is I. + +To see it in action, add a method + + sub STORE { + my $obj = shift; + $#$obj = 1; + @$obj->[0,1] = ('=', shift); + } + +to the package C. After this change one can do + + my $a = symbolic->new(3); + my $b = symbolic->new(4); + my $c = sqrt($a**2 + $b**2); + +and the numeric value of $c becomes 5. However, after calling + + $a->STORE(12); $b->STORE(5); + +the numeric value of $c becomes 13. There is no doubt now that the module +symbolic provides a I calculator indeed. + +To hide the rough edges under the hood, provide a tie()d interface to the +package C (compare with L). Add methods + + sub TIESCALAR { my $pack = shift; $pack->new(@_) } + sub FETCH { shift } + sub nop { } # Around a bug + +(the bug is described in L<"BUGS">). One can use this new interface as + + tie $a, 'symbolic', 3; + tie $b, 'symbolic', 4; + $a->nop; $b->nop; # Around a bug + + my $c = sqrt($a**2 + $b**2); + +Now numeric value of $c is 5. After C<$a = 12; $b = 5> the numeric value +of $c becomes 13. To insulate the user of the module add a method + + sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; } + +Now + + my ($a, $b); + symbolic->vars($a, $b); + my $c = sqrt($a**2 + $b**2); + + $a = 3; $b = 4; + printf "c5 %s=%f\n", $c, $c; + + $a = 12; $b = 5; + printf "c13 %s=%f\n", $c, $c; + +shows that the numeric value of $c follows changes to the values of $a +and $b. + =head1 AUTHOR Ilya Zakharevich EFE. +=head1 SEE ALSO + +The L pragma can be used to enable or disable overloaded +operations within a lexical scope. + =head1 DIAGNOSTICS When Perl is run with the B<-Do> switch or its equivalent, overloading @@ -584,7 +1480,28 @@ this overloading). Say, if C is overloaded, then the method C<(eq> is shown by debugger. The method C<()> corresponds to the C key (in fact a presence of this method shows that this package has overloading enabled, and it is what is used by the C -function). +function of module C). + +The module might issue the following warnings: + +=over 4 + +=item Odd number of arguments for overload::constant + +(W) The call to overload::constant contained an odd number of arguments. +The arguments should come in pairs. + +=item `%s' is not an overloadable type + +(W) You tried to overload a constant type the overload package is unaware of. + +=item `%s' is not a code reference + +(W) The second (fourth, sixth, ...) argument of overload::constant needs +to be a code reference. Either an anonymous subroutine, or a reference +to a subroutine. + +=back =head1 BUGS @@ -597,7 +1514,21 @@ C is present (possibly undefined). This may create interesting effects if some package is not overloaded, but inherits from two overloaded packages. -This document is confusing. +Relation between overloading and tie()ing is broken. Overloading is +triggered or not basing on the I class of tie()d value. + +This happens because the presence of overloading is checked too early, +before any tie()d access is attempted. If the FETCH()ed class of the +tie()d value does not change, a simple workaround is to access the value +immediately after tie()ing, so that after this call the I class +coincides with the current one. + +B a way to fix this without a speed penalty. + +Barewords are not covered by overloaded string constants. + +This document is confusing. There are grammos and misleading language +used in places. It would seem a total rewrite is needed. =cut