クロージャーとグロブ割り当てを使用したサブルーチン

前回、前々回の日記でシンボリックテーブルとグロブを紹介したので、クロージャーとグロブ割り当てを利用したサブルーチンの紹介をしたいと思います。

レキシカル変数を不老不死にするクロージャ

Perlではグローバル変数とレキシカル変数が存在しています。それぞれの変数には生存期間が存在します。

レキシカル変数にはスコープという概念が存在します。変数へのリファレンスを失うまでPerlは記憶領域に値を保持しますが、リファレンスを失ったとたんにメモリを解放します。*1

クロージャーはこのリファレンスを保持することによってレキシカル変数を延命する作法です。

#!/usr/bin/perl
#use strict;
#use warnings;

my $coderef;

{
    ### このスコープ内では$nameにアクセスできる。
    my $name = 'okamura';
    $coderef = sub { print "I'm " . $name; };
}


### スコープ外なので参照できない。
print $name;

### コードリファレンスが$nameを参照したままなので
### 参照カウントが0になっていないのです。
$coderef->();

詳細を調べたい方はこちらperldocでperlrefかperlfaq7をご覧ください。

perldoc perlref
perldoc perlfaq7

日本語はこちら

もう少しクロージャ

たぶん上述の例だといまいちクロージャの用途が伝わりづらいので次のコードもご覧下さい。

1. サンプル

#!/usr/bin/perl
use strict;
use warnings;

### 無名サブルーチンを返す
sub hi {
    my $name = shift;
    return sub {
        my $word = shift;
        print "Hey, ", $name, '. ', $word, "\n";
    };
}

my $coderef = hi('Cutie'); # $nameに'Cutie'を代入する

$coderef->("What's up?");   # まだ$nameに値を保持し続けている
$coderef->("You free?");        # 今暇?
$coderef->("Wanna hang out?");  # お茶しない?

2. 実行

:!perl %
Hey, Cutie. What's up?
Hey, Cutie. You free?
Hey, Cutie. Wanna hang out?

グロブ割り当てを使用したサブルーチンとクロージャ

lib/Person.pm

package Person;
use strict;
use warnings;

sub new {
    my ( $class, %args ) = @_;

    my $self = bless {
        name => $args{name},
        old  => $args{old},
    }, $class;

}

sub name { $_[0]->{name}; }
sub old  { $_[0]->{old};  }

1;

script/sample.pl

#!/usr/bin/perl
use strict;
use warnings;
use FindBin qw($Bin);
use Path::Class qw/dir file/;
use lib dir($Bin, '..', 'lib')->stringify;
use Person;

my $taro = Person->new( name => 'taro', old => '20' );
print $taro->name, "\n";
print $taro->old, "\n";

実行

:!perl script/sample.pl
taro
20

上記のlib/Person.pmを次のように書く事もできます。

package Person;
use strict;
use warnings;

sub import {
    no strict 'refs';
    for my $method ( qw/name old/ ) {
        *$method = sub { $_[0]->{"$method"} };
    }
}

sub new {
    my ( $class, %args ) = @_;
    my $self = bless {%args}, $class;
}

1;

これはPerlでは良く使われるテクニックです。

前々回、前回、今回の記事を書いた目的の最終目標はClass::Data::Inheritable を新人に説明させたいからまず自分が説明する、という目的があったのですが、あらかた説明できたかな。どうなんだろう。

*1:どこから参照されているかを示す参照カウントを保持しておき、これが0になるのを待つ。