Perl6でMMDを使ってみた

Perl6

Perl6では関数の定義時にSignatureを詳しく宣言できるようになりました。また、変数の宣言に静的型付け的な要素が取り入れられたため、引数リストの数だけでなく型の指定が可能です。また、引数だけでなく返り値の型も宣言できるようになりました。他にもオプション引数とか名前付き引数とか色々出来るようになったのですが、それは本題ではないので割愛。
本日のお題は、仮引数に値の制約条件をつけるwhere節です。まずは下のコードを見てください。1から10までのInt型だけを実引数として与えられる例です。

multi sub TestSub (Int $arg where 1..10 ) {...}
# この記法は省略表記で、実際には下のコードと等価

multi sub TestSub (Int $arg where { $_ ~~ 1..10 }) {...}
# where節のブロックの中は好きなコードを書くことができ、
#評価した値が真であれば呼び出しが成功する
#引数は暗黙的に$_に格納される

この機能を用いることで、不正な値を引数に取る関数呼び出しが失敗することを保証できます。つまり今までは関数の中で値の正当性をチェックしていたのが、Signatureの定義の中でチェックができるようになったわけです。関数全体のコード量は大きく変わりませんが、関数の中のコードは簡潔になり、また関数を書いた人の意図が捉えやすくなると考えられます。例えば実数範囲だけに絞って平方根を取りたい時、負数を引数とする関数呼び出しが失敗して欲しいとしましょう。

  • CallFunctionTest.p6
sub TestSqrt (Int $var where 0..Inf) {
    return $var.sqrt;
}

say TestSqrt(4);
say TestSqrt(-4)
  • 実行結果
$perl6 CallFunctionTest.p6
2
Constraint type check failed for parameter '$var'
  in 'TestSqrt' at line 1:CallFunctionTest.p6
  in main program body at line 6:CallFunctionTest.p6

二回目のTestSqrtに負数を渡したとき、想定通り失敗しているのがお分かり頂けると思います。しかし、whereの使い方はコレだけではありません。というよりも、今から説明するMulti Method Dispatchとの連携でこ、その真価を発揮するのです。
Perl6では関数のMulti Method Dispatch(MMD)が可能になりました。これはC++やC#で言う所の関数オーバーロードに近い機能で、同名でSignatureの違う関数が宣言できます。この機能と先程紹介した引数の制限を連携すると、与えられた引数の値の範囲によって関数を呼び分けることができます。上記のコードにDispatchを追加してみましょう。Int.sqrt関数は自然数に対して呼び出したときに二乗根を返しますが、負数の呼び出しに対してはNaN(非数)を返します。実数型(Int)+複素数型(Complex)で値が返ってきて欲しい時はInt.roots(Int)を使いましょう。これはレシーバのn乗根を返すメソッドで、この場合は$var.roots(2)です。

  • MultiDispatchTest.p6
# Multi Dispatchする関数はmulti修飾子を付ける
multi sub TestSqrt (Int $var where 0..Inf) {
    return $var.sqrt;
}

# 同名で関数を定義する
multi sub TestSqrt (Int $var where -Inf..^0) {
    return $var.roots(2);
}

say TestSqrt(4);
say TestSqrt(-4);
  • 実行結果
$perl6 MultiDispatchTest.p6
2
1.22464679914735e-16 + 2i -3.67394039744206e-16 + -2i

Int.rootsの実装にバグがあるせいで計算結果は明らかに間違っていますが、引数が負数の時は正しく二番目の定義が呼び出されています。バグに関しては既に報告済みなので、おそらく近いうちに修正されるでしょう。ちなみに複数のDispatchがある場合は全てのSignatureの定義に対して評価を行う(有り体に言えば全てのwhere節の中を実行する)ため相応の時間が掛かりますし、例えばwhere節の中に無限ループ等を書けば処理が帰ってこなくなります。
また、それぞれのDispatchのwhere節を評価した際に、複数のDispatchが該当してしまった場合は以下のようなエラーが出ます。

  • AmbiguousDispatchTest.p6
multi sub TestSqrt (Int $var where 0..Inf) {
    return $var.sqrt;
}

# where節に注目
multi sub TestSqrt (Int $var where -Inf..0) {
    return $var.roots(2);
}

say TestSqrt(4);
say TestSqrt(-4);
say TestSqrt(0);
  • 実行結果
$ perl6 AmbiguousDispatchTest.p6
2
1.22464679914735e-16 + 2i -3.67394039744206e-16 + -2i
Ambiguous dispatch to multi 'TestSqrt'. Ambiguous candidates had signatures:
:(Int $var where ({ ... }))
:(Int $var where ({ ... }))

  in main program body at line 11:AmbiguousDispatchTest.p6

実行時にエラーが出力されているのが分かります。このエラーメッセージの中にMulti Dispatchされている関数のSignatureが列挙されているのですが、残念ながらwhere節の中身は表示してくれないようです。ちなみにAmbiguousな値を引数に渡さないかぎりこのエラーは検出されない(つまり実行前の構文解析は通る)ので、where節の中に複雑な処理を書く場合は注意した方が良いかもしれません。なお、仮引数にリテラルを書くこともできます。

  • LiteralSignatureTest.p6
multi sub TestSqrt (Int $var where 0^..Inf) {
    return $var.sqrt;
}

multi sub TestSqrt (Int $var where -Inf..^0) {
    return $var.roots(2);
}

multi sub TestSqrt (0) {
    return "zero";
}

say TestSqrt(4);
say TestSqrt(-4);
say TestSqrt(0);
  • 実行結果
$ perl6 LiteralSignatureTest.p6
2
1.22464679914735e-16 + 2i -3.67394039744206e-16 + -2i
zero

引数に0を渡した時は、三番目のDispatchが呼ばれました。このように、引数の値によって違う関数を呼び出したい時にはMulti Dispatchは非常に有効です。ただし、where節の中に副作用のあるコードを書く時は要注意です。まずは下のコードを見てください。

  • SideEffectTest.p6
class Test {
    my $state = "Error!";

    multi method SETest (Int $hoge where {($state eq "Error!")}) {
    say $state;}
}

my $TestObj = Test.new();

$TestObj.SETest(0);
  • 実行結果
$ perl6 SideEffectTest.p6
Error!

当たり前のように最初に$stateに格納されている"Error!"が出力されます。では、次のようにDispatchを追加した場合はどうでしょうか？

  • SideEffectTest2.p6
class Test {
    my $state = "Error!";

    # $stateを書き換える
    multi method SETest (Int $hoge where {($state = "Normal") && ($_ != 0)}) {
    say $state;}

    multi method SETest (Int $hoge where {($state eq "Error!")}) {
    say $state;}
}

my $TestObj = Test.new();
$TestObj.SETest(0);
  • 実行結果
$ perl6 SideEffectTest2.p6
Normal
No candidates found to invoke for method 'SETest' on object of type 'Test'; available candidates have signatures:
:(Mu : Int $hoge where ({ ... });; *%_)
:(Mu : Int $hoge where ({ ... });; *%_)

このように１つ目のDispatchのwhere節の中で$stateを書き換えると、本来成功する筈の２つ目のDispatchの呼び出しに失敗してしまいました。普通はこんなことはしないと思いますが、逆に言えばこんなこともできますよ、ということで。とても黒魔術の香りを感じます。何やらエラーメッセージの内容が不思議なことになっているような気もしますが…

書いているうちにかなり長くなってしまいました。まぁ今回はこの辺で。