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";
|
||||
}
|
||||
elsif ($type =~ /^throw::(.*)$/)
|
||||
{
|
||||
die "Uncaught exception $1";
|
||||
}
|
||||
}
|
||||
die "$@";
|
||||
}
|
||||
|
@ -1009,6 +1013,67 @@ sub macro_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 {
|
||||
my ($term) = @_;
|
||||
my @tokens = tokenize($term);
|
||||
|
|
Loading…
Reference in a new issue