目錄

名稱

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;

說明

此實用程式允許為類別重載 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 指令中指定的運算子，根據稍後說明的 "Magic Autogeneration" 規則。例如，上述的 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" 使用。

Mathemagic、變異器和複製建構函式

術語「數學魔術」描述數學運算子的過載實作。數學魔術運算會引發問題。考慮下列程式碼

$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 =',

大部分可過載運算子會一對一對應到這些金鑰。例外，包括此雜湊中未顯現的其他可過載運算，包含在下列附註中。此清單會隨著時間而增加。

如果嘗試註冊上述未找到的運算子，會發出警告。

自動產生 Magic

如果找不到運算的方法，則 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' 金鑰用於指定一個 catch-all 函式，以呼叫任何未個別重載的運算子。指定的函式將傳遞四個參數。前三個參數與傳遞給對應方法 (如果已定義) 的參數相同。第四個參數是該遺失方法的 use overload 金鑰。如果啟用「位元」功能 (請參閱 功能)，會傳遞第五個 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 文件，

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

實作

下列內容可能會因 RSN 而變更。

所有作業的方法表格都快取在封裝的符號表雜湊的魔法中。在處理 use overload、no overload、新的函式定義和 @ISA 中的變更時，快取會失效。

（每個 SVish 物件都有個 magic 佇列，而 magic 是該佇列中的項目。這表示單一變數可以同時參與多種形式的 magic。例如，環境變數通常同時具有兩種形式：它們的 %ENV magic 和 taint magic。不過，實作 overloading 的 magic 會套用至儲存區，而儲存區很少直接使用，因此不應減慢 Perl 速度。）

如果套件使用 overloading，它會攜帶特殊旗標。在定義新函式或修改 @ISA 時，也會設定此旗標。在支援 overloading 的第一個作業之後，會出現輕微速度損失，因為會更新 overloading 表格。如果沒有 overloading，旗標會關閉。因此，此後唯一的速度損失是檢查此旗標。

預期不會變更的方法引數為常數（但未強制執行）。

COOKBOOK

請新增範例至以下內容！

雙面 Scalars

將此內容放入 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/;

（第二行會建立一個同時具有字串值和數字值的 scalar。）這會列印

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

雙面 References

假設您想建立一個物件，可以同時作為陣列參考和雜湊參考存取。

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 的實際類型是 scalar 參考，我們不會 overloading scalar 取消參照。因此，我們可以使用 $$bar（我們在 overloading 取消參照的函式中執行的動作）取得 $bar 的實際未 overloading 內容。類似地，TIEHASH() 方法傳回的物件是 scalar 參考。

其次，每次使用雜湊語法時，我們會建立新的繫結雜湊。這讓我們不必擔心參考迴圈的可能性，這將導致記憶體外洩。

這兩個問題都可以解決。假設我們要在實作為雜湊本身的物件參考上 overloading 雜湊取消參照，唯一必須解決的問題是如何存取這個實際雜湊（與 overloading 取消參照運算子顯示的虛擬雜湊相反）。以下是一個可能的擷取常式

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 O 選項，且不能透過 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 應變為 false。但是，用於檢查假值的運算子 bool 已被覆寫（這次是透過覆寫 ""），並傳回一個長字串，因此 symbolic 類型的任何物件都是 true。為了解決這個問題，我們需要一種將物件與 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

上述模組非常原始。它未實作變異器方法（++、-= 等），未執行深度複製（在沒有變異器的情況下不需要！），而且只實作範例中使用的那些算術運算。

實作大多數算術運算很簡單；只需使用運算表格，並將填入 %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 列，以及程式碼（此程式碼假設變異器只會變更一個層級深度的內容，因此不需要遞迴複製）

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

若要讓 ++ 和 -- 運作，我們需要實作實際的變異器，可以透過直接方式或在 nomethod 中實作。我們會繼續在 nomethod 中執行操作，因此請在 wrap() 的第一行後新增

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

這並不是最有效的實作，可以考慮

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

作為替代方案。

最後，請注意可以透過

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

填入 %subr。這完成在 50 行 Perl 程式碼中實作基礎符號計算器的動作。由於子表達式的數值不會快取，因此計算器運作速度非常慢。

以下是練習的解答：在 str() 的情況下，我們不需要明確的遞迴，因為重載的 . 運算子會回退至現有的重載運算子 ""。如果未明確要求 fallback，重載的算術運算子不會回退至數值轉換。因此，如果沒有明確的遞迴，num() 會將 ['+', $a, $b] 轉換為 $a + $b，這只會重建 num() 的引數。

如果您好奇為什麼 str() 和 num() 的轉換預設值不同，請注意撰寫符號計算器有多麼容易。這種簡潔性是因為適當地選擇預設值。額外說明：因為明確遞迴，所以 num() 比 sym() 脆弱：我們需要明確檢查 $a 和 $b 的類型。如果元件 $a 和 $b 碰巧是某種相關類型，這可能會導致問題。

真正符號計算器

您可能會好奇為什麼我們稱呼上述計算器為符號計算器。原因在於表達式的實際值計算會延後到值使用時才進行。

要看到實際運作，請新增一個方法

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

到套件 symbolic。在做完這個變更之後，您可以執行

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 模組確實提供了一個符號計算器。

為了隱藏引擎蓋下的粗糙邊緣，請提供一個 tie()d 介面到套件 symbolic。新增方法

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 <ilya@math.mps.ohio-state.edu>。

另請參閱

overloading pragma 可用於在詞彙範圍內啟用或停用重載運算子 - 參閱 overloading。

診斷

當 Perl 以 -Do 參數或等效參數執行時，重載會引發診斷訊息。

使用 Perl 除錯器的 m 指令 (參閱 perldebug)，可以推論哪些運算子已重載 (以及哪個祖先觸發此重載)。例如，如果 eq 已重載，則除錯器會顯示方法 (eq。方法 () 對應於 fallback 鍵 (事實上，此方法的存在表示此套件已啟用重載，而這是模組 overload 的 Overloaded 函數所使用的)。

模組可能會發出下列警告

overload::constant 的引數數量為奇數

(W) 對 overload::constant 的呼叫包含奇數個引數。引數應成對出現。

'%s' 不是可重載的類型

(W) 您嘗試重載 overload 套件不知道的常數類型。

'%s' 不是程式碼參考

(W) overload::constant 的第二個 (第四個、第六個，...) 引數必須是程式碼參考。匿名子常式或子常式的參考。

overload 引數 '%s' 無效

(W) use overload 傳遞了一個它不識別的引數。您是否輸入錯誤的運算子？

錯誤和陷阱