内容

名称

overload - 用于重载 Perl 操作的包

概要

package SomeThing;

use overload
    '+' => \&myadd,
    '-' => \&mysub;
    # etc
...

package main;
$a = SomeThing->new( 57 );
$b = 5 + $a;
...
if (overload::Overloaded $b) {...}
...
$strval = overload::StrVal $b;

描述

此 pragma 允许为类重载 Perl 的操作符。要重载内置函数，请参阅 "perlsub 中的重写内置函数"。

基础

声明

use overload 指令的参数是 (键，值) 对。有关所有合法键的完整列表，请参阅下面的 "可重载操作"。

操作符实现（值）可以是子程序、子程序引用或匿名子程序 - 换句话说，任何在 &{ ... } 调用中合法的代码。指定为字符串的值被解释为方法名。因此

package Number;
use overload
    "-" => "minus",
    "*=" => \&muas,
    '""' => sub { ...; };

声明减法将由 Number 类（或其基类之一）中的 minus() 方法实现，并且 Number::muas() 函数将用于乘法的赋值形式 *=。它还定义了一个匿名子程序来实现字符串化：每当将一个祝福到 Number 包中的对象用于字符串上下文时，就会调用它（例如，此子程序可以将数字作为罗马数字返回）。

调用约定和魔法自动生成

以下 minus() 的示例实现（假设 Number 对象只是对标量的祝福引用）说明了调用约定

package Number;
sub minus {
    my ($self, $other, $swap) = @_;
    my $result = $$self - $other;         # *
    $result = -$result if $swap;
    ref $result ? $result : bless \$result;
}
# * may recurse once - see table below

在 use overload 指令中指定的所有子程序中传递三个参数（有例外 - 请参见下文，特别是 "nomethod"）。

第一个参数是提供重载操作符实现的操作数 - 在这种情况下，是调用其 minus() 方法的对象。

第二个参数是另一个操作数，或者在单目操作符的情况下为 undef。

第三个参数在两个操作数被交换的情况下（且仅在这种情况下）设置为 TRUE。Perl 可能会这样做以确保第一个参数（$self）是实现重载操作的对象，这与一般的对象调用约定一致。例如，如果 $x 和 $y 是 Number

operation   |   generates a call to
============|======================
$x - $y     |   minus($x, $y, '')
$x - 7      |   minus($x, 7, '')
7 - $x      |   minus($x, 7, 1)

Perl 还可以使用 minus() 来实现 use overload 指令中未指定的其他操作符，根据后面描述的 "魔法自动生成" 规则。例如，上面的 use overload 没有为任何操作符 --、neg（单目减法的重载键）或 -= 声明任何子程序。因此

operation   |   generates a call to
============|======================
-$x         |   minus($x, 0, 1)
$x--        |   minus($x, 1, undef)
$x -= 3     |   minus($x, 3, undef)

注意 undef：当自动生成导致使用不改变其任何操作数的标准操作符的方法来实现改变操作数的操作符（“变异器”：这里，-- 和 -=）时，Perl 将 undef 作为第三个参数传递。这仍然评估为 FALSE，与操作数未被交换的事实一致，但它给了子程序一个机会在这些情况下改变其行为。

在以上所有示例中，minus() 只需要返回减法的结果：Perl 会负责将结果赋值给 $x。实际上，此类方法不应该修改其操作数，即使 undef 被作为第三个参数传递（请参见 "可重载操作"）。

++ 和 -- 的实现并非如此：它们应该修改其操作数。-- 的适当实现可能如下所示

use overload '--' => "decr",
    # ...
sub decr { --${$_[0]}; }

如果启用了“按位”功能（参见 feature），则会将第五个 TRUE 参数传递给处理 &、|、^ 和 ~ 的子例程。这表示调用方期望数值行为。第四个参数将为 undef，因为该位置 ($_[3]) 预留给 "nomethod" 使用。

数学魔术、变异器和复制构造函数

术语“数学魔术”描述了数学运算符的重载实现。数学魔术运算会引发一个问题。考虑以下代码

$a = $b;
--$a;

如果 $a 和 $b 是标量，那么在执行这些语句后

$a == $b - 1

但是，对象是对祝福数据的引用，因此如果 $a 和 $b 是对象，那么赋值 $a = $b 仅复制引用，使 $a 和 $b 引用相同对象数据。因此，人们可能会期望操作 --$a 也会递减 $b 以及 $a。但是，这与我们期望数学运算符的工作方式不一致。

Perl 通过在调用定义为实现变异器 (--、+= 等) 的方法之前透明地调用复制构造函数来解决此困境。在上面的示例中，当 Perl 遇到递减语句时，它会复制 $a 中的对象数据，并将对复制数据的引用分配给 $a。只有这样，它才会调用 decr()，该方法会更改复制的数据，使 $b 保持不变。因此，对象隐喻尽可能地保留，而数学魔术运算仍然根据算术隐喻工作。

注意：前一段描述了当 Perl 根据标量自动生成对象的复制构造函数时会发生什么。对于其他情况，请参见 "复制构造函数"。

可重载运算

可以在 use overload 指令中指定的键的完整列表在哈希 %overload::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 =',

大多数可重载运算符与这些键一一对应。例外情况（包括此哈希中没有显示的额外可重载运算）包含在后面的注释中。此列表会随着时间的推移而增长。

如果尝试注册上面未找到的运算符，则会发出警告。

魔法自动生成

如果找不到操作的方法，Perl 会尝试从已定义的操作中自动生成替代实现。

注意：本节中描述的行为可以通过将 fallback 设置为 FALSE 来禁用（参见 "fallback"）。

在下表中，数字表示优先级。例如，下表说明，如果未定义 '!' 的实现，则 Perl 将使用 'bool' 来实现它（即，通过反转 'bool' 方法返回的值）；如果布尔转换也未实现，则 Perl 将使用 '0+'，或者如果失败，则使用 '""'。

operator | can be autogenerated from
         |
         | 0+   ""   bool   .   x
=========|==========================
   0+    |       1     2
   ""    |  1          2
   bool  |  1    2
   int   |  1    2     3
   !     |  2    3     1
   qr    |  2    1     3
   .     |  2    1     3
   x     |  2    1     3
   .=    |  3    2     4    1
   x=    |  3    2     4        1
   <>    |  2    1     3
   -X    |  2    1     3

注意：迭代器 ('<>') 和文件测试 ('-X') 运算符按正常方式工作：如果操作数不是已祝福的 glob 或 IO 引用，则将其转换为字符串（使用 '""'、'0+' 或 'bool' 的方法）以解释为 glob 或文件名。

operator | can be autogenerated from
         |
         |  <   <=>   neg   -=    -
=========|==========================
   neg   |                        1
   -=    |                        1
   --    |                   1    2
   abs   | a1    a2    b1        b2    [*]
   <     |        1
   <=    |        1
   >     |        1
   >=    |        1
   ==    |        1
   !=    |        1

* one from [a1, a2] and one from [b1, b2]

正如数值比较可以从 '<=>' 的方法自动生成一样，字符串比较可以从 'cmp' 的方法自动生成。

 operators          |  can be autogenerated from
====================|===========================
 lt gt le ge eq ne  |  cmp

类似地，'+=' 和 '++' 键的自动生成类似于上面的 '-=' 和 '--'

operator | can be autogenerated from
         |
         |  +=    +
=========|==========================
    +=   |        1
    ++   |   1    2

其他赋值变体类似于 '+=' 和 '-='（类似于上面的 '.=' 和 'x='）

          operator ||  *= /= %= **= <<= >>= &= ^= |= &.= ^.= |.=
-------------------||-------------------------------------------
autogenerated from ||  *  /  %  **  <<  >>  &  ^  |  &.  ^.  |.

还要注意，复制构造函数（键 '='）可能会自动生成，但仅适用于基于标量的对象。参见 "复制构造函数"。

最小重载操作集

由于某些操作可以从其他操作自动生成，因此需要重载一组最小的操作，以便可以使用完整的重载操作集。当然，自动生成的运算符可能无法完全按照用户的预期执行。最小集是

+ - * / % ** << >> x
<=> cmp
& | ^ ~ &. |. ^. ~.
atan2 cos sin exp log sqrt int
"" 0+ bool
~~

在转换中，只需要字符串、布尔值或数值中的一个，因为每个都可以从另外两个生成。

use overload 的特殊键

nomethod

'nomethod' 键用于指定一个通用的函数，用于处理任何未单独重载的操作符。指定的函数将传递四个参数。前三个参数与如果定义了相应方法将传递给该方法的参数一致。第四个参数是该缺失方法的 use overload 键。如果启用了“按位”功能（参见 feature），则将向处理 &、|、^ 和 ~ 的子例程传递第五个 TRUE 参数，以指示调用者期望数值行为。

例如，如果 $a 是一个被祝福到声明以下内容的包中的对象

use overload 'nomethod' => 'catch_all', # ...

那么操作

3 + $a

可能（除非为 '+' 键专门声明了一个方法）导致调用

catch_all($a, 3, 1, '+')

参见 "Perl 如何选择操作符实现"。

fallback

分配给 'fallback' 键的值告诉 Perl 它应该尝试多努力才能找到实现缺失操作符的替代方法。

参见 "Perl 如何选择操作符实现"。

复制构造函数

如 上面 所述，当对与其他引用共享其对象的引用应用变异器时，将调用此操作。例如，如果 $b 是数学魔法的，'++' 被重载为 'incr'，'=' 被重载为 'clone'，那么代码

$a = $b;
# ... (other code which does not modify $a or $b) ...
++$b;

将以等效于以下方式执行

$a = $b;
# ...
$b = $b->clone(undef, "");
$b->incr(undef, "");

注意

Perl 如何选择运算符实现

首先检查 nomethod 还是 fallback？如果运算符的两个操作数类型不同，并且都重载了运算符，则使用哪个实现？以下是优先级规则

  1. 如果第一个操作数声明了一个子例程来重载运算符，则使用该实现。

  2. 否则，如果第一个操作数的 fallback 为 TRUE 或未定义，则查看 自动生成规则 是否允许使用其其他运算符。

  3. 除非运算符是赋值（+=、-= 等），否则重复步骤 (1) 以考虑第二个操作数。

  4. 重复步骤 (2) 以考虑第二个操作数。

  5. 如果第一个操作数具有 "nomethod" 方法，则使用该方法。

  6. 如果第二个操作数具有 "nomethod" 方法，则使用该方法。

  7. 如果两个操作数的 fallback 都为 TRUE，则对运算符执行通常的操作，将操作数视为数字、字符串或布尔值，具体取决于运算符（参见注释）。

  8. 什么都没用 - 退出。

如果只有一个操作数（或只有一个操作数具有重载），则跳过上述关于另一个操作数的检查。

对于解引用操作，上述规则存在例外（如果步骤 1 失败，则始终回退到正常的内置实现 - 请参阅解引用），以及对于 ~~（它有自己的规则集 - 请参阅 "可重载操作" 上面的“匹配”）。

关于步骤 7 的说明：一些运算符根据其操作数的类型具有不同的语义。由于没有办法指示 Perl 将操作数视为例如数字而不是字符串，因此这里的结果可能不是您预期的。请参阅 "错误和陷阱"。

失去重载

比较操作的限制是，即使例如 cmp 应该返回一个祝福的引用，自动生成的 lt 函数也将仅基于 cmp 结果的数值产生一个标准的逻辑值。特别是在这种情况下，需要一个有效的数值转换（可能用其他转换表示）。

类似地，.= 和 x= 运算符如果应用了字符串转换替换，则会失去其数学特性。

当您对一个数学对象进行 chop() 操作时，它会被提升为字符串，并且其数学特性会丢失。其他操作也可能发生这种情况。

继承和重载

重载通过 @ISA 层次结构尊重继承。继承以两种方式与重载交互。

use overload 指令中的方法名称

如果

use overload key => value;

中的 value 是一个字符串，它将被解释为一个方法名称 - 该名称可能（以通常的方式）从另一个类继承。

操作的重载由派生类继承

从重载类派生的任何类也被重载并继承其运算符实现。如果在多个祖先中重载了相同的运算符，则实现由通常的继承规则确定。

例如，如果 A 从 B 和 C（按此顺序）继承，B 用 \&D::plus_sub 重载 +，而 C 用 "plus_meth" 重载 +，那么子例程 D::plus_sub 将被调用来实现包 A 中对象的运算 +。

请注意，在 Perl 5.18 之前的版本中，fallback 键的继承不受上述规则的约束。第一个重载祖先中的 fallback 值被使用。这在 5.18 中得到修复，以遵循通常的继承规则。

运行时重载

由于所有 use 指令都在编译时执行，因此在运行时更改重载的唯一方法是

eval 'use overload "+" => \&addmethod';

您也可以使用

eval 'no overload "+", "--", "<="';

尽管在运行时使用这些结构值得怀疑。

公共函数

包 overload.pm 提供以下公共函数

overload::StrVal(arg)

返回 arg 的字符串值，如同没有字符串化重载一样。如果您使用此函数来获取引用的地址（用于检查两个引用是否指向同一对象），那么您最好使用 builtin::refaddr() 或 Scalar::Util::refaddr()，它们更快。

overload::Overloaded(arg)

如果 arg 受到某些操作的重载，则返回 true。

overload::Method(obj,op)

返回 undef 或实现 op 的方法的引用。

这样的方法总是接受三个参数，如果它是 XS 方法，则会强制执行。

重载常量

对于某些应用程序，Perl 解析器对常量的处理过于复杂。可以通过 overload::constant() 和 overload::remove_constant() 函数来介入此过程。

这些函数接受一个哈希作为参数。此哈希的识别键是

integer

用于重载整数常量，

float

用于重载浮点数常量，

binary

用于重载八进制和十六进制常量，

q

用于重载 q 引用的字符串、qq 和 qx 引用的字符串的常量部分以及 here-document，

qr

用于重载正则表达式的常量部分。

相应的数值是函数的引用，这些函数接受三个参数：第一个是常量的初始字符串形式，第二个是 Perl 如何解释该常量，第三个是常量的使用方式。请注意，初始字符串形式不包含字符串分隔符，并且在反斜杠分隔符组合中去除了反斜杠（因此分隔符的值与该字符串的处理无关）。该函数的返回值是 Perl 如何解释该常量。第三个参数除非是重载的q- 和 qr- 常量，否则未定义，在单引号上下文中为 q（来自字符串、正则表达式和单引号 HERE 文档），对于 tr/y 运算符的参数为 tr，对于 s 运算符的右侧为 s，否则为 qq。

由于表达式 "ab$cd,," 只是 'ab' . $cd . ',,' 的快捷方式，因此期望重载的常量字符串配备合理的重载连接运算符，否则会导致荒谬的结果。类似地，负数被视为正常量的否定。

请注意，从除 import() 和 unimport() 方法之外的任何地方调用函数 overload::constant() 和 overload::remove_constant() 可能毫无意义。从这些方法中，它们可以被调用为

sub import {
    shift;
    return unless @_;
    die "unknown import: @_" unless @_ == 1 and $_[0] eq ':constant';
    overload::constant integer => sub {Math::BigInt->new(shift)};
}

实现

以下内容可能会随时更改。

所有操作的方法表缓存在包的符号表哈希的魔术中。在处理 use overload、no overload、新的函数定义以及 @ISA 中的更改时，缓存将失效。

（每个 SVish 东西都有一个魔术队列，魔术是该队列中的一个条目。这就是单个变量可以同时参与多种魔术形式的方式。例如，环境变量通常同时具有两种形式：它们的 %ENV 魔术和它们的污染魔术。但是，实现重载的魔术应用于存储区，存储区很少直接使用，因此不应该减慢 Perl 的速度。）

如果一个包使用重载，它会携带一个特殊的标志。当定义新函数或修改 @ISA 时，也会设置此标志。在支持重载的第一个操作之后，会有一点速度损失，因为此时重载表正在更新。如果不存在重载，则会关闭此标志。因此，此后唯一的速度损失是检查此标志。

预期对不应显式更改的方法的参数是常量（但不会强制执行）。

食谱

请在以下内容中添加示例！

双面标量

将此代码放在 Perl 库目录中的 two_face.pm 文件中

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]}

使用方法如下

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

（第二行创建了一个标量，它同时具有字符串值和数值。）这将打印

seven=vii, seven=7, eight=8
seven contains 'i'

双面引用

假设您想创建一个既可以作为数组引用，也可以作为哈希引用的对象。

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

现在可以使用数组和哈希语法访问对象

my $bar = two_refs->new(3,4,5,6);
$bar->[2] = 11;
$bar->{two} == 11 or die 'bad hash fetch';

请注意此示例的几个重要特征。首先，$bar 的实际类型是标量引用，我们没有重载标量解引用。因此，我们可以通过使用 $$bar（我们在重载解引用函数中所做的事情）来获取 $bar 的实际非重载内容。类似地，TIEHASH() 方法返回的对象是标量引用。

其次，每次使用哈希语法时，我们都会创建一个新的绑定哈希。这使我们不必担心出现引用循环的可能性，这会导致内存泄漏。

这两个问题都可以解决。例如，如果我们想在对实现为哈希本身的对象的引用上重载哈希解引用，唯一需要解决的问题是如何访问这个实际哈希（与虚拟哈希不同，虚拟哈希由重载的解引用运算符展示）。以下是一个可能的获取例程

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

为了避免在每次访问时创建绑定哈希，可以使用额外的间接级别，这允许非循环的引用结构

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

现在如果 $baz 被重载成这样，那么 $baz 就是对中间数组的引用的引用，该数组保存对实际数组和访问哈希的引用。访问哈希的 tie() 对象是对实际数组的引用的引用，所以

符号计算器

将此代码放入 Perl 库目录中的 symbolic.pm 文件中

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

这个模块非常不寻常，因为它没有提供任何常见的重载运算符，而是为 "nomethod" 提供了实现。在这个例子中，nomethod 子例程返回一个对象，该对象封装了对对象执行的操作：symbolic->new(3) 包含 ['n', 3]，2 + symbolic->new(3) 包含 ['+', 2, ['n', 3]]。

以下是一个使用上述包“计算”外接八边形边长的脚本示例

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

$side 的值为

['/', ['-', ['sqrt', ['+', 1, ['**', ['n', 1], 2]],
                    undef], 1], ['n', 1]]

请注意，虽然我们使用了一个简单的脚本获得了这个值，但没有简单的方法可以使用这个值。事实上，这个值可以在调试器中检查（参见 perldebug），但前提是设置了 bareStringify Option，而不是通过 p 命令。

如果尝试打印这个值，那么重载运算符 "" 将被调用，这将调用 nomethod 运算符。这个运算符的结果将再次被字符串化，但这个结果又是 symbolic 类型，这将导致无限循环。

在 symbolic.pm 模块中添加一个漂亮打印方法

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]";
}

现在可以使用以下代码完成脚本

print "side = ", $side->pretty, "\n";

pretty 方法执行对象到字符串的转换，因此使用此方法重载运算符 "" 是自然的。但是，在这样的方法内部，没有必要对对象的组件 $a 和 $b 进行漂亮打印。在上面的子例程中，"[$meth $a $b]" 是某些字符串和组件 $a 和 $b 的连接。如果这些组件使用重载，连接运算符将查找重载运算符 .；如果不存在，它将查找重载运算符 ""。因此，使用以下代码就足够了

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]";
}

现在可以将脚本的最后一行更改为

print "side = $side\n";

这将输出

side = [/ [- [sqrt [+ 1 [** [n 1 u] 2]] u] 1] [n 1 u]]

并且可以使用所有可能的方法在调试器中检查该值。

仍然存在一些问题：考虑脚本的循环变量 $cnt。它是一个数字，而不是一个对象。我们不能将这个值设置为 symbolic 类型，因为这样循环将不会终止。

确实，要终止循环，$cnt 应该变为假。但是，用于检查假值的运算符 bool 被重载（这次通过重载的 ""），并返回一个长字符串，因此任何类型为 symbolic 的对象都是真值。为了克服这个问题，我们需要一种方法来比较对象与 0。事实上，编写一个数值转换例程更容易。

以下是添加了此类例程（并略微修改了 str()）的 symbolic.pm 文本。

package symbolic;           # Primitive symbolic calculator
use overload
    nomethod => \&wrap, '""' => \&str, '0+' => \&num;

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

所有数值转换的工作都在 %subr 和 num() 中完成。当然，%subr 并不完整，它只包含下面示例中使用的运算符。这是一个额外的积分问题：为什么我们需要在 num() 中显式递归？（答案在本节末尾。）

像这样使用此模块

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

它打印（没有那么多换行符）

[/ [- [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

上面的模块非常原始。它没有实现 mutator 方法（++、-= 等），没有进行深层复制（没有 mutator 不需要！），并且只实现了示例中使用的算术运算。

实现大多数算术运算很容易；只需使用运算表，并将填充 %subr 的代码更改为

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()}";
}

由于实现赋值运算符的子例程不需要修改其操作数（见上面 "可重载运算"），因此除了将这些运算符添加到 %subr 并定义一个复制构造函数（因为 Perl 没有办法知道 '+=' 的实现不会改变参数 - 见 "复制构造函数"）之外，我们不需要任何特殊的东西来使 += 及其朋友工作。

要实现复制构造函数，请将 '=' => \&cpy 添加到 use overload 行，以及代码（此代码假设 mutator 只改变一层深度的内容，因此不需要递归复制）

sub cpy {
    my $self = shift;
    bless [@$self], ref $self;
}

要使 ++ 和 -- 工作，我们需要实现实际的 mutator，无论是直接实现，还是在 nomethod 中实现。我们继续在 nomethod 中做事情，因此添加

if ($meth eq '++' or $meth eq '--') {
    @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
    return $obj;
}

在 wrap() 的第一行之后。这不是最有效的实现，可以考虑

sub inc { $_[0] = bless ['++', shift, 1]; }

代替。

最后，请注意，可以通过以下方式填充 %subr：

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{'-'};

这段代码用 50 行 Perl 代码实现了简单的符号计算器。由于子表达式的数值没有被缓存，所以计算器速度很慢。

以下是练习的答案：在 str() 的情况下，我们不需要显式递归，因为重载的 . 运算符将回退到现有的重载运算符 ""。如果未显式请求 fallback，则重载的算术运算符 *不会* 回退到数值转换。因此，如果没有显式递归，num() 将把 ['+', $a, $b] 转换为 $a + $b，这将只是重新构建 num() 的参数。

如果您想知道为什么 str() 和 num() 的转换默认值不同，请注意编写符号计算器是多么容易。这种简单性是由于对默认值的适当选择。另外一点：由于显式递归，num() 比 sym() 更脆弱：我们需要显式检查 $a 和 $b 的类型。如果组件 $a 和 $b 碰巧是某种相关类型，这可能会导致问题。

真正的 符号计算器

人们可能会想知道为什么我们将上面的计算器称为符号计算器。原因是表达式值的实际计算被推迟到该值被 *使用* 时。

要查看它的实际效果，请向 symbolic 包添加一个方法

sub STORE {
    my $obj = shift;
    $#$obj = 1;
    @$obj->[0,1] = ('=', shift);
}

更改后，您可以执行

my $a = symbolic->new(3);
my $b = symbolic->new(4);
my $c = sqrt($a**2 + $b**2);

此时 $c 的数值变为 5。但是，在调用

$a->STORE(12);  $b->STORE(5);

之后，$c 的数值变为 13。现在毫无疑问，symbolic 模块确实提供了一个 *符号* 计算器。

为了隐藏底层代码的粗糙边缘，请为 symbolic 包提供一个 tie()d 接口。添加方法

sub TIESCALAR { my $pack = shift; $pack->new(@_) }
sub FETCH { shift }
sub nop {  }                # Around a bug

（Perl 5.14 中修复了这个错误，在 "BUGS" 中有描述）。您可以使用这个新接口，例如

tie $a, 'symbolic', 3;
tie $b, 'symbolic', 4;
$a->nop;  $b->nop;          # Around a bug

my $c = sqrt($a**2 + $b**2);

现在 $c 的数值为 5。在 $a = 12; $b = 5 之后，$c 的数值变为 13。为了隔离模块的用户，请添加一个方法

sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }

现在

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;

显示 $c 的数值会随着 $a 和 $b 值的变化而变化。

作者

Ilya Zakharevich <[email protected]>。

另请参阅

overloading 编译指示可以用来在词法范围内启用或禁用重载操作 - 请参阅 overloading。

诊断信息

当 Perl 使用 -Do 开关或其等效项运行时，重载会产生诊断信息。

使用 Perl 调试器 (参见 perldebug) 的 m 命令，可以推断出哪些操作被重载了（以及哪个祖先触发了这种重载）。例如，如果 eq 被重载，那么调试器会显示方法 (eq。方法 () 对应于 fallback 键（实际上，该方法的存在表明该包启用了重载，并且它是模块 overload 的 Overloaded 函数所使用的）。

该模块可能会发出以下警告

overload::constant 的参数数量为奇数

(W) 对 overload::constant 的调用包含奇数个参数。参数应该成对出现。

'%s' 不是可重载类型

(W) 您尝试重载 overload 包不知道的常量类型。

'%s' 不是代码引用

(W) overload::constant 的第二个（第四个，第六个，...）参数需要是一个代码引用。可以是匿名子程序，也可以是子程序的引用。

overload 参数 '%s' 无效

(W) use overload 传递了一个它不认识的参数。您是否拼错了运算符？

错误和陷阱