From b14ed6d9d1395a03f4b9d5be3c378e6697cc56d9 Mon Sep 17 00:00:00 2001
From: MadMaurice <madmaurice@zom.bi>
Date: Tue, 6 Apr 2021 21:11:13 +0200
Subject: [PATCH] Add slurp_token for easier parsing

---
 lib/Minilisp.pm | 53 +++++++++++++++++++------------------------------
 1 file changed, 20 insertions(+), 33 deletions(-)

diff --git a/lib/Minilisp.pm b/lib/Minilisp.pm
index 86b3dfd..4d87069 100644
--- a/lib/Minilisp.pm
+++ b/lib/Minilisp.pm
@@ -463,21 +463,21 @@ sub parser_expr {
     }
 }
 
-sub parser_identifier {
+sub slurp_token {
   my $ts = shift;
-
-  die "Expected identifier" unless $ts->[0]->{type} == IDENT;
-
+  my $expected_type = shift;
+  my $msg = shift || "Expected $expected_type";
   my $tok = shift @$ts;
 
-  return $tok->{value};
+  die "$msg" unless $tok->{type} == $expected_type;
+
+  return $tok;
 }
 
 sub parser_list {
   my $ts = shift;
 
-  my $tok = shift @$ts;
-  die "Missing ( after ' for list" unless $tok->{type} == LPAREN;
+  slurp_token($ts, LPAREN, "Expected ( after ' for list");
 
   my @elements;
   while ($ts->[0]->{type} != RPAREN)
@@ -485,7 +485,7 @@ sub parser_list {
       push @elements, parser_expr($ts);
     }
 
-  shift @$ts; # Drop RPAREN
+  slurp_token($ts, RPAREN, "Expected ) after list");
 
   return sub {
     my $ctx = shift;
@@ -506,8 +506,7 @@ sub parser_call {
         {
           shift @$ts;
           my $parsed = $macros{$name}->($ts);
-          my $rpar = shift @$ts;
-          die "Expected ) after macro $name" unless $rpar->{type} == RPAREN;
+          slurp_token($ts, RPAREN, "Expected ) after macro $name");
           return $parsed;
         }
     }
@@ -521,9 +520,7 @@ sub parser_call {
       push @params, parser_expr($ts);
     }
 
-  my $tok = shift @$ts;
-
-  die "Missing )" unless $tok->{type} == RPAREN;
+  slurp_token($ts, RPAREN, "Expecte ) after call");
 
   return sub {
     my $ctx = shift;
@@ -537,17 +534,15 @@ sub gen_macro_let {
   return sub {
     my $ts = shift;
 
-    my $tok = shift @$ts;
-    die "Expected ( after let" unless $tok->{type} == LPAREN;
+    slurp_token($ts, LPAREN, "Expected ( after let");
 
     my @assignments;
 
     while ($ts->[0]->{type} != RPAREN)
       {
-        $tok = shift @$ts;
-        die "Expected pair in parameter list in let" unless $tok->{type} == LPAREN;
+        slurp_token($ts, LPAREN, "Expected ( before assignment in let");
 
-        my $ident = parser_identifier($ts);
+        my $ident = slurp_token($ts, IDENT)->{value};
 
         my $expr;
         if ($ts->[0]->{type} == RPAREN)
@@ -559,8 +554,7 @@ sub gen_macro_let {
             $expr = parser_expr($ts)
           }
 
-        $tok = shift @$ts;
-        die "Expected ) after parameter pair" unless $tok->{type} == RPAREN;
+        slurp_token($ts, RPAREN, "Expected ) after assignment in let");
 
         push @assignments, {
           ident => $ident,
@@ -568,8 +562,7 @@ sub gen_macro_let {
         };
       }
 
-    die "Expected ) after parameter list in let" unless $ts->[0]->{type} == RPAREN;
-    shift @$ts;
+    slurp_token($ts, RPAREN);
 
     my $inner = macro_progn($ts);
 
@@ -588,23 +581,19 @@ $macros{'let*'} = gen_macro_let(1);
 sub macro_lambda {
   my $ts = shift;
 
-  my $tok = shift @$ts;
-  die "Expected ( after lambda keyword" unless $tok->{type} = LPAREN;
+  slurp_token($ts, LPAREN, "Expected ( after lambda keyword");
 
   my @param_list;
   while ($ts->[0]->{type} != RPAREN)
     {
-      my $ident = parser_identifier($ts);
+      my $ident = slurp_token($ts, IDENT)->{value};
       push @param_list, $ident;
     }
 
-  $tok = shift @$ts;
-  die "Expected ) after parameter list in lambda" unless $tok->{type} = LPAREN;
+  slurp_token($ts, RPAREN, "Expected ) after parameter list in lambda");
 
   my $body = parser_expr($ts);
 
-  die "Expected ) after lambda" unless $ts->[0]->{type} == RPAREN;
-
   return sub {
     my $octx = shift;
     return sub {
@@ -637,8 +626,6 @@ sub macro_if {
 
   my $fbranch = parser_expr($ts);
 
-  die "Expected ) after else expression" unless $ts->[0]->{type} == RPAREN;
-
   return sub {
     my $ctx = shift;
 
@@ -677,7 +664,7 @@ $macros{progn} = \&macro_progn;
 sub macro_defun {
   my $ts = shift;
 
-  my $ident = parser_identifier($ts);
+  my $ident = slurp_token($ts, IDENT)->{value};
 
   my $body = macro_lambda($ts);
 
@@ -775,7 +762,7 @@ $macros{unless} = \&macro_unless;
 sub macro_set {
   my $ts = shift;
 
-  my $ident = parser_identifier($ts);
+  my $ident = slurp_token($ts, IDENT, "Expected identifier after set")->{value};
 
   my $expr = parser_expr($ts);