正規表現で静的解析するPPR.pmでunused varを実装してみる #Perl

ハローこんにちは、メリークリスマス、まこぴーです。

今回はPPR.pmの紹介をします。

その前に宣伝

来年のYAPC::Tokyo 2019でこういう話をします！！！

「Perl5の静的解析入門　機械と人間双方の歩み寄りによる平和編」っていう題名です。

チケットはこちら: https://passmarket.yahoo.co.jp/event/show/detail/015qs4zxqp35.html

僕のトークプロポーザルはこちら　https://yapcjapan.org/2019tokyo/timetable.html#/detail/2

「あ、なんかPerlじゃなくてもいいけれど静的解析楽しそう」とか「他の言語どうやるんだろう」っていう人も来てください。Goの静的解析のことも少し喋れます。あとめっちゃ長くなったので気になるけれど時間がない人は、会場に来て僕の話を聞いたら1時間で済む。普段Perl書いてない人も楽しめるようにしゃべるので頼みます！！

PPR - Pattern-based Perl Recognizer

Perl5を静的解析する手段としては、過去様々な方法がありました。一番有名なものですと、PPI.pmが挙げられます。PPI.pmはPerl本体のコードを使わずに実装されたPerlスクリプトのパーサーです。Pure Perlであるがゆえに遅いのですが、実績がありPerl::Critic等の静的解析を使ったツールに利用されてきました。

他にもPerl::Lexerというモジュールがあります。このモジュールはXS(C拡張)でPerl本体のAPIを呼び出し、perlコマンドが用いる本物のパーサーを利用しています。

別のアプローチをPPR.pmは取っています。他のモジュールがASTに変換したり、トークン列に区分けするのと違い、PPR.pmは正規表現の補足グループとして引っ掛けたいトークン列を定義します。使う時は普通の正規表現と同じように、文字列のPerlプログラムに対して正規表現のマッチを実行します。

では試していきましょう。

注意

この次の項から出てくるPerlのサンプルコードは以下のコードが上に暗黙的に含まれています。

use strict;
use warnings;
use utf8;
use feature qw/say/;
use PPR;
use DDP;

また、PPR.pmはcpanmで導入可能です。筆者の環境は、plenvを用いて以下のように作りました。また、結果の確認のためにData::Printerも導入しています。

$ plenv install 5.28.1
$ plenv local 5.28.1
$ plenv install-cpanm
$ cpanm PPR DDP

plenvの導入方法については以下の記事を参照してください。

plenvを使ったPerl環境構築〜2018年度版〜

この記事の説明の順番

PPRの使い方を簡単な例から紹介
もう少し複雑なサンプルコードをパースしていく
最後に未使用変数の検査を実装する

PPRを使う

ステートメントと空白のマッチ

まず静的解析の初歩として、1 + 1;というステートメントに対して適用してみます。

my $script = "1 + 1;";

my @result = grep { defined }
    $script =~ m{
        ((?&PerlStatement)) $PPR::GRAMMAR
    }x;

p @result;

$PPR::GRAMMERはおまじないです。具体的に言うとこの中に、ここで使っている(?&PerlStatement)のような、トークン列をマッチさせるためのパターン定義がされています。
(?&PerlStatement)はPerlのステートメントにマッチします。それをさらに(...)で括ってキャプチャできるようにしています。
/xは空白や改行を無視します。コメントも便利に書けるので複雑なパターンを書くときに便利です。

grep { defined }としているのは、返ってくる配列にundefが大量に混ざっているため、フィルタする必要があるからです。
これで結果はこうなります。

[
    [0] "1 + 1;"
]

しかしこれだけだと文字列全体をマッチしているのと変わりません。そこで複数のステートメントを含んだ文字列、1 + 1; 1 + 2;を食わせてみます。どうなるでしょうか。

my $script = "1 + 1; 1 + 2;";

my @result = grep { defined }
    $script =~ m{
        ((?&PerlStatement)) $PPR::GRAMMAR
    }x;

p @result;

[
    [0] "1 + 1;"
]

最初のステートメントしかマッチしていません。そこでこのように/gを加えて複数回マッチするように工夫を加えます。

my $script = "1 + 1; 1 + 2;";

my @result = grep { defined }
    $script =~ m{
        ((?&PerlStatement)) $PPR::GRAMMAR
    }gx;

p @result;

[
    [0] "1 + 1;",
    [1] " 1 + 2;"
]

2つの文がうまくマッチできています。しかし2個目は手前に空白が入ってしまっています。これをどうにか回避しましょう。このように(?&PerlOWS)を付け加えます。

my $script = "1 + 1; 1 + 2;";

my @result = grep { defined }
    $script =~ m{
        (?&PerlOWS) ((?&PerlStatement)) $PPR::GRAMMAR
    }gx;

p @result;

[
    [0] "1 + 1;",
    [1] "1 + 2;"
]

このようにうまく空白を無視することが出来ました。(?&PerlOWS)はゼロ文字以上の空白や改行、コメント、POD、__END__などのセクションにマッチします。キャプチャ対象から外したため、取り除くことが出来たということですね。

リテラルと演算子のマッチ

上記の事柄でステートメントの数を数えたり抜き出したりする事はできました。ここからは、もっと細かい単位のマッチを試していきましょう。

以下のパターン(PPR.pm上ではルールと書かれているので次からはルールと呼称します)を用います。

(&?PerlLiteral) 数字や文字リテラルにマッチします。qrやqwといったクオートで囲まれた文字やリストにもマッチします。
(&?PerlInfixBinaryOperator) 中置二項演算子にマッチします。+とか*とかです。

上の方であらかじめステートメントでバラしているので、ひとつずつマッチさせていきます。スクリプトは以下のようになりました。

my $script = "1 + 1; 1 + 2;";

my @statements = grep { defined }
    $script =~ m{
        (?&PerlOWS) ((?&PerlStatement)) $PPR::GRAMMAR
    }gx;

for my $statement (@statements) {
    my @result = grep { defined }
        $statement =~ m{
            (?&PerlOWS)
                ((?&PerlLiteral)) (?&PerlOWS)
                ((?&PerlInfixBinaryOperator)) (?&PerlOWS)
                ((?&PerlLiteral)) (?&PerlOWS)
                $PPR::GRAMMAR
        }gx;
    p @result;
}

ステートメントの中身は2項演算子とリテラルを用いたものしか含まれない前提の正規表現マッチではあります。やはり空白が含まれるため、(?&PerlOWS)を適宜混ぜていきます。

そして結果はこうなります。

[
    [0] 1,
    [1] "+",
    [2] 1
]
[
    [0] 1,
    [1] "+",
    [2] 2
]

いい感じですね。名前付きキャプチャと組み合わせるとさらにいい感じになります。

my $script = "1 + 1; 1 + 2;";

my @statements = grep { defined }
    $script =~ m{
        (?&PerlOWS) ((?&PerlStatement)) $PPR::GRAMMAR
    }gx;

for my $statement (@statements) {
    my @result = grep { defined }
        $statement =~ m{
            (?&PerlOWS)
                (?<lvalue>(?&PerlLiteral)) (?&PerlOWS)
                (?<operator>(?&PerlInfixBinaryOperator)) (?&PerlOWS)
                (?<rvalue>(?&PerlLiteral)) (?&PerlOWS)
                $PPR::GRAMMAR
        }gx;
    say "rvalue: $+{lvalue}, operator: $+{operator}, rvalue: $+{rvalue}";
}

rvalue: 1, operator: +, rvalue: 1
rvalue: 1, operator: +, rvalue: 2

どうですか、なにかに使えそうな気分になってきませんか？

未使用変数の捕捉

Perl5はスコープを多用する言語です。GCがリファレンスカウントであったり、ifでスコープを作ったり、スコープを切るためだけの生のブロックが存在したりと、スコープは欠かせない存在です。

Perl5でuse strict;がされた環境ではmyを用いた変数宣言をしなければ、その変数は使うことが出来ません。またこの変数は適用されるスコープが静的に決まるレキシカルスコープ変数です。この制限によって、バグを生みにくいコードを書くことが出来ます。

しかしこれらの特徴にも弱点があります。以下のコードをご覧ください。

my $hoge;
if ($is_foo) {
    my $hoge = "bar";
}
say $hoge;

これの結果、出力される$hogeはundefです。「ifがスコープを作る」「myで宣言したらレキシカルスコープ」というように、ifの外側と内側の$hogeは違う変数であり、中で代入したとしても、外側の$hogeには影響がありません。しばしばこのような「ifの内側で変数を入れて外側で使う」ケースが発生しますが、うっかりこのようにしてしまうこともあとが立ちません。

他に似たような特性をもつ言語はないかと見てみると、Goがあります。Goではmyの代わりに:=による変数宣言があり、ifはスコープを作ります。

hoge := ""
if isFoo {
    hoge := "bar"
}

fmt.Println(hoge)

Goでも同様のことが起こります。しかし、このような事故を防ぐ一つの対策として、コンパイル時に未使用変数の検査が走ります。ifブロック内のhogeのような宣言したものの他では使われていない変数を調べて、あった場合にはコンパイルを失敗させます。

この検査はコードをきれいにしたりデッドコードをなくすなどの目的も大きいのですが、こういったバグを起こしにくくする効果もあると思います。

さて、ここではサンプルコードを対象に、Perlのなかの限られたケースのみをターゲットにして、未使用変数の検査を実装していきます。

未使用変数の検査に必要な機能

変数宣言の列挙
変数が使われている場所を列挙
スコープを意識しつ未使用変数を見つける

変数宣言の列挙

Perl5でuse strict;がされた環境ではmyを用いた変数宣言をしなければ、その変数は使うことが出来ません。ここではスクリプト内で宣言された変数を列挙してみます。

少し複雑なスクリプトを使いたいなということで、定番のフィボナッチ数列を出してくれる君に登場してもらいます。

fib.pl

use strict;
use warnings;
use utf8;

use feature qw/say/;

my $i = -1;
my $f0 = 0;
my $f1 = 1;

my $fib = sub {
    $i++;
    return "$i: 1" if $i == 0;
    my $res = $f0 + $f1;
    ($f0, $f1) = ($f1, $res);
    return "$i: ". $res;
};

for (0..10) {
    say $fib->();
}

無駄にクロージャを使って実行すれば実行するほど次の数列を出すという感じになっています。

$ perl fib.pl
0: 1
1: 1
2: 2
3: 3
4: 5
5: 8
6: 13
7: 21
8: 34
9: 55
10: 89

このスクリプトをPPRで組み立てた正規表現に食わせて、宣言されている変数名を列挙するスクリプトを作ります。

ファイル読むのにopenとかめんどいので、File::Slurpをcpanmで導入しておきます。

$ cpanm File::Slurp

そしてここからは、

use File::Slurp qw/slurp/;

というuseがスクリプトの先頭に加わるので注意してください。

まず、上の例にならってステートメントを列挙してみましょう。

my $script = slurp("fib.pl");

my @statements = grep { defined }
    $script =~ m{
        \G (?&PerlOWS) ((?&PerlStatement)) $PPR::GRAMMAR
    }gx;

p @statements;

\Gが加わっていますが、おまじないです。どういう効能があるのか、僕もちょっとうまく説明出来ませんが、PPR.pmのドキュメントには使われているのでならうことにします。

さて、これを実行するとどうなるかと言うと、

[
    [0] "use strict;",
    [1] "use warnings;",
    [2] "use utf8;",
    [3] "use feature qw/say/;",
    [4] "my $i = -1;",
    [5] "my $f0 = 0;",
    [6] "my $f1 = 1;",
    [7] "my $fib = sub {
    $i++;
    return "$i: 1" if $i == 0;
    my $res = $f0 + $f1;
    ($f0, $f1) = ($f1, $res);
    return "$i: $res";
};",
    [8] "for (0..10) {
    say $fib->();
}"
]

なるほどです。useの宣言が続いて、その後に変数宣言のステートメントがあります。さらに無名関数を作る定義が丸々1個になっています。これは変数宣言だからですね。右辺のブロックは分解しないといけません。

さらに、繰り返しが続きますが、これもまるまる一つのステートメント扱いですね。

さあさあここからやっていきますよ。

やりたいのは変数宣言の列挙でしたね。変数への値の割当をキャプチャするそのものズバリな(?&PerlAssignment)というルールがあります。ステートメントごとに使ってみましょう。

my $script = slurp("fib.pl");

my @statements = grep { defined }
    $script =~ m{
        \G (?&PerlOWS) ((?&PerlStatement)) $PPR::GRAMMAR
    }gx;

for my $statement (@statements) {
    my @result = grep { defined }
        $statement =~ m{
            \G (?&PerlOWS) ((?&PerlAssignment)) $PPR::GRAMMAR
        }gx;
    next if scalar(@result) == 0;
    p @result;
}

[
    [0] "my $i = -1"
]
[
    [0] "my $f0 = 0"
]
[
    [0] "my $f1 = 1"
]
[
    [0] "my $fib = sub {
    $i++;
    return "$i: 1" if $i == 0;
    my $res = $f0 + $f1;
    ($f0, $f1) = ($f1, $res);
    return "$i: $res";
}"
]

変数宣言だけを補足することが出来ましたね。ただ、(?&PerlAssignment)はやりたいことと若干違っていて、すでにある変数に代入したり、++したりするのもとっ捕まえてしまいます。

では、もう少しフィルタを加えて、myで宣言しているもののみキャプチャしましょう。さらに変数名も取ります。

my $script = slurp("fib.pl");

my @statements = grep { defined }
    $script =~ m{
        \G (?&PerlOWS) ((?&PerlStatement)) $PPR::GRAMMAR
    }gcx;

for my $statement (@statements) {
    my @assignments = grep { defined }
        $statement =~ m{
            \G (?&PerlOWS) ((?&PerlAssignment)) $PPR::GRAMMAR
        }gx;
    next if scalar(@assignments) == 0;

    for my $assignment (@assignments) {
        my ($variable, $assignment) = grep { defined }
            $assignment =~ m{
                \G (?&PerlOWS)
                    my (?&PerlOWS)
                    (?:(?&PerlBareword) (?&PerlOWS))?
                    ((?&PerlLvalue)) (?&PerlOWS)
                    (?:
                        (?&PerlAssignmentOperator) (?&PerlOWS)
                        ((?&PerlStatement)) (?&PerlOWS)
                    )?
                    $PPR::GRAMMAR
            }gx;
        next unless $variable;

        $variable =~ s/[()]//g;
        my @variables = map { s/\A\s//gr } split ",", $variable;
        p @variables;
    }
}

やたら長くなってきましたね。myは組み込み関数なので(?&PerlBuiltinFunction)でも引っ掛けられると思いますが(試していません)、今回はmyに限定するので文字列でmyって書いちゃいます。ただの正規表現なのでこういうことができます。

変数名をキャプチャするところですが、(?&PerlVariable)というそのものがあるのですが、Perlは一度に複数の変数を宣言することができるので、(?&PerlLvalue)を用いて複数の宣言に対応します。その後にバラさないといけないんですが、()を取り除いたあとにsplitしてます。PPRでやりたかったのですが、うまく行かなかったので手を抜いています。

あと、myのあとに(?&PerlBareword)を0個か1個くると想定しているのは、Perlはここに裸の文字列を突っ込むことができるからです。主にパッケージ名が想定されているようです(ex.my PackageName $hoge)。他にもfieldsプラグマに関係しているようですが、それ以外では僕はTheSchwartzでしか見たことがないです。あとあんまりこれは意味がないらしく、読む人向けの書き方みたいです。

あと他にもAttributeをつけられたり(my $i : foo)するのですが、Attributeつけてるのは見たことがなく、もう力尽きたのでこれで勘弁してください。

さて、結果はと言うと、

[
    [0] "$i"
]
[
    [0] "$f0"
]
[
    [0] "$f1"
]
[
    [0] "$fib"
]

お、いーですね〜。

変数宣言を見つけられたのですが、右辺値の無名関数の中であったり、forループの中が見落とされています。

まずは変数宣言の右辺値です。リテラルであれば切り捨てて、リテラルじゃなければパースするという戦略で行ってみます。

リテラルだけかどうかじゃないかを判定します。(ここからコード片になりますが、最後にがっちゃんこしたものをお見せします)。

        my $matcher_literal = qr{
            \G (?&PerlOWS) ((?&PerlLiteral)) (?&PerlOWS) $PPR::GRAMMAR
        }x;
        if (scalar(grep{ defined } $assignment =~ m{$matcher_literal}gx)) {
            next;
        }

無名関数かどうかのチェックを入れます。今回の題材のコードを狙い撃ちしていますが。。。

        my $matcher_anon_subroutine = qr{
            \G (?&PerlOWS) ((?&PerlAnonymousSubroutine)) (?&PerlOWS) $PPR::GRAMMAR
        }x;
        if (scalar(grep{ defined } $assignment =~ m{$matcher_anon_subroutine}gx)) {
            warn $assignment;
            my ($block) = grep { defined }
                $assignment =~ m{
                    \G (?&PerlOWS)
                        sub (?&PerlOWS)
                        \{ (?&PerlOWS)
                        ((?&PerlStatementSequence)) (?&PerlOWS)
                        \} (?&PerlOWS)
                    $PPR::GRAMMAR
                }gcx;
            my $result = inspect_block($block);
        }

やっていることとしてはsub { ... }で、外側を外して...だけ取り出すという操作です。その後にinspect_blockという関数に渡しちゃいます。

で、inspect_blockは定義していないのですが、今回のパーサー全体をそういう名前にして、再帰できるようにします。

my $script = slurp("fib.pl");

my $result = inspect_block($script);

sub inspect_block {
    my $block = shift;

    my (@declares, @usings);

    ...

    return {
        declare_variables => \@declares,
        using_variables => \@usings,
    };
}

これでブロック内を再帰的に探索できます。

同じようにforループに対してもケアしておきます。forループは右辺値ではないですから、先ほどとはループの外側で検査をします。


        my $matcher_control_block = qr{
            \G (?&PerlOWS) ((?&PerlControlBlock)) (?&PerlOWS) $PPR::GRAMMAR
        }x;
        if (scalar(grep{ defined } $statement =~ m{$matcher_control_block}gx)) {
            my ($modifier, $block) = grep { defined }
                $statement =~ m{
                    \G (?&PerlOWS)
                        ((?&PerlStatementModifier)) (?&PerlOWS)
                        \{ (?&PerlOWS)
                        ((?&PerlStatementSequence)) (?&PerlOWS)
                        \} (?&PerlOWS)
                    $PPR::GRAMMAR
                }gx;
            my $result = inspect_block($block);
            push @declares, $result->{declares}->@*;
            push @usings, $result->{usings}->@*;

            next;
        }

modifierにはこのサンプルコードで言うとfor (0..10)が引っかかります。doやevalを引っ掛けたい場合はやはり右辺値の検査にこのコードを入れる必要があるでしょう。

これで結果は、

\ {
    declares   [
        [0] "$i",
        [1] "$f0",
        [2] "$f1",
        [3] "$fib",
        [4] "$res"
    ],
    usings     []
}

となります。無名関数の中までちゃんと調べることが出来ていますね。

変数を使っている場所を探す

長くなったのでまずコード片を見せます。


        my @terms = grep { defined }
            $statement =~ m{
                (?&PerlOWS) ((?&PerlTerm)) (?&PerlOWS) $PPR::GRAMMAR
            }gx;

        for my $term (@terms) {
            if (grep { defined } $term =~ m{$matcher_anon_subroutine}gx) {
                next;
            }

            my $variable_matcher = qr{
                (?&PerlOWS) ((?&PerlScalarAccessNoSpaceNoArrow))(?&PerlComma)?
                (?:(?&PerlOWS) ((?&PerlVariable)))?
                (?&PerlOWS) $PPR::GRAMMAR
            }x;
            my @variables = grep { defined } $term =~ $variable_matcher;
            @variables = map { s/\s+\z//gr } @variables;

            push @usings, @variables;
        }

$statementはステートメントごとに分解した文字列です。これを(?&PerlTerm)に分解します。これはまあ汎用的な式の列と思えばいいです。じゃあ(?&PerlExpression)とどう違うのかというのがまだ分かってないですが。

説明にはこう書いてあります。

Matches a simple high-precedence term within a Perl expression. That is: a subroutine or builtin function call; a variable declaration; a variable or typeglob lookup; an anonymous array, hash, or subroutine constructor; a quotelike or numeric literal; a regex match; a substitution; a transliteration; a do or eval block; or any other expression in surrounding parentheses.

無名関数はちょっと都合が悪いので飛ばします。

さらにそこから(?&PerlVariable)で変数を抜き出します。(?&PerlScalarAccessNoSpaceNoArrow)を使っているのは最後の$fib->()で(?&PerlVariable)だと->()も含まれてくるため。さらにカンマとか二個目が現れているのは、($f0, $f1) = ($f1, $res);に対応するためです。ちょっと汎用的ではない無理矢理な感じですがこれでいけます。

\ {
    declares   [
        [0] "$i",
        [1] "$f0",
        [2] "$f1",
        [3] "$fib",
        [4] "$res"
    ],
    usings     [
        [0]  "$i",
        [1]  "$f0",
        [2]  "$f1",
        [3]  "$fib",
        [4]  "$i",
        [5]  "$i",
        [6]  "$i",
        [7]  "$res",
        [8]  "$f0",
        [9]  "$f1",
        [10] "$f0",
        [11] "$f1",
        [12] "$f1",
        [13] "$res",
        [14] "$i",
        [15] "$fib"
    ]
}

これで列挙が出来ました。

スコープを意識しつ未使用変数を見つける

ここまでくればあとは数え上げるだけです。ただ、課題は一つあります。スコープを意識することです。

今回はスコープが新しく作られる時はinspect_blockが呼び出されるときということになっています。なので、それに従えばいいでしょう。

まず、%global_refcount, %local_refcount, %child_refcountと3つの参照カウントを持つ変数を導入します。

それぞれの役割は、

%global_refcount: 自分のスコープの外で宣言された変数に対する参照カウント
%local_refcount: 自分のスコープ内で宣言された変数に対する参照カウント
%child_refcount: 自分のスコープのさらに内側のスコープに対してinspect_blockを呼び出したときに返ってきた%global_refcountをマージした合計

です。

具体的にはこんな感じのコードです。

    my (%local_refcount, %global_refcount, %child_refcount);

    ...;

    my $result = inspect_block($block);
    my $refcount = $result->{global_refcount};
    $child_refcount{$_} += $refcount->{$_} for keys %$refcount;

    ...;

    push @usings, (map { ($_) x $child_refcount{$_} } keys %child_refcount);
    for my $using (@usings) {
        if (grep { $using eq $_ } @declares) {
            $local_refcount{$using}++;
        }
        else {
            $global_refcount{$using}++;
        }
    }

    for my $vn (keys %local_refcount) {
        if ($local_refcount{$vn} == 1) {
            say "$vn is unused variable.";
        }
    }

はい、もうunused varの検査もしてますね。%local_refcountの値は宣言も含まれるので1に等しければ、使われていないことがわかります。

さて、これで完成です。

試しに、サンプルコードに意地悪をしてみましょう。

my $fib = sub {
    my $i;
    $i++;
    return "$i: 1" if $i == 0;
    my $res = $f0 + $f1;
    ($f0, $f1) = ($f1, $res);
    return "$i: ". $res;
};

my $iが新たに宣言されているため、この$iは一生1で表示されます。このコードを、完成版にかけてみると、

$i is unused variable.

どの$iだかわからないですが、ちゃんと検知することが出来ました。

完成版はこちらです。

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use feature qw/say/;
use PPR;
use DDP;
use File::Slurp qw/slurp/;

my $script = slurp("fib.pl");

inspect_block($script);

sub inspect_block {
    my $block = shift;

    my (@declares, @usings);
    my (%local_refcount, %global_refcount, %child_refcount);

    my $matcher_anon_subroutine = qr{
        \G (?&PerlOWS) ((?&PerlAnonymousSubroutine)) (?&PerlOWS) $PPR::GRAMMAR
    }x;

    my @statements = grep { defined }
        $block =~ m{
            \G (?&PerlOWS) ((?&PerlStatement)) $PPR::GRAMMAR
        }gx;

    for my $statement (@statements) {
        my $use_matcher = qr{
            \G (?&PerlOWS) ((?&PerlUseStatement)) $PPR::GRAMMAR
        }x;
        if (grep { defined } $statement =~ qr/$use_matcher/x) {
            next;
        }

        my $matcher_control_block = qr{
            \G (?&PerlOWS) ((?&PerlControlBlock)) (?&PerlOWS) $PPR::GRAMMAR
        }x;
        if (scalar(grep{ defined } $statement =~ m{$matcher_control_block}gx)) {
            my ($modifier, $block) = grep { defined }
                $statement =~ m{
                    \G (?&PerlOWS)
                        ((?&PerlStatementModifier)) (?&PerlOWS)
                        \{ (?&PerlOWS)
                        ((?&PerlStatementSequence)) (?&PerlOWS)
                        \} (?&PerlOWS)
                    $PPR::GRAMMAR
                }gx;
            my $result = inspect_block($block);
            my $refcount = $result->{global_refcount};
            $child_refcount{$_} += $refcount->{$_} for keys %$refcount;

            next;
        }

        my @terms = grep { defined }
            $statement =~ m{
                (?&PerlOWS) ((?&PerlTerm)) (?&PerlOWS) $PPR::GRAMMAR
            }gx;

        for my $term (@terms) {
            if (grep { defined } $term =~ m{$matcher_anon_subroutine}gx) {
                next;
            }

            my $variable_matcher = qr{
                (?&PerlOWS) ((?&PerlScalarAccessNoSpaceNoArrow))(?&PerlComma)?
                (?:(?&PerlOWS) ((?&PerlVariable)))?
                (?&PerlOWS) $PPR::GRAMMAR
            }x;
            my @variables = grep { defined } $term =~ $variable_matcher;
            @variables = map { s/\s+\z//gr } @variables;

            push @usings, @variables;
        }

        my @assignments = grep { defined }
            $statement =~ m{
                \G (?&PerlOWS) ((?&PerlAssignment)) $PPR::GRAMMAR
            }gx;

        for my $assignment (@assignments) {
            my ($assign_variable, $assignment) = grep { defined }
                $assignment =~ m{
                    \G (?&PerlOWS)
                        my (?&PerlOWS)
                        (?:(?&PerlBareword) (?&PerlOWS))?
                        ((?&PerlLvalue)) (?&PerlOWS)
                        (?:
                            (?&PerlAssignmentOperator) (?&PerlOWS)
                            ((?&PerlStatement)) (?&PerlOWS)
                        )?
                        $PPR::GRAMMAR
                }gx;
            next unless $assign_variable;

            $assign_variable =~ s/[()]//g;
            my @assign_variables = map { s/\A\s//gr } split ",", $assign_variable;
            push @declares, @assign_variables;

            next unless $assignment;

            my $matcher_literal = qr{
                \G (?&PerlOWS) ((?&PerlLiteral)) (?&PerlOWS) $PPR::GRAMMAR
            }x;
            if (scalar(grep{ defined } $assignment =~ m{$matcher_literal}gx)) {
                next;
            }

            if (scalar(grep{ defined } $assignment =~ m{$matcher_anon_subroutine}gx)) {
                my ($block) = grep { defined }
                    $assignment =~ m{
                        \G (?&PerlOWS)
                            sub (?&PerlOWS)
                            \{ (?&PerlOWS)
                            ((?&PerlStatementSequence)) (?&PerlOWS)
                            \} (?&PerlOWS)
                        $PPR::GRAMMAR
                    }gx;
                my $result = inspect_block($block);
                my $refcount = $result->{global_refcount};
                $child_refcount{$_} += $refcount->{$_} for keys %$refcount;
            }
        }
    }
    push @usings, (map { ($_) x $child_refcount{$_} } keys %child_refcount);
    for my $using (@usings) {
        if (grep { $using eq $_ } @declares) {
            $local_refcount{$using}++;
        }
        else {
            $global_refcount{$using}++;
        }
    }

    for my $vn (keys %local_refcount) {
        if ($local_refcount{$vn} == 1) {
            say "$vn is unused variable.";
        }
    }

    return {
        local_refcount => \%local_refcount,
        global_refcount => \%global_refcount,
    };
}

このコードの問題点

使ったあとに`my`を宣言されると誤検知する

my $fib = sub {
    $i++;
    return "$i: 1" if $i == 0;
    my $res = $f0 + $f1;
    ($f0, $f1) = ($f1, $res);
    my $i = 0;
    return "$i: ". $res;
};

こんな感じで、スコープの前後で$iが所属しているスコープが変わってしまっている場合ですが、これは正しいコードです(動作はバグってますが)。しかし、どの変数も1回は触っているのにもかかわらず、$i is unused variable.と表示されます。スコープの中は前後関係を見ずに一緒くたにしているためこうなります。参照カウントを数えるのを最後に一気にやるのではなく、都度どちらのスコープに所属するかを考えながら加算していくようにすればうまくいきそうです。

文字列リテラル内の変数

$fibの最後のreturn "$i: ".$resですが、return "$i: $res"とすると、2個目の$resをうまくキャプチャすることが出来ません。文字列リテラル内に複数含まれるケースはもう少しPPR.pmの挙動を把握していないと難しそうです。

まとめ

PPR.pmを使うとPerlのコードを正規表現で引っ掛けることができるよ
置換とかには向いているけれど、こういうやつはPPIでやったほうが楽かもしれないよ
年末年始に筆者はもっと精進してPPR.pmの挙動を把握します
こういう静的解析やるとperlコマンドの気持ちになれて、いつもお世話になっていますという気分になれるよ

最後に宣伝

はい、2度目の宣伝です。

来年のYAPC::Tokyo 2019でこういう話をします！！！　なんとまだチケット買えます！！！ 1/26です！