2010年08月23日 08:00 [Edit]

perl - Data::Decycle で悪循環を断とう!

Perlは循環参照が苦手

有名な話ですが、Perlで循環参照を作ると、プログラムが終了するまでその分のメモリーは解放されません。

use strict;
use warnings;
{
    package Dummy;
    sub new { bless $_[1], $_[0] }
    sub DESTROY { warn "($_[0])" }
}
{
    my $mom = Dummy->new( {} );
    my $son = Dummy->new( {} );
    $mom->{son} = 'me';
    $son->{mom} = 'her';
    # こちらはここで解放されるが…
}
{
    my $mom = Dummy->new( {} );
    my $son = Dummy->new( {} );
    $mom->{son} = $son;
    $son->{mom} = $mom;
    # こちらはここではなく…
}
warn "Goodbye, world!";
# ここでやっと解放される

Weak Referenceはあるけれど…

Perl 5.8から導入された weak reference を使えばこの問題は解決しはしますが…

use strict;
use warnings;
use Scalar::Util qw/weaken/;
{
    package Dummy;
    sub new { bless $_[1], $_[0] }
    sub DESTROY { warn "($_[0])" }
}
{
    my $mom = Dummy->new( {} );
    my $son = Dummy->new( {} );
    $mom->{son} = $son;
    weaken $mom->{son};
    $son->{mom} = $mom;
    weaken $son->{mom};
}
warn "Goodbye, world!";

ひちめんどうくさい上に、こう書くと怒られちゃいます。

use strict;
use warnings;
use Scalar::Util qw/weaken/;
{
    package Dummy;
    sub new { bless $_[1], $_[0] }
    sub DESTROY { warn "($_[0])" }
}
{
    my $mom = Dummy->new( {} );
    my $son = Dummy->new( {} );
    weaken $mom->{son} = $son;
    weaken $son->{mom} = $mom;
}
warn "Goodbye, world!";

ClosureだってLeakする

そして実は、closureもリークすることがあるのです。

use strict;
use warnings;
{
    package Dummy;
    sub new { bless $_[1], $_[0] }
    sub DESTROY { warn "($_[0])" }
}
{
    my $fact;
    $fact = sub{ $_[0] <= 1 ? $_[0] : $_[0] * $fact->($_[0] - 1) };
    bless $fact, 'Dummy';
    print $fact->(10), "\n";
}
warn "Goodbye, world!";

この場合、Scalar::Util::weaken() は無力を通り越して有害です。

use strict;
use warnings;
use Scalar::Util qw/weaken/;
{
    package Dummy;
    sub new { bless $_[1], $_[0] }
    sub DESTROY { warn "($_[0])" }
}
{
    my $fact;
    $fact = sub{ $_[0] <= 1 ? $_[0] : $_[0] * $fact->($_[0] - 1) };
    bless $fact, 'Dummy';
    print $fact->(10), "\n";
    weaken $fact; # undef $fact といっしょ!
    print $fact->(10), "\n";
}
warn "Goodbye, world!";

mallocとfreeじゃあるまいし

最後に何らかの手段で強制的に循環を断つことも可能ではありますが…

use strict;
use warnings;
use Data::Decycle qw/decycle_deeply/;
{
    package Dummy;
    sub new { bless $_[1], $_[0] }
    sub DESTROY { warn "($_[0])" }
}
{
    my $mom = Dummy->new( {} );
    my $son = Dummy->new( {} );
    $mom->{son} = $son;
    $son->{mom} = $mom;
    decycle_deeply($mom);
    decycle_deeply($son);
}
warn "Goodbye, world!";

これじゃCのmalloc()+free()のペアや、C++のnew+deleteのペアといっしょで、何のための garbage collector なのかわかりません。

こういっちゃなんですが、Perlをdisるのに格好のネタですね。

use Data::Decycle

そこで作ったのがData::Decycleです。

Data::Decycleを使えば以下のようにして循環参照を強制回収できます。

use strict;
use warnings;
use Data::Decycle;
{
    package Dummy;
    sub new { bless $_[1], $_[0] }
    sub DESTROY { warn "($_[0])" }
}

{
    my $guard = Data::Decycle->new();
    add $guard my $mom = Dummy->new( {} );
    add $guard my $son = Dummy->new( {} );
    $mom->{son} = $son;
    $son->{mom} = $mom;
}
warn "Goodbye, world!";

もちろんこうでもOKです。

use strict;
use warnings;
use Data::Decycle;
{
    package Dummy;
    sub new { bless $_[1], $_[0] }
    sub DESTROY { warn "($_[0])" }
}

{
    my $guard = Data::Decycle->new(
      my $mom = Dummy->new( {} ),
      my $son = Dummy->new( {} )
    );
    $mom->{son} = $son;
    $son->{mom} = $mom;
}
warn "Goodbye, world!";

PadWalker がインストールされていれば、closureも逝けます。

use strict;
use warnings;
use Data::Decycle;
{
    package Dummy;
    sub new { bless $_[1], $_[0] }
    sub DESTROY { warn "($_[0])" }
}

{
    my $guard = Data::Decycle->new;
    my $fact;
    $fact = sub{ $_[0] <= 1 ? $_[0] : $_[0] * $fact->($_[0] - 1) };
    bless $fact, 'Dummy';
    $guard->add($fact);
    print $fact->(10), "\n";
}
warn "Goodbye, world!";

どーなってんの?

ソース嫁。

ではあんまりなので解説すると、my $guard = がキモです。この$guardは、当然スコープを抜けると始末されるので、DESTROY()が定義されていれば$guard->DESTROY()が実行されます。ここで登録された参照をdecycle_deeplyしてやれば全員きれいに道連れにできるというわけです。

その他のgoodies

他にも明示的に循環参照に対策する関数ももちろんあります。

use 5.010;
use strict;
use warnings;
use Data::Decycle qw/:all/;

{
    package Dummy;
    sub new { bless $_[1], $_[0] }
    sub DESTROY { warn "($_[0])" }
}
{
    my $mom = Dummy->new( {} );
    my $son = Dummy->new( {} );
    say "($mom) has cyclic ref ? ", has_cyclic_ref $mom ? 'yes' : 'no';
    say "($son) may leak ? ",       may_leak       $son ? 'yes' : 'no';
    $mom->{son} = $son;
    $son->{mom} = $mom;
    say "($mom) has cyclic ref ? ", has_cyclic_ref $mom ? 'yes' : 'no';
    say "($son) may leak ? ",       may_leak       $son ? 'yes' : 'no';
    weaken_deeply $mom;
    weaken_deeply $son;
    say "($mom) has cyclic ref ? ", has_cyclic_ref $mom ? 'yes' : 'no';
    say "($son) may leak ? ",       may_leak       $son ? 'yes' : 'no';
}
warn "Goodbye, world!";

base class にして、メソッドにしてもイケます。

use 5.010;
use strict;
use warnings;
{
    package Dummy;
    use base 'Data::Decycle';
    sub new { bless $_[1], $_[0] }
    sub DESTROY { warn "($_[0])" }
}
{
    my $mom = Dummy->new( {} );
    my $son = Dummy->new( {} );
    say "($mom) has cyclic ref ? ", $mom->has_cyclic_ref ? 'yes' : 'no';
    say "($son) may leak ? ",       $son->may_leak?        'yes' : 'no';
    $mom->{son} = $son;
    $son->{mom} = $mom;
    say "($mom) has cyclic ref ? ", $mom->has_cyclic_ref ? 'yes' : 'no';
    say "($son) may leak ? ",       $son->may_leak?        'yes' : 'no';
    $mom->weaken_deeply;
    $son->weaken_deeply;
    say "($mom) has cyclic ref ? ", $mom->has_cyclic_ref ? 'yes' : 'no';
    say "($son) may leak ? ",       $son->may_leak?        'yes' : 'no';
}
warn "Goodbye, world!";

Stop worring about chasing your own tail now. Enjoy!

Dan the Perl Monger

注意: CPANにアップロードされていた Data-Decycle-0.01.tar.gz の内容が壊れていました。 Data-Decycle-0.02.tar.gz 以降をお使いになるか、 svn/git で入手を


この記事へのトラックバックURL