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} = \¯o_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} = \¯o_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);