[Perl] サブルーチンプロトタイプとデフォルト変数で遊ぶ

この記事は [Perl Advent Calendar 2020](https://qiita.com/advent-calendar/2020/perl) の12月10日のエントリです。
昨日は @papix さんの「[PerlでスナップショットテストをするTest::Snapshotのご紹介](https://papix.hatenablog.com/entry/2020/12/09/220713)」でした。

---
本記事では、Perl のとりわけ Perl らしい側面に、焦点を当ててみました。
内容は [perlsub](https://perldoc.jp/docs/perl/5.24.1/perlsub.pod) と関係する部分が多いですので、Perl に不慣れな方は併せてご参照ください。

# デフォルト変数 $_ について

**デフォルト変数、便利ですよね！** ――と言って、同意してくれる人は昨今少ないでしょう。コードの可読性を低める、として、goto 文並みに毛嫌いする向きもあります。確かに、デフォルト変数`$_`への代入は暗黙的に行なわれ、しかも変数名で何が格納されているのかを説明してもくれないので、可読性を著しく損ねることがあります。さらにデフォルト変数はグローバル変数なので、きちんと`local`化してから使わないと、思いもよらぬ場所で中味が変更されていて、デバッグを困難にする、という例も、枚挙にいとまがありません[^1]。

ですが、Perl には大規模開発にも堪えると同時に、ワンライナー (一行野郎) といった文化を代表として、サーバ管理者に楽をさせたり、日々の煩雑な業務を自動化してくれたりする、ハックのための言語という側面もあります。Perl の極めて強力な記述力の一端を、引数を省略でき、キーボードを叩く数を 1 ストロークでも少なく抑える、デフォルト変数の力が担っていることは、間違いのないところでしょう。目の前の、当座の課題を解決してゆくために、コードを次から次へと書き捨ててゆく、というのも、Perl の意図された使途の一つ (いや、むしろそれが本来の使途) です。私も、自分用の REPL 環境を持っていて頻繁に使うモジュールをあらかじめ読込ませておき、そこにコード片を貼りつけては仕事を片付けてゆく、という使い方をよくするのですが、そのさいこの Perl の強大な記述力に助けられていることは多いです。

## 主題と焦点

ラリー・ウォールが言語学を修めていたこととも関係して、Perl には他の言語にはない独創的な、自然言語と類比的な機能がたくさん盛り込まれています。例えばシジル (`$`, `@`, `%`, etc.) は**冠詞**に相当するものであり、単数や複数といった**数**についての情報も含みます。**コンテキスト**によって言語構成要素が振舞いを変えるのも、とても自然な発想です。そして、デフォルト変数は this/it などに相当する**代名詞**であり、同じ対象にくりかえし言及する労を省きます。それをさらに`for`と組み合わせれば、ドイツ語や日本語などと似て、**主題と焦点** (Theme and Rheme) の構造をつくり出すことになります。
例えば、次のような一連の処理は、とても読みやすいものではないでしょうか：

```perl
for ($str) {
    chomp;
    s/hoge/fuga/gi;
    tr/a-z/A-Z/ if /^\^/;
    tr/A-Z/a-z/ if /^\,/;
    print;
}
```

プロダクトごとにコーディング規約があったり、状況に応じて部分的な言語セットを利用したりするのは当然として、目の前の課題に対して一番楽なソリューションを使うのがハックというものの筈ですし、シチュエーションを無視して「きれいな Perl はこう！」と決めつけてしまうのは、TMTOWTDI の精神に反するように思います。

[^1]: ちなみに、グローバルな`$_`の使用を非合法化する、小飼弾氏の [underscore](https://metacpan.org/pod/underscore) というプラグマモジュールもあります。まあ最低限、これを使って`no underscore;`しても`croak`されることがない程度のクリーンなコードを、プロダクトなら書いた方がよいでしょうね。

# サブルーチンプロトタイプ

サブルーチンプロトタイプ機構は、非常に癖が強くて常用するメカニズムではありませんが、お手製で内部をいじくり倒せる Perl という言語らしい、これまた面白い仕組みと言えるでしょう。
プロトタイプは引数チェックのための機能ではありません。サブルーチンに対してプロトタイプを宣言すると、引数を解釈するパーサの振舞いを個々に指定して変えることができ、自分で新しい構文を設計できます。引数の評価コンテキストにも影響を与えるため、注意深く用いる必要があり、まあ半‐黒魔術といったところでしょう。

プロトタイプは、次のように宣言します：

```perl
sub hoge (&;$) { ... }
sub fuga :prototype(*$$\@) { ... }
```

前者のスタイルは、別の機能であるサブルーチンシグネチャの指定と競合してしまい、来る Perl 7 ではサブルーチンシグネチャがデフォルトで有効になる、という話もあるので、後者のようにプロトタイプ属性で書いてやる方が、前方互換性のためには安全でしょう。

次のように、無名関数に対しても指定でき、型グロブの`CODE`スロットへの代入などに利用します：

```perl
BEGIN {
    *piyo = sub :prototype(\%) { ... };
}
```

## いろいろな使い方

サブルーチンプロトタイプの意味は、基本的には、プロトタイプで指定したシジルと同じ性質の引数が、同じ順序で渡されることを、パーサに期待させるものです。`;`というセパレータは、それより後ろの引数が省略可能であることを伝えます。シジルの直前に`\`が付いていると、サブルーチンの側ではリファレンスとしてその引数を受け取ります。さらに使い方によって、以下に挙げるようなメリットも享受することができます。

- `&`は、その位置にコードリファレンスを期待します。プロトタイプの先頭のシジルが`&`である場合、`sub`キーワードを省略し、ブロックとしてコードリファレンスを渡すことができます (これは [Try::Catch](https://metacpan.org/pod/Try::Catch) の実装などに利用されています)。

```perl
sub twice :prototype(&) {
    my $coderef = shift;
    $coderef->();
    $coderef->();
}
twice {
    say 'hello, world!';
};  # ←セミコロンを忘れない
```

- プロトタイプ`()`は、無引数であるということを示します (これは [constant](https://metacpan.org/pod/constant) プラグマの実装などに利用されています)。また`($)`であれば、単項演算子のように振舞います。

```perl
sub hoge1 { $_[0] }
sub hoge2 :prototype($) { $_[0] }
say hoge1 'fuga', 'piyo';  #=> fuga
say hoge2 'fuga', 'piyo';  #=> fugapiyo
```

- プロトタイプ`(_)`は、引数が省略された場合にデフォルト変数`$_`を利用します (組込み関数`lc`などと同様の振舞い)。

```perl
# if you are on Windows
use 5.28.0;
use warnings;
use utf8;
use Encode qw/encode decode/;
sub sjenc :prototype(_) { encode('cp932', $_[0]) }
sub sjdec :prototype(_) { decode('cp932', $_[0]) }

my @folders = qw(山の写真 海の写真 人の写真);
my @files;
for (@folders) {
    opendir(my $dirh, sjenc) or die $!;
    push @files, map sjdec, readdir $dirh;
}
say sjenc for grep /谷口撮影\.jpg$/i, @files;
```

- プロトタイプに`*`を指定してやると、`use`や`require`のように、`use strict`下でも、パッケージ名を「裸の単語」で渡すことができるようになります (これは [Module::Load](https://metacpan.org/pod/Module::Load) の実装などに利用されています)。

```perl
# モジュールのインストールパスを表示
sub which_module :prototype(*) {
    my $pkg = shift;
    eval "use $pkg ();";
    $pkg =~ s!::!/!g;
    say $INC{"$pkg.pm"};
}
which_module List::MoreUtils;
```

# 無名関数を自動でカリー化 (ラムダ抽象)

言語機能についてのご紹介は以上です。ここからは、少し遊んでみることにしましょう。

ご存知のように、Perl のサブルーチンに与えられるパラメタは、配列`@_`を介して受け渡されます。組込みの配列操作関数`shift`は、サブルーチンスコープの中では、引数が省略された場合にこの「デフォルト配列」`@_`を操作します。これはこれで、なかなか良くできた仕組みだと思うのですが、コールバック関数を引数に取るようなサブルーチン (高階関数) を頻繁に扱うようになってくると、もっとシンプルにコードブロックが書けたらよいのに、と思うこともあります。ブロックの先頭でいちいち`shift`して一時変数に代入するのは面倒ですし、ブロックを一行では書きにくくなります。かと言って`$_[0]`などをたくさん登場させるのも、ごちゃごちゃして、とても読みにくいものです。
Python の`lambda`や JavaScript のアロー関数式のように、もっとサクッと無名関数が書けると便利です。しかも Perl には、デフォルト変数という、自動的に組込み関数が対象にしてくれるような変数があるのだから、とりあえず`$_[0]`が`$_`に入っていれば、何をするにも便利だと思いませんか？　これはつまり、デフォルト変数を束縛して、無名関数を手軽にカリー化 (ラムダ抽象) できればよいのだが、ということです。
サブルーチンプロトタイプとデフォルト変数をうまく使えば、こうした挙動は短いコードで、簡単に実現することができます。以下で定義する`asub`というサブルーチン (“a”nonymous “sub”routine のつもり) は、`sub`キーワードと同様に使うことができます。ただし、`sub`の代わりに`asub`を使うと、あらかじめ`$_`に`$_[0]`がセットされた (カリー化された) コードリファレンスが返ります。`@_`も、通常の`sub`の場合と同様に渡っていますので、必要なら参照したり、一時変数に代入したりすることができます。`sub`の上位互換版みたいなものですね。

```perl
sub asub :prototype(&) {
    my $coderef = shift;
    return sub {
        local $_;
        if (@_) { $_ = $_[0] }
        $coderef->(@_);
    };
}
```

コードリファレンスを受け取り、それをデフォルト変数でカリー化したコードリファレンスを返すような関数です。返されるコードリファレンスでは、まず先頭で`$_`を`local`化しているので、前後での`$_`の中味には影響が及びません。その後、もし`@_`が空でなければ、`$_`に`$_[0]`を代入し、それから元のコードリファレンスを呼ぶことにする、という、ただそれだけです。

これを`sub`キーワードのように使って、例えば次のようになります。「`sub`キーワードのように使える」ということが、サブルーチンプロトタイプを指定したことの恩恵です。

```perl
sub give_hello {
    my $coderef = shift;
    $coderef->('hello');
}
give_hello sub { my $str = shift; say uc $str, '!' if $str =~ /E/i && 4 < length $str };
give_hello sub { say uc $_[0], '!' if $_[0] =~ /E/i && 4 < length $_[0] };
give_hello asub { say uc, '!' if /E/i && 4 < length };
```

`give_hello`の 3 つの呼出し、いずれも「HELLO!」を出力します。`asub`を使うと、コードブロックをずいぶん簡潔に書けるようになったことが見て取れますね。

# 組込み配列処理関数の破壊的版を作ってみる

これだけでは面白くないですね。せっかく`asub`を定義したので、これとサブルーチンプロトタイプを使って、もっと遊んでみたいと思います。

Perl のリスト処理関数のうち、`map`や`grep`などは、非破壊的なものだけが組込みで提供されています。Ruby の`Array#map`と`Array#map!`のように、破壊的ヴァージョンもあると便利なのにな、と思うこともあります。もっとも、無ければ自分で作ればいいのです。というわけで、以下に実装を試みてみました。名前に “d” がない組込み関数の、それぞれ破壊的 “d”estructive 版を提供しています。リストではなく配列しか取ることができませんが、今したいことが何かを考えれば、それは当然ですね。
配列を直接変更するので何も返さなくていい道理ですが、私は貧乏性なので、何も返さないのはちょっともったいない。とりあえずは、変更後の配列をそのまま返却するようにしてみましょう。

```perl
sub dmap :prototype(&\@) {
    my ($proc, $aref) = @_;
    $proc = &asub($proc);
    @$aref = map { $proc->($_) } @$aref;
    return @$aref;
}

sub dgrep :prototype(&\@) {
    my ($proc, $aref) = @_;
    $proc = &asub($proc);
    @$aref = grep { $proc->($_) } @$aref;
    return @$aref;
}

sub dreverse :prototype(\@) {
    my $aref = shift;
    @$aref = reverse @$aref;
    return @$aref;
}

sub dsort :prototype(&\@) {
    my ($proc, $aref) = @_;
    my ($caller_a, $caller_b) = do {
        no strict 'refs';
        my $pkg = caller;
        \(*{"${pkg}::a"}, *{"${pkg}::b"});
    };
    @$aref = sort {
        local (*$caller_a, *$caller_b) = \($a, $b);
        $proc->();
    } @$aref;
    return @$aref;
}
```

これらは、次のように動きます：

```perl
my @arr1 = (1, 2, 3);
# @arr1 の各要素を自乗
# さらに結果は返りもするので @arr2 にコピー
my @arr2 = dmap { $_ * $_ } @arr1;
# @arr2 を奇数だけに
dgrep { $_ % 2 } @arr2;
say "@arr1";  #=> 1 4 9
say "@arr2";  #=> 1 9

# dsort の例
my @arr = (8, 1, 5, 6, 1, 7, 4);
dsort { $b <=> $a } @arr;
say "@arr";   #=> 8 7 6 5 4 1 1
```

それではコードを解説しましょう。
まず`\@`をプロトタイプに指定して、受け取る配列はリファレンスで渡るようにします。これによって、配列を直接書換えるという破壊的な動作が可能になります。
コードリファレンスは、受け取ってから`$proc = &asub( $proc );`として、カリー化しています。`&`付きで呼出しているのは、サブルーチンプロトタイプを回避するための小技です。`asub`は`sub`キーワードと同様に使いたいため、プロトタイプに`(&)`を指定していましたが、これだとコードブロックそのものを渡す必要があり、コードリファレンスを変数に入れて渡すことができません。そこで`&`を付加して、パーサのプロトタイプチェックを回避するようにしてから、`asub`化しています。
それ以外に大したことはしていませんが、`dsort`では`sort`のように`$a`や`$b`を使えるようにしなければいけないので、少しごちゃごちゃしています (これは [List::Util::PP](https://metacpan.org/pod/List::Util::PP) の実装を参考にしました)。`$a`、`$b`はパッケージ変数ですので、何もしなければ「コードリファレンスが定義されたパッケージ」のそれらを参照します。ですので、それらを`sort`内の`$a`、`$b`で一時的に上書きしてやる必要があり、それからコードリファレンスを呼出します。

# まとめ

こうしたコードが威力を発揮するシーンは、限定的かもしれません。サブルーチンプロトタイプの利用は、Perl に慣れたプログラマの直観に反する挙動を惹き起こすことがままあり、必ずしも薦められるものでもありません。
にもかかわらず、自由に構文を導入できるプロトタイプはやはり素晴らしいものであり、デフォルト変数もまた使い方によってはコードをとても短く、読みやすくしてくれる場合があります。自由な発想で、この Perl という壮大な遊び場を、自分仕様に作り変えてゆくことは、とても魅力的です。そうしたハックを、ぜひ日常のコードにも取り入れてみてはどうでしょうか、という提案です。

---
明日の担当は @AnaTofuZ さんです！