diff --git a/lib/Minilisp.pm b/lib/Minilisp.pm index f0bfa5d..1429637 100644 --- a/lib/Minilisp.pm +++ b/lib/Minilisp.pm @@ -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);