Tie::Hashを使って、Hashに追加順序を記憶する機能を追加する。

Perl

Tie::Hashっていうモジュールがあって、それを読み込むと、Hashの機能を拡張できる。
その機能拡張に、Hashの追加順を記憶するって事もでき、
Tie::HashのドキュメントやTie::IxHashのコードを参考に、どんなもんか作ってみた。
参考って書いてるけど、ほとんどパクり。


package Tie::Hash::Sample;
use Tie::Hash;

our @ISA = qw(Tie::Hash);
sub TIEHASH  { bless [{}, [], 0], $_[0]; } # 実体, 順序, each時の参照カウンタ
sub STORE    {
	if(not exists $_[0][0]->{$_[1]}){ push(@{$_[0][1]} , $_[1]); }
	$_[0][0]->{$_[1]} = $_[2];
}
sub FETCH    { $_[0][0]->{$_[1]}; }
sub FIRSTKEY { $_[0][2] = 0; NEXTKEY( @_ ) }
sub NEXTKEY  { $_[0][2] < @{$_[0][1]} ? $_[0][1][$_[0][2]++] : undef }
sub EXISTS   { exists $_[0][0]->{$_[1]} }

sub DELETE   { 
	if(exists $_[0][0]->{$_[1]}){
		for(my $i=0; $i<@{$_[0][1]}; $i++){
			if($_[0][1][$i] eq $_[1]){
				return delete $_[0][0]->{(splice(@{$_[0][1]},$i,1))[0]};
			}
		}
	}
	return undef;
}
sub CLEAR    { %{$_[0][0]} = @{$_[0][1]} = (); }
sub SCALAR   { scalar %{$_[0][0]} }

1;

@_の値をそのまま使ってるため、非常に見にくい。
以下の順で置換えをすると若干みやすくなるかも
$_[0] => $this　（オブジェクト（配列）の参照）
$this[0] => $hash_ref　(実際に値を持つハッシュの参照)
$this[1] => $array_ref（ハッシュのキーを格納した順序を記憶する配列の参照）
$this[2] => $scalar 　（eachなどで順番に取り出すときに必要なカウント用変数）


ただ、ハッシュの代わりに独自のオブジェクトを与えて、
ハッシュ操作するときに必要なメソッドをオーバーライドするだけのお手軽実装。
なので、独自なメソッドも追加できます。


各メソッドについてちょっとメモ書き。

sub TIEHASH

blessでパッケージと関連付ける処理があるように、コンストラクタのようなもの。
tieで関連付けを行うとこれが呼び出され、オブジェクトのように使えるようになる。
引数は (パッケージ名)
返り値は オブジェクト

sub STORE

データを記録する時に呼び出される。
値の代入や更新、初期化時にもこれが呼び出される。
今回は順番を記憶したいだけなので、existsでハッシュに存在しないデータならリストの最後方へpushする。
引数は (オブジェクト, キー, 値)
返り値は 値

sub FETCH

ハッシュから値を取り出すときに呼び出される。
eachなどで代入で右辺値に置いた時など。
引数は (オブジェクト, キー)
返り値は 値

sub FIRSTKEY

例えばkeysやeachなど、値を取り出す時のキーを決める処理をしたりする。
大体、keysやeachを呼び出すと最初の1度だけ行われ、ループを抜けるまで呼び出されることはない。
今回はリストの先頭から順に参照するため参照カウンタをリセットして、NEXTKEYを呼び出してそれを返り値にしている。
引数は (オブジェクト)。
返り値は キー

sub NEXTKEY

次のキーを返す。
今回はリストから参照カウンタを添え字にしてキーを取り出し、それを返す。参照カウンタを1加算する。
引数は (オブジェクト)。
返り値は キー

sub EXISTS

キーが存在するか否か。ハッシュにキーがあったら真、なかったら偽を返す。シンプル。
引数は (オブジェクト, キー)。
返り値は 真・偽のどちらか

sub DELETE

キーを削除するときに呼び出される。(delete関数)
今回は線形探索して指定されたキーがリストにあったときに、deleteを呼び出す。
同時に、リストの中のキーも削除する。
ただ、最近追加したキーを削除する時は探索のコストが最悪になるのが考え物。
個人的にはdelete関数はあまり呼び出さないし、
順序を記憶するハッシュが必要になる機会もあまりないだろうし、このままでいい気もする。
引数は (オブジェクト, キー)。
返り値は 削除されたキーの値（存在しなければ偽）

sub CLEAR

キーの宣言時を除く初期化時に呼び出される。

tie my %h1, 'Tie::Hash::Sample'; #呼び出されない（コンストラクタで初期化済みなはずなためか?）
%h1 = ( xxx => 1 ); # 呼び出される
undef %h1; # 呼び出される

引数は (オブジェクト)。
返り値は 不明

sub SCALAR

ハッシュに対してスカラーで評価した場合の振る舞い。
通常はハッシュをスカラーで評価したものを返す。
引数は (オブジェクト)
返り値は 特に理由がなければ scalar(%hash) の値


無駄話

関数を呼ぶと引数を受け取るために、暗黙のうちに@_に代入されますが、
引数を受け取った関数から他の関数へ引数を丸投げしたい時、

sub func1(){
   &func2();
   &func2;
   func2();
   func2;
}

上の4種類の内、"&func2"の時だけ、@_を引数としてくれます。他は空の配列。



Tie::IxHashと純粋なHashとのベンチマークも取ってみたい。
代入、更新、削除、keys、each、初期化とハッシュのコピー辺り。