YAPC::Japan::Online 2022のLTで話したことの補足です。タイトルにあるjust epic. の話は時間内にできたのですが、それ以降の、dot言語をPerlとして解釈させる話をするところで時間切れになったので、この記事でお伝えします。
dot言語はPerl、という気づき
過去に書いたブログ記事を読み返していました。
この記事では、電子レンジラックに家のインフラの殆どが乗っかっている状況が説明されているのですが、ふとdot言語のグラフが目に入ります。
digraph haisen {
電子レンジラック -> 手前コンセント;
冷蔵庫 -> 手前コンセント;
...
}
それまでprototypeを見て回っていたので、点と点が繋がります。これはPerlのプログラムではないでしょうか?
digraph haisen { # 適切なprototypeを指定すればブロックを渡せる
電子レンジラック -> 手前コンセント; # クラスのメソッド呼び出し構文に見える
冷蔵庫 -> 手前コンセント;
...
} # プログラム末尾ならセミコロンは不要
dot言語をPerlとして動かす
点と点がつながったので、あとは実装していきます。実行したらdot言語のプログラム部分を出力するPerlプログラム、という構成にしましょう。
グラフのつながりをクラスメソッドの呼び出しにする箇所をどうするか。頂点の数だけクラスを用意するのは骨が折れそうだし、空白文字を含むクラスが定義できなさそう? ということで動的になんとかできないかを考えます。
存在しないメソッド呼び出しをフックするなら AUTOLOAD メソッドが使えそうですね。そして、あらゆるクラス、つまり UNIVERSAL の AUTOLOAD メソッドを定義してやれば、全てのメソッド呼び出しをグラフの接続関係に変換できそうです。
ということで、やってみたのが以下のコードです。完全なコードはGitHub上にあります。
use strict; use warnings; use utf8; use feature 'say'; binmode(STDOUT, ':utf8'); sub digraph ($) { print 'digraph '; shift->(); } sub haisen (&) { my $sub = shift; my ($pkg, undef, undef, $name) = caller(0); $name =~ s/\A$pkg\:://; my $sub2 = sub { say "$name {"; $sub->(); say '}'; }; $sub2; } sub UNIVERSAL::AUTOLOAD { my ($graph) = $UNIVERSAL::AUTOLOAD; return if $graph =~ /DESTROY/; my ($src, $dst) = map { / / ? qq("$_") : $_ } split /::/, $graph; say ' ', $src, ' -> ', $dst, ';'; } # 中略
Perlとしてコードを実行すると確かにdot言語のコードが生成されます。よかったですね。
グラフ名を自由に変えたい、あるいは間接オブジェクト記法の天啓
さて、これで当初の目的は達成されたのですが、問題点が1つだけあります。グラフ名 (haisen) と同名のサブルーチンを定義する必要がある点です。できればグラフ名を自由に決めて、1回だけ書けばよい、ということにしたいのですが、できるのでしょうか?
試しにhaisenサブルーチンを消してみます。するとこういう出力結果になりました。
% perl dot.pl
電子レンジラック -> 手前コンセント;
冷蔵庫 -> 手前コンセント;
(中略)
エアコン -> エアコン用コンセント;
1 -> haisen;
Can't use string ("1") as a subroutine ref while "strict refs" in use at dot.pl line 9.
digraph
おや、途中までコードが実行されてエラーになっている?? Deparseしてみましょう……
% perl -MO=Deparse dot.pl
use strict;
use warnings;
use utf8;
use feature 'say';
binmode STDOUT, ':utf8';
Wide character in print at /usr/local/Cellar/perl/5.34.0/lib/perl5/5.34.0/B/Deparse.pm line 1772.
sub digraph ($) {
print 'digraph ';
(shift())->();
}
sub UNIVERSAL::AUTOLOAD {
my($graph) = $UNIVERSAL::AUTOLOAD;
return if $graph =~ /DESTROY/;
my($src, $dst) = map({/ / ? qq["$_"] : $_;} split(/::/, $graph, 0));
say ' ', $src, ' -> ', $dst, ';';
}
digraph(do {
"\x{96fb}\x{5b50}\x{30ec}\x{30f3}\x{30b8}\x{30e9}\x{30c3}\x{30af}"->手前コンセント;
"\x{51b7}\x{8535}\x{5eab}"->手前コンセント;
(中略)
"\x{30a8}\x{30a2}\x{30b3}\x{30f3}"->エアコン用コンセント
}->haisen);
dot.pl syntax OK
当然といえば当然ですが、先ほどとはパース結果が変わっています。注目すべきは、digraph サブルーチンにdoブロックの評価結果のオブジェクトの haisen メソッドを呼び出している点です。Perlの間接オブジェクト記法によってこのようになっています。
これをうまく使えないでしょうか? doブロックが返すオブジェクトの haisen メソッドを呼ぶ、という構造をうまく使いたいです。
ということで、以下のような作戦を考えます。
UNIVERSAL::AUTOLOADで出力すべきグラフの文字列をどんどん貯めるUNIVERSAL::AUTOLOADが何らかのクラスのインスタンス (!!) を返す- 「何らかのクラス」の
AUTOLOADメソッドでグラフ名を決める - 最後にまとめて出力する
- 「何らかのクラス」のインスタンスの実体はサブルーチンにして呼び出し可能にする
この方針で実装したのが以下のコードです。これも完全なコードはGitHubにあります。
use strict; use warnings; use utf8; use feature 'say'; binmode(STDOUT, ':utf8'); sub digraph ($) { shift->(); } sub UNIVERSAL::AUTOLOAD { my ($graph) = $UNIVERSAL::AUTOLOAD; return if $graph =~ /DESTROY/; my ($src, $dst) = map { / / ? qq("$_") : $_ } split /::/, $graph; push @Digraph::stash, " $src -> $dst;"; Digraph->new; } package Digraph { our @stash = (); our $GRAPH_NAME = '(anonymous)'; our $AUTOLOAD; sub new { my ($class) = @_; my $self = bless sub { say "digraph $GRAPH_NAME {"; for (@stash) { say $_; } say '}'; }, $class; $self; } sub AUTOLOAD { my ($self) = @_; return if $AUTOLOAD =~ /DESTROY/; my $name = $AUTOLOAD; $name =~ s/\ADigraph\:://; $GRAPH_NAME = $name; $self; } } # 中略
こうすることで、グラフの名前をいくら変えても1箇所だけ書き換えればよくなりました。ありがたい限りですね。
おわりに
dot言語のプログラムをPerlとして動かすための取り組みについて紹介しました。1つ目の手法を思い付いてLTに盛り込んでいたのですが、当日直前になって2つ目の手法を思い付いたので、記念に残します。
