Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Perlito5 - pretty-printer precedence, special cases
  • Loading branch information
@fglock
fglock committed Oct 4, 2013
1 parent 913bc28 commit e1b541e
Showing 1 changed file with 77 additions and 30 deletions.
107 changes: 77 additions & 30 deletions misc/pretty_print.pl
View file
Expand Up @@ -3,14 +3,19 @@

package Perlito5::PrettyPrint {

use Data::Dumper;

my %dispatch = (
stmt => \&statement,
block => \&block,
keyword => \&keyword,
op => \&op,
paren => \&paren,
stmt => \&statement, # if (expr) {stms}
block => \&block, # {stmts}
keyword => \&keyword, # if
op => \&op, # expr
paren => \&paren, # (expr)
paren_semicolon => \&paren_semicolon, # (expr;expr;expr)
);

my %pair = (
'(' => ')',
'[' => ']',
'{' => '}',
);

my %op = (
Expand All @@ -31,10 +36,37 @@ package Perlito5::PrettyPrint {
'infix:<!~>' => { fix => 'infix', prec => 4, str => ' !~ ' },

'infix:<*>' => { fix => 'infix', prec => 5, str => ' * ' },
'infix:</>' => { fix => 'infix', prec => 5, str => ' / ' },
'infix:<%>' => { fix => 'infix', prec => 5, str => ' % ' },
'infix:<x>' => { fix => 'infix', prec => 5, str => ' x ' },

'infix:<+>' => { fix => 'infix', prec => 6, str => ' + ' },
'infix:<->' => { fix => 'infix', prec => 6, str => ' - ' },
'list:<.>' => { fix => 'list', prec => 6, str => ' . ' },

'infix:<<<>' => { fix => 'infix', prec => 7, str => ' << ' },
'infix:<>>>' => { fix => 'infix', prec => 7, str => ' >> ' },

# TODO - named unary, -X

'infix:<lt>' => { fix => 'infix', prec => 9, str => ' lt ' },
'infix:<le>' => { fix => 'infix', prec => 9, str => ' le ' },
'infix:<gt>' => { fix => 'infix', prec => 9, str => ' gt ' },
'infix:<ge>' => { fix => 'infix', prec => 9, str => ' ge ' },
'infix:<<=>' => { fix => 'infix', prec => 9, str => ' <= ' },
'infix:<>=>' => { fix => 'infix', prec => 9, str => ' >= ' },
'infix:<<>' => { fix => 'infix', prec => 9, str => ' < ' },
'infix:<>>' => { fix => 'infix', prec => 9, str => ' > ' },

# TODO - more operators

'infix:<=>' => { fix => 'infix', prec => 19, str => ' = ' },

'infix:<=>>' => { fix => 'infix', prec => 20, str => ' => ' },
'list:<,>' => { fix => 'list', prec => 20, str => ', ' },

# TODO - more operators

'list:<,>' => { fix => 'list', prec => 9, str => ', ' },
);

my %tab;
Expand All @@ -55,13 +87,12 @@ package Perlito5::PrettyPrint {
my ( $data ) = @_;
return 1 if !ref($data);
return 0 if $data->[0] eq 'block';
return 1 if $data->[0] ne 'stmt';
return 1 if $data->[0] ne 'stmt'; # stmt => [ keyword => 'if' ],
if (ref($data->[1])) {
my $dd = $data->[1]; # stmt => [ keyword => 'if' ],
my $dd = $data->[1]; # [ keyword => 'if' ],
if ($dd->[0] eq 'keyword') {
if ($dd->[1] eq 'if' || $dd->[1] eq 'for' || $dd->[1] eq 'while') {
return 0;
}
return 0
if $dd->[1] eq 'if' || $dd->[1] eq 'for' || $dd->[1] eq 'while';
}
}
return 1;
Expand All @@ -82,9 +113,8 @@ package Perlito5::PrettyPrint {

sub op {
my ( $data, $level, $out ) = @_;
my $cmd = $data->[0];
my $op = $data->[1];
my $spec = $op{$op} || {};
my $spec = $op{$op} || die "unknown op: $op";
if ($spec->{fix} eq 'infix') {
op_render( $data->[2], $level, $out, $spec );
push @$out, $spec->{str};
Expand All @@ -105,18 +135,37 @@ package Perlito5::PrettyPrint {
}
}
else {
die "unknown op: $op";
die "unknown fixity: $spec->{fix}";
}
return;
}

sub paren {
my ( $data, $level, $out ) = @_;
my @dd = @$data;
shift @dd;
my $open = $dd[0];
$dd[0] = 'list:<,>';
push @$out, '(';
push @$out, $open;
op( [ op => @dd ], $level, $out );
push @$out, ')';
push @$out, $pair{$open};
}

sub paren_semicolon {
my ( $data, $level, $out ) = @_;
push @$out, $data->[1];
for my $line ( 2 .. $#$data ) {
op( $data->[$line], $level, $out ) if @{ $data->[$line] };
if ($line != $#$data) {
if (@{ $data->[$line+1] }) {
push @$out, '; ';
}
else {
push @$out, ';';
}
}
}
push @$out, $pair{$data->[1]};
}

sub keyword {
Expand All @@ -127,7 +176,6 @@ package Perlito5::PrettyPrint {

sub statement {
my ( $data, $level, $out ) = @_;
my $cmd = $data->[0];
for my $line ( 1 .. $#$data ) {
my $d = $data->[$line];
if ( ref($d) ) {
Expand All @@ -142,25 +190,22 @@ package Perlito5::PrettyPrint {

sub block {
my ( $data, $level, $out ) = @_;
my @dd = @$data;
my $cmd = $dd[0];
if ( @dd == 1 ) {
if ( @$data == 1 ) {
push @$out, "{}";
return;
}
push @$out, '{', "\n";
$level++;
for my $line ( 1 .. $#dd ) {
my $d = $dd[$line];
my $out1 = [];
for my $line ( 1 .. $#$data ) {
my $d = $data->[$line];
push @$out, tab($level);
if ( ref($d) ) {
$dispatch{ $d->[0] }->( $d, $level, $out1 );
$dispatch{ $d->[0] }->( $d, $level, $out );
}
else {
push @$out1, $d;
push @$out, $d;
}
push @$out, tab($level), @$out1;
push @$out, ';' if $line != $#dd && statement_need_semicolon($d);
push @$out, ';' if $line != $#$data && statement_need_semicolon($d);
push @$out, "\n";
}
$level--;
Expand All @@ -172,11 +217,13 @@ package Perlito5::PrettyPrint {
{
my $data = [
'block',
[ stmt => [ keyword => 'if' ], [ paren => '@a' ], ['block', [ 'stmt' => '123' ]] ],
[ stmt => [ keyword => 'if' ], [ paren => '(', '@a' ], ['block', [ 'stmt' => '123' ]] ],
[ block => [ 'stmt' => '2' ], [ 'stmt' => '3' ], ],
['block'],
[ op => 'list:<,>', '2', '3', [ 'op', 'infix:<*>', ['op', 'infix:<+>', 4, 7], ['op', 'infix:<**>', 5, 2] ] ],
123,
[ stmt => [ keyword => 'for' ], [ paren_semicolon => '(', [], [], [] ], ['block'] ],
[ stmt => [ keyword => 'for' ], [ paren_semicolon => '(', ['op', 'infix:<=>', '$i', 0], [], [] ], ['block'] ],
];
my $out = [];
Perlito5::PrettyPrint::block( $data, 0, $out );
Expand Down

0 comments on commit e1b541e

Please sign in to comment.