Implement macros catch and throw

This commit is contained in:
madmaurice 2021-04-08 21:48:42 +02:00
parent f50550f882
commit 34d4de92f0

View file

@ -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} = \&macro_loop; $macros{loop} = \&macro_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} = \&macro_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} = \&macro_throw;
sub compile { sub compile {
my ($term) = @_; my ($term) = @_;
my @tokens = tokenize($term); my @tokens = tokenize($term);