Perl Memo

はじめに - 遅延初期化

初期化にコストのかかるオブジェクトがあり、かつそれを必ずしも毎回使用する必要のない場合、必要となった時にはじめて初期化する、といったスタンスをとることができます。

# $obj を使う場面で ...
initialize($obj) unless defined $obj; # 未初期化ならここで初期化する
do_something($obj);
# ...

しかし、このような初期化コードを毎回 $obj を使う場面で書くのはまどろっこしいわけで、これをどうにかして隠蔽しようと考えます。たとえば、内部で未初期化なら初期化を行うような生成関数を経由すれば隠蔽できます：

# $obj インスタンスを返す
my $obj;
sub get_obj
{
    initialize($obj) unless defined $obj;
    return $obj;
}
# ...
do_something( get_obj() );

しかし、この手法にはいくつかの改善すべき点があります：

• 上の例のように変数の所有を関数側にすると寿命管理がしづらくなる。
• （逆に）関数呼び出し側で変数を所有しそれを生成関数に引き渡すスタイルをとると、「変数名」「生成関数名」のふたつの識別子を管理することになりあまりよろしくない。
• （当然のことではあるが）関数呼び出しが多発し視覚的な区別がしづらくなる。

まぁ、わざわざ関数を経由させることなく記述したいものです。

Proxy パターン

$obj が何かのクラスのインスタンスで、内部構造にはタッチせずにメソッドコールしか行わないのであれば、virtual proxy（Proxy パターン, GoF本）を利用するという手もあります。簡単に言えば、別のクラスで包んでしまうという手法です：

package RealSubject;
sub new { print '(construct)' ; bless { foo => 1 }, shift }
sub foo { shift->{foo} }

package Proxy;
sub new { bless \( my $s ), shift }
sub DESTROY {}
sub AUTOLOAD
{
    my $self = shift;
    ( my $method = $AUTOLOAD ) =~ s/.*:://;
    ( $$self ||= new RealSubject )->$method(@_);
}

package main;
my $subj  = new RealSubject; #=> '(construct)'
my $proxy = new Proxy;       #=> 
print $subj->foo;            #=> 1
print $proxy->foo;           #=> '(construct)', 1

• virtual proxy を使った例のスクリプト

すべての RealSubject メソッドは、Proxy を経由して呼び出されています。また、最初のメソッド呼び出し（$proxy->foo）が起こるまで、RealSubject インスタンスは作成されていません（ので目論見通りです）。AUTOLOAD により、すべてのメソッドを横流しすることに成功しています。

このソリューションによって、「変数」の見た目を崩すことなく初期化が可能になりました。しかし、初期化したいものがオブジェクトではなく単なるスカラーだったりハッシュだったりする場合には適用できません。また、メソッドコールごとに中間オブジェクト(Proxy)へのアクセスコストがかかります（これに関しては生成関数を経由した場合も同じ。しかし、こちらはメソッドコールなので多少割高）。

tie を使った解決法の模索

NOTE: 以下の内容は perl 5.8.0 以上向け。

さて、ここで、tie が使えないかどうか考えてみましょう。tie を用いることにより、取得や代入などの変数への干渉をトラップできます。よって、これらの干渉がはじめてあった時、ひらたくいえば、変数に「触った」時を初期化タイミングとして使うことができます。また、タイ変数は untie すれば何事も無かったかのようにもとの変数に戻ります。この機構はなかなかよさそうです。つまり、変数に「触った」時、即ち FETCH や STORE などのメソッドが呼ばれた時点で自らを初期化します（遅延初期化）。さらに、自らを untie することにより、以降のアクセスに tie が関与しません（中間オブジェクトへのアクセスコストの排除）。とりあえず、やってみましょう。

package Phantom;
sub TIESCALAR { my ($class, $self) = @_ ; bless $self => $class }
sub FETCH { my $self = shift ; untie $$self ; $$self = { foo => 1 } }

tie my $num, 'Phantom', \$num;
print $num->{foo};  #=> 1

• tie を使った実験のスクリプト

注意：このコードには問題があります。（後述）

とりあえず、一体このコードは何をやろうとしているのか、というと：

1. tie の行。変数 $num をクラス Phantom でもって tie する。引数として $num へのリファレンスを与える。
   1. 結果、Phantom::TIESCALAR が呼ばれる。
   2. Phantom::TIESCALAR は、渡されたリファレンスにクラス Phantom を bless して返す。以下、この戻り値を $tied とし、また tied object とも呼ぶことにする。
2. print の行。$num->{foo} を表示しようとする。
   1. 引数 $num->{foo} が評価される。
   2. $num をデリファレンスするために、$num 自体の値が評価される。
   3. $num はタイ変数なので、関連づけられたオブジェクトの FETCH メソッドを呼び出す。すなわち、$tied->FETCH が呼ばれる。
   4. Phantom::FETCH では：
      1. まず変数 $ref に $num へのリファレンスを格納する。
      2. 次に $ref のリファレント（つまり $num）に対して untie をかける。これにより $num への tie が解除される。
      3. 最後に $ref のリファレント（つまり $num）に無名ハッシュ { foo => 1 } を代入する。
      4. 戻り値は最後に評価した値である $num、即ち { foo => 1 }。
   5. 結局、$num->{foo} の値として { foo => 1 } でのキー foo の値である 1 が返る。
   6. 1 が表示される。

てなかんじです。ごちゃごちゃしていますが重要な点は、単なるスカラーを、遅延初期化しようとしていること、そして、初期化された後は余計なコードは一切絡まなくさせようとしている点です。

しかしこのコードは、遅延初期化については実現できているのですが、余計なコードを絡ませない試みについては実現できていません。ためしに、最後の行のあとに print tied($num) ? 'tied' : 'not tied'; などとしてみると tied と表示されます。つまり、untie されていません。

NOTE: 5.6.1 以前の perl を利用していると、not tied と表示されます（つまり、untie されています）。これは perl のバグによるもので、5.8.0 では fix されています。参考 - [perl-oo:0667]

untie 問題とその解決法

何がまずかったのでしょう？ 実は、FETCH や STORE などの中では $num はタイ変数ではないかのように振る舞うのです（内部で MAGIC ビットを落とされている）。よって、untie しても何も起こりません。正直 Perl の範囲内でこれを解決する方法は思いつきませんでした。が、Inline::C を使えば何とかならないこともないようです。以下のような関数を使えばよいそうです。参考 - [perl-oo:0669]

void magical_on(SV* sv) { SvMAGICAL_on(SvRV(sv)); }

これは、（リファレントの）落とされた MAGIC ビットを立てる関数となります。これを untie する前にかませばいいので、FETCH メソッドは以下のようになります。

sub FETCH
{
    my $self = shift;
    magical_on($self);
    untie $$self;
    $$self = { foo => 1 };
}

これで OK です。なんか危険臭いですが…（危険であるとわかる方はお教え下さい）。あと、「それなら全部 C で書こうよ」とか無しね:p。

インターフェースの模索（プロトタイプあそび）

あとはこれを利用しやすいようにすれば幸せになれます。tie されて初期化待ちになっている状態を Phantom 状態と名付けることにします。

Phantom 化するための関数 phantomize をどう作ればいいでしょうか？ 前の例では、tie をするのに、変数 $num とそのリファレンスと両方を扱わなければなりませんでしたが、リファレンスから本体は導出できるので phantomize に渡すのはリファレンスのみで OK です。例示：

• phantomize(\$num);

初期化方法は変数により違ってくると思うので、これも無名関数で渡してしまいましょう。この初期化関数の第一引数は、初期化したいもののリファレンスということににしましょう。

• phantomize( sub { ${+shift} = { foo => 1 } }, \$num );

さらにプロトタイプを使って遊びましょう。プロトタイプ & を使えば、無名関数を map や sort のように sub を書くことなく渡せます。sub phantomize(&$) として、以下のようにできます：

• phantomize { ${+shift} = { foo => 1 } } \$num;

もういっちょ。perl 5.8.0 以上じゃないと使えませんが、プロトタイプ \[$@%*] というのがあります。これを使えば、暗黙的にスカラー、配列、ハッシュ、型グロブのリファレンスを渡すことができます。そうするとわざわざ \ を使ってリファレンスを生成する必要がなくなります。sub phantomize(&\[$@%*]) として、以下のようにできます。これで最終形です：

• phantomize { ${+shift} = { foo => 1 } } $num;

最終形ではリファレンスを作らなくても良いので、自然なところに my を置くことができます：

• phantomize { ${+shift} = { foo => 1 } } my $num;

最初と比べると大違いですね。いや、違う、としか言ってませんって!

結果生成物

関数 phantomize では第二引数が何のリファレンスなのかを調べ、リファレントをそれに合わせたクラス（Tie::Phantom::Scalar, Tie::Phantom::Array, ...）で tie してやります。それぞれのクラスは、メソッドが呼ばれると自らを untie し、その後コンストラクタで渡された初期化関数でもって初期化し、最後に行われたメソッドに対応する作業を行います。

以上の作業をモジュール化したものが以下の Tie::Phantom です。

• Tie/Phantom.pm

現在のところいくつか不都合があります。以下のような「触り」方をすると、うまくいきません。どうにかならんもんかな。

• $#array = $scalar; （配列の STORESIZE。サイズ変更が反映されない）
• @array = (); （配列の CLEAR。perl が落ちる）
• %hash = (); （ハッシュの CLEAR。perl が落ちる）
• ($key, $value) = each %hash; （リストコンテキストでの each。初回の $value が空になる）

やっぱり一から MAGIC いじりしなきゃいけないのかなぁ。くそう。

# $year年 $mon月の末日 $lastday を求める
$lastday = $mon == 2 ? 28 + ($year % 4 == 0 and ($year % 400 == 0 or $year % 100 != 0)) 
                     : 31 - ($mon - 1) % 7 % 2;

おまけ：二文字減らす

閏年判定に使っている条件式で、or のほうが and よりも優先順位が低いためにカッコが一対必要になっています。これを解消するには：

• or を || に変えて優先順位を上げる
• 否定をとって and を or に、or を and にする

あたりがありそうです。|| を使うのは何となく不格好なので、否定をとってみましょう。

# $year年 $mon月の末日 $lastday を求める
$lastday = $mon == 2 ? 29 - ($year % 4 != 0 or $year % 400 != 0 and $year % 100 == 0) 
                     : 31 - ($mon - 1) % 7 % 2;

…だからどうした、という気もします。