madmaurice/Minilisp.pm
1
1
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add slurp_token for easier parsing

Browse source
This commit is contained in:
madmaurice 2021-04-06 21:11:13 +02:00
parent c954f0216f
commit b14ed6d9d1
1 changed files with 20 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
lib/Minilisp.pm
View file

@ -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);