Perlでtry-catch-finally文

Perl

2022/12/30追記: 本記事は「Perlのプロトタイプ宣言を利用してtry-catch-finally文を作る」といった記事です。コメントにある通りTry::Tinyがまさしくこれをちゃんとやっています。

もし「Perlでtry-catch-finallyを行いたい」という場合は次をお読みください。

ryozi.hatenadiary.jp

追記ここまで

サブルーチンのプロトタイプを使えば、

@nums = map { $_ * 2; } @nums;

といった、変った構文を自分で作ることができます。
これを使ってJavaのtry-catch-finally文っぽいものを書いてみました。
catch判定がスマートではないので、もう少し改善したい。。。
Error.pmを参考にした部分もあります。

use strict;
use warnings;

# catch
sub catch(&@){
	my $sub = shift;
	my @subs= @_;
	my $this = sub {
		print "catch Begin\n";
		$sub->(@_);
		print "catch End\n";
	};
	return @subs ? ($this, @subs) : ($this);
}

# 識別子
use constant FINALLY_BLOCK_TYPENAME => 'FinallyBlockType';

# finally
sub finally(&) {
	my $sub = shift;
	return bless sub{
		print "finally Begin\n";
		$sub->();
		print "finally End\n";
	}, FINALLY_BLOCK_TYPENAME;
}

# 最後尾にfinallyがあるはずなので、それをチェックする
sub _findFinally(\@){
	my $proc = pop @{$_[0]};
	# 
	if(ref $proc eq FINALLY_BLOCK_TYPENAME){
		return $proc;
	}
	push @{$_[0]}, $proc;
	return undef;
}

# try
sub try(&@){
	my $try = shift;
	my $finally = _findFinally(@_);
	
	print "try Begin\n";
	
	eval{
		$try->();
	};
	
	print "try End\n";
	
	# try中に例外発生
	if($@){
		my $error = $@;
		foreach my $catch (@_){
			eval{
				$catch->($error);
			};
			if($@){
				next;
			}
			last;
		}
	}
	
	if($finally){
		$finally->();
	}
	return undef;
}

### ###

# try -> catch(Exception) failed -> catch(Died) success!! -> finally
print "\nCase1: test(try-catch(Exception)-catch(Died)-catch(Hoge)-finally)\n";

try {
	print "  try!!\n";
	die;
} catch {
	my $e = shift;
	print "  Exception catch check...\n";
	$e =~ /Exception/ || die;
	print "  catch!!\n";
} catch {
	my $e = shift;
	print "  Died catch check...\n";
	$e =~ /Died/ || die;
	print "  catch!!\n";
} catch {
	my $e = shift;
	print "  Hoge catch check...\n";
	$e =~ /Hoge/ || die;
	print "  catch!!\n";
} finally {
	print "  finally!!\n";
};


print "\nCase2: try-catch(Exception)\n";
try {
	print "  try!!\n";
	die 'Exception';
} catch {
	shift =~ /Exception/ || die;
	print "  catch!!\n";
};


print "\nCase3: try-finally\n";
try {
	print "  try!!\n";
	die 'Exception';
} finally {
	print "  finally!!\n";
};

Case1: test(try-catch(Exception)-catch(Died)-catch(Hoge)-finally)
try Begin
  try!!
try End
catch Begin
  Exception catch check...
catch Begin
  Died catch check...
  catch!!
catch End
finally Begin
  finally!!
finally End

Case2: try-catch(Exception)
try Begin
  try!!
try End
catch Begin
  catch!!
catch End

Case3: try-finally
try Begin
  try!!
try End
finally Begin
  finally!!
finally End

解説的なもの

サブルーチンのプロトタイプについてはperldocが良いでしょう。
perlsub - Perl のサブルーチン - perldoc.jp


まず簡単に構文っぽく書くにはどうサブルーチンを定義すればよいかを確認しました。

use strict;
use warnings;


sub a(&){

}

a {1;};


sub b(&@){

}

b {} (1..3);


sub c(&\@){
	$_[0]->($_[1]);
}

my @list = (1,2,3);

c { print shift @{$_[0]}; } @{[1,2,3]};


sub d(\@&){
	$_[1]->($_[0]);
}

# d @list {}; # syntax error

d @list, sub{ print shift @{$_[0]}; };

sub ff(&@){
	print "ff arg: @_\n";
	my $sub = shift;
	my $this = sub { $sub->(); };
	return @_ ? ($this, @_) : ($this);
}

sub fff(&@){
	shift->();
	print "@_\n";
}

fff {0} ff {1} ff {2} ff {3};

aは思ったとおりです。
bとcは構文は全く同じですが、動作としてはbはリストのコピーを渡すのに対し、
cはリストのリファレンスを渡す(push,pop)ので、リストに操作を行うと呼び出し元のリストにも影響が出ます。
dはb,cのようにmap {} @a;と書くところを map @a {};とかけないか試したものです。しかし、構文エラーでした。


最後のff,fffは今回のtry-catch-finallyの肝となる部分です。
このとき、ffプロトタイプには、1個のCODEと可変長配列を許容するよう(&@)と定義しています。
まず、式は右から評価されます。この場合、ff {3}です。
ffは関数ですから、実行結果を返します。
今回はCODEをラップした形にしていますが、単純にCODEを返していることと同等です。
そして戻り値は、その左の式に返ります。次に実行される式は、
"ff {2} sub{3}" となります。
普通に書くと"ff {2} {3}"は文法エラーで、"ff {2}, sub{3}"としなければならないのですが、なぜか、この場合は後者のように評価されます。
このようにどんどん増えていくので、可変長にしているわけです。
(なので、ff sub{0}, 1, '2', 3.14, \4;などとしても通ります。)
これを使ってtry-catch-finallyを書いていけます。


・異常な文法をエラーにしろとか、
・try内でtryして外側のtryにcatchさせるとか、
・例外条件の書き方がスマートではないとか、
とか、不満はありますが、もう飽きたので、とりあえずこれでいいです。