Skip to content

Commit

Permalink
Perlito5 - misc/perl5_parser refactor
Browse files Browse the repository at this point in the history
  • Loading branch information
@fglock
fglock committed Jul 12, 2024
1 parent 29a1d99 commit efcefe4
Showing 1 changed file with 24 additions and 49 deletions.
73 changes: 24 additions & 49 deletions misc/perl5_parser/perl5_parser.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -150,19 +150,15 @@
my $pos = parse_optional_whitespace( $tokens, $index )->{next};
if ( $tokens->[$pos][0] == PAREN_OPEN() ) {
my $args_expr = parse_term( $tokens, $pos );
if ( $args_expr->{FAIL} || $args_expr->{value}{args} ) {
error( $tokens, $index );
}
error( $tokens, $index ) if $args_expr->{FAIL} || $args_expr->{value}{args};
}
return { type => 'APPLY', value => { name => $name }, next => $index };
};
my $FUNCTION_CALL_BLOCK_ARGUMENT = sub { # argument is a block
my ( $tokens, $index, $name ) = @_;
my $pos = $index;
my $block = parse_statement_block( $tokens, $pos );
if ( $block->{FAIL} ) {
return parse_fail( $tokens, $index );
}
return parse_fail( $tokens, $index ) if $block->{FAIL};
return { type => 'APPLY_BLOCK', value => { name => $name, block => $block }, next => $block->{next} };
};

Expand Down Expand Up @@ -207,9 +203,7 @@
my ( $tokens, $index, $name ) = @_;
my $pos = $index;
my $expr = parse_precedence_expression( $tokens, $pos, $LIST_OPERATOR_PRECEDENCE );
if ( $expr->{FAIL} ) {
return parse_fail( $tokens, $index );
}
return parse_fail( $tokens, $index ) if $expr->{FAIL};
return { type => 'PRINT', value => { name => $name, args => $expr }, next => $expr->{next} };
},
'do' => $FUNCTION_CALL_BLOCK_ARGUMENT,
Expand All @@ -219,18 +213,14 @@
my ( $tokens, $index, $name ) = @_;
my $pos = $index;
my $expr = parse_precedence_expression( $tokens, $pos, $LIST_OPERATOR_PRECEDENCE );
if ( $expr->{FAIL} ) {
return parse_fail( $tokens, $index );
}
return parse_fail( $tokens, $index ) if $expr->{FAIL};
return { type => 'USE', value => { name => $name, args => $expr }, next => $expr->{next} };
},
'no' => sub { # use module;
my ( $tokens, $index, $name ) = @_;
my $pos = $index;
my $expr = parse_precedence_expression( $tokens, $pos, $LIST_OPERATOR_PRECEDENCE );
if ( $expr->{FAIL} ) {
return parse_fail( $tokens, $index );
}
return parse_fail( $tokens, $index ) if $expr->{FAIL};
return { type => 'NO', value => { name => $name, args => $expr }, next => $expr->{next} };
},
);
Expand Down Expand Up @@ -603,10 +593,7 @@ sub parse_precedence_expression {
}
else {
$left_expr = parse_term( $tokens, $index );
if ( $left_expr->{FAIL} ) {
return parse_fail( $tokens, $index );
}
$pos = $left_expr->{next};
return parse_fail( $tokens, $index ) if $left_expr->{FAIL};
$pos = parse_optional_whitespace( $tokens, $left_expr->{next} )->{next};
if ( $tokens->[$pos][0] == END_TOKEN() ) {
return $left_expr;
Expand All @@ -617,25 +604,23 @@ sub parse_precedence_expression {
while ( $tokens->[$pos][0] != END_TOKEN() ) {
$pos = parse_optional_whitespace( $tokens, $pos )->{next};
return parse_fail( $tokens, $index ) if $tokens->[$pos][0] == END_TOKEN();
my $op_value = $tokens->[$pos][1];
my $type = $tokens->[$pos][0];
my $op_pos = $pos;
$op_value = $tokens->[$pos][1];
my $type = $tokens->[$pos][0];
my $op_pos = $pos;

last unless exists $PRECEDENCE{$op_value};
my $precedence = $PRECEDENCE{$op_value};
last if $precedence < $min_precedence;

$pos++;
$pos = parse_optional_whitespace( $tokens, $pos )->{next};
$pos = parse_optional_whitespace( $tokens, $pos + 1 )->{next};

if ( $type == PAREN_OPEN() || $type == CURLY_OPEN() || $type == SQUARE_OPEN() ) { # Handle postfix () [] {}
my $right_expr = parse_term( $tokens, $op_pos );
if ( $right_expr->{FAIL} ) {
return parse_fail( $tokens, $index );
}
$left_expr = { type => 'APPLY_OR_DEREF', value => [ $left_expr, $right_expr ], next => $right_expr->{next} };
$pos = $left_expr->{next};
$pos = parse_optional_whitespace( $tokens, $pos )->{next};
$pos = parse_optional_whitespace( $tokens, $left_expr->{next} )->{next};
next;
}
if ( $type == ARROW() ) { # Handle ->method ->method() ->() ->[] ->{}
Expand All @@ -660,19 +645,17 @@ sub parse_precedence_expression {
$left_expr = { type => 'METHOD_CALL', value => [ $left_expr, $right_expr ], next => $right_expr->{next} };
}
}
$pos = $left_expr->{next};
$pos = parse_optional_whitespace( $tokens, $pos )->{next};
$pos = parse_optional_whitespace( $tokens, $left_expr->{next} )->{next};
next;
} # /arrow
if ( $type == QUESTION() ) { # Handle ternary operator
my $true_expr = parse_precedence_expression( $tokens, $pos, 0 ); # Parse the true branch
if ( $true_expr->{FAIL} ) {
return parse_fail( $tokens, $index );
}
$pos = $true_expr->{next};
$pos = parse_optional_whitespace( $tokens, $pos )->{next};
$pos = parse_optional_whitespace( $tokens, $true_expr->{next} )->{next};
if ( $tokens->[$pos][0] == COLON() ) {
$pos++; # Consume the ':'
$pos++; # Consume the ':'
$pos = parse_optional_whitespace( $tokens, $pos )->{next};
}
else {
Expand Down Expand Up @@ -718,8 +701,7 @@ sub parse_precedence_expression {
else {
$left_expr = { type => 'BINARY_OP', value => [ $op_value, $left_expr, $right_expr ], next => $right_expr->{next} };
}
$pos = $left_expr->{next};
$pos = parse_optional_whitespace( $tokens, $pos )->{next};
$pos = parse_optional_whitespace( $tokens, $left_expr->{next} )->{next};
}
return $left_expr;
}
Expand Down Expand Up @@ -1040,8 +1022,7 @@ sub parse_if_expression {
if ( $tokens->[$pos][1] ne ';' && $tokens->[$pos][1] ne ')' ) {
$expr = parse_precedence_expression( $tokens, $pos, 0 );
error( $tokens, $index ) if $expr->{FAIL};
$pos = $expr->{next};
$pos = parse_optional_whitespace( $tokens, $pos )->{next};
$pos = parse_optional_whitespace( $tokens, $expr->{next} )->{next};
error( $tokens, $index ) if $tokens->[$pos][1] ne ';' && $tokens->[$pos][1] ne ')';
}
return { type => 'IF_CONDITION', value => { delimiter => $tokens->[$pos][1], args => $expr }, next => $pos + 1 };
Expand All @@ -1061,8 +1042,7 @@ sub parse_delimited_expression {
if ( $tokens->[$pos][1] ne $delim ) {
$expr = parse_precedence_expression( $tokens, $pos, $precedence );
error( $tokens, $index ) if $expr->{FAIL};
$pos = $expr->{next};
$pos = parse_optional_whitespace( $tokens, $pos )->{next};
$pos = parse_optional_whitespace( $tokens, $expr->{next} )->{next};
error( $tokens, $index ) if $tokens->[$pos][1] ne $delim;
}
return { type => 'PAREN', value => { delimiter => $start_delim, args => $expr }, next => $pos + 1 };
Expand Down Expand Up @@ -1198,22 +1178,19 @@ sub parse_statement {
my $stmt = $tokens->[$pos][1];
if ( $STATEMENT_COND_BLOCK{$stmt} ) {
my $expr;
$pos = parse_optional_whitespace( $tokens, $pos + 1)->{next};
$pos = parse_optional_whitespace( $tokens, $pos + 1 )->{next};
$expr = parse_if_expression( $tokens, $pos );
if ( $expr->{value}{delimiter} eq ';' ) {
error( $tokens, $index ) if $stmt ne 'for' && $stmt ne 'foreach';
error( $tokens, $index ) if $stmt ne 'for' && $stmt ne 'foreach';
my @expr = ($expr);
$pos = $expr->{next} - 1;
$expr = parse_if_expression( $tokens, $pos );
$expr = parse_if_expression( $tokens, $expr->{next} - 1 );
push @expr, $expr;
$pos = $expr->{next} - 1;
$expr = parse_if_expression( $tokens, $pos );
$expr = parse_if_expression( $tokens, $expr->{next} - 1 );
push @expr, $expr;
$expr = { type => 'THREE_ARG_FOR', value => \@expr, next => $expr->{next} };
}
error( $tokens, $index ) if $expr->{FAIL};
$pos = $expr->{next};
$pos = parse_optional_whitespace( $tokens, $pos )->{next};
$pos = parse_optional_whitespace( $tokens, $expr->{next} )->{next};
my $block = parse_statement_block( $tokens, $pos );
error( $tokens, $index ) if $expr->{FAIL};

Expand All @@ -1239,8 +1216,7 @@ sub parse_statement {
$ast = parse_precedence_expression( $tokens, $pos, 0 );
error( $tokens, $index ) if $ast->{FAIL};

$pos = $ast->{next};
$pos = parse_optional_whitespace( $tokens, $pos )->{next};
$pos = parse_optional_whitespace( $tokens, $ast->{next} )->{next};
if ( $tokens->[$pos][0] == IDENTIFIER() ) { # statement modifier
my $stmt = $tokens->[$pos][1];
if ( $STATEMENT_MODIFIER{$stmt} ) {
Expand All @@ -1253,8 +1229,7 @@ sub parse_statement {
value => { modifier => $stmt, args => $ast, cond => $cond_ast },
next => $cond_ast->{next}
};
$pos = $ast->{next};
$pos = parse_optional_whitespace( $tokens, $pos )->{next};
$pos = parse_optional_whitespace( $tokens, $ast->{next} )->{next};
}
}

Expand Down

0 comments on commit efcefe4

Please sign in to comment.