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