Implement macros catch and throw
This commit is contained in:
parent
f50550f882
commit
34d4de92f0
1 changed files with 65 additions and 0 deletions
|
@ -439,6 +439,10 @@ sub parser_prog {
|
||||||
{
|
{
|
||||||
die "return from block $1 outside of any block named $1";
|
die "return from block $1 outside of any block named $1";
|
||||||
}
|
}
|
||||||
|
elsif ($type =~ /^throw::(.*)$/)
|
||||||
|
{
|
||||||
|
die "Uncaught exception $1";
|
||||||
|
}
|
||||||
}
|
}
|
||||||
die "$@";
|
die "$@";
|
||||||
}
|
}
|
||||||
|
@ -1009,6 +1013,67 @@ sub macro_loop {
|
||||||
}
|
}
|
||||||
$macros{loop} = \¯o_loop;
|
$macros{loop} = \¯o_loop;
|
||||||
|
|
||||||
|
sub macro_catch {
|
||||||
|
my $ts = shift;
|
||||||
|
|
||||||
|
my $tag_expr = parser_expr($ts);
|
||||||
|
|
||||||
|
my $inner = macro_progn($ts);
|
||||||
|
|
||||||
|
return sub {
|
||||||
|
my $ctx = shift;
|
||||||
|
|
||||||
|
my $tag = $tag_expr->($ctx);
|
||||||
|
|
||||||
|
die "Expected tag expr after catch to evaluate to keyword"
|
||||||
|
unless ref($tag) eq "KEYWORD";
|
||||||
|
|
||||||
|
my $tagname = $tag->{value};
|
||||||
|
|
||||||
|
my $result;
|
||||||
|
eval {
|
||||||
|
$result = $inner->($ctx);
|
||||||
|
};
|
||||||
|
|
||||||
|
if($@) {
|
||||||
|
if (ref($@) eq "throw::$tagname")
|
||||||
|
{
|
||||||
|
return $@->{retval};
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
die $@;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $result;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$macros{catch} = \¯o_catch;
|
||||||
|
|
||||||
|
sub macro_throw {
|
||||||
|
my $ts = shift;
|
||||||
|
|
||||||
|
my $tag_expr = parser_expr($ts);
|
||||||
|
|
||||||
|
my $inner = parser_expr($ts);
|
||||||
|
|
||||||
|
return sub {
|
||||||
|
my $ctx = shift;
|
||||||
|
|
||||||
|
my $tag = $tag_expr->($ctx);
|
||||||
|
|
||||||
|
die "Expected tag expr after throw to evaluate to keyword"
|
||||||
|
unless ref($tag) eq "KEYWORD";
|
||||||
|
|
||||||
|
my $tagname = $tag->{value};
|
||||||
|
|
||||||
|
my $retval = $inner->($ctx);
|
||||||
|
|
||||||
|
die bless({ retval => $retval }, "throw::$tagname");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$macros{throw} = \¯o_throw;
|
||||||
|
|
||||||
sub compile {
|
sub compile {
|
||||||
my ($term) = @_;
|
my ($term) = @_;
|
||||||
my @tokens = tokenize($term);
|
my @tokens = tokenize($term);
|
||||||
|
|
Loading…
Reference in a new issue