From 34d4de92f0f6234b8a229190d4235d3346a35d17 Mon Sep 17 00:00:00 2001
From: MadMaurice <madmaurice@zom.bi>
Date: Thu, 8 Apr 2021 21:48:42 +0200
Subject: [PATCH] Implement macros catch and throw

---
 lib/Minilisp.pm | 65 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 65 insertions(+)

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} = \&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 {
   my ($term) = @_;
   my @tokens = tokenize($term);