Simplify parsing of identifiers

This commit is contained in:
madmaurice 2021-04-04 22:55:26 +02:00
parent 02ac5dd3fc
commit 0ec88feeb6

View file

@ -441,6 +441,16 @@ sub parser_expr {
} }
} }
sub parser_identifier {
my $ts = shift;
die "Expected identifier" unless $ts->[0]->{type} == IDENT;
my $tok = shift @$ts;
return $tok->{value};
}
sub parser_list { sub parser_list {
my $ts = shift; my $ts = shift;
@ -513,8 +523,7 @@ sub macro_let {
$tok = shift @$ts; $tok = shift @$ts;
die "Expected pair in parameter list in let" unless $tok->{type} == LPAREN; die "Expected pair in parameter list in let" unless $tok->{type} == LPAREN;
my $ident = shift @$ts; my $ident = parser_identifier($ts);
die "Expected identifier in pair in parameter list in let" unless $ident->{type} == IDENT;
my $assignment; my $assignment;
if ($ts->[0]->{type} == RPAREN) if ($ts->[0]->{type} == RPAREN)
@ -529,7 +538,7 @@ sub macro_let {
$tok = shift @$ts; $tok = shift @$ts;
die "Expected ) after parameter pair" unless $tok->{type} == RPAREN; die "Expected ) after parameter pair" unless $tok->{type} == RPAREN;
$variables->{$ident->{value}} = $assignment; $variables->{$ident} = $assignment;
} }
die "Expected ) after parameter list in let" unless $ts->[0]->{type} == RPAREN; die "Expected ) after parameter list in let" unless $ts->[0]->{type} == RPAREN;
@ -556,9 +565,8 @@ sub macro_lambda {
my @param_list; my @param_list;
while ($ts->[0]->{type} != RPAREN) while ($ts->[0]->{type} != RPAREN)
{ {
$tok = shift @$ts; my $ident = parser_identifier($ts);
die "Expected only identifier in parameter list" unless $tok->{type} == IDENT; push @param_list, $ident;
push @param_list, $tok->{value};
} }
$tok = shift @$ts; $tok = shift @$ts;
@ -640,8 +648,7 @@ $macros{progn} = \&macro_progn;
sub macro_defun { sub macro_defun {
my $ts = shift; my $ts = shift;
my $ident = shift @$ts; my $ident = parser_identifier($ts);
die "Expected identifier in defun" unless $ident->{type} == IDENT;
my $body = macro_lambda($ts); my $body = macro_lambda($ts);
@ -652,10 +659,10 @@ sub macro_defun {
return $fn->(@_); return $fn->(@_);
}; };
my $ictx = ctx_create($ctx, { my $ictx = ctx_create($ctx, {
'$ident->{value}' => $self, '$ident' => $self,
}); });
$fn = $body->($ictx); $fn = $body->($ictx);
ctx_set($ctx, $ident->{value}, $fn); ctx_set($ctx, $ident, $fn);
return $fn; return $fn;
} }
} }