Perlito5 - pretty-printer AST

fglock · Oct 4, 2013 · a204083 · a204083
1 parent ed1912f
commit a204083
Showing 1 changed file with 46 additions and 27 deletions.
diff --git a/misc/pretty_print.pl b/misc/pretty_print.pl
@@ -2,40 +2,59 @@
 
 package Perlito5::PrettyPrint {
 
+    use Data::Dumper;
+
     my %dispatch = (
         stmt    => \&statement,
         block   => \&block,
         list    => \&list,
         keyword => \&keyword,
+        op      => \&op,
+    );
+
+    my %op = (
+        'infix:<*>' => { fix => 'infix', prec => 1, str => '*' },
+        'infix:<+>' => { fix => 'infix', prec => 2, str => '+' },
     );
 
     # TODO
     # precedence
     # prefix/infix/postfix
 
+    my %tab;
+
     sub tab {
-        my $level = shift;
-        "\t" x $level;
+        my $level = $_[0];
+        $tab{$level} //= "\t" x $level;
+    }
+
+    sub op {
+        my ( $data, $level, $out ) = @_;
+        my $cmd = $data->[0];
+        my $op = $data->[1];
+        my $spec = $op{$op} || {};
+        if ($spec->{fix} eq 'infix') {
+            push @$out, $data->[2], ' ', $spec->{str}, ' ', $data->[3];
+        }
+        else {
+            die "unknown op: $op";
+        }
+        return;
     }
 
     sub keyword {
         my ( $data, $level, $out ) = @_;
-        push @$out, $data;
+        push @$out, $data->[1];
         return;
     }
 
     sub statement {
         my ( $data, $level, $out ) = @_;
-        if ( !ref($data) ) {
-            push @$out, $data;
-            return;
-        }
-        for my $line ( 0 .. $#$data ) {
+        my $cmd = $data->[0];
+        for my $line ( 1 .. $#$data ) {
             my $d = $data->[$line];
             if ( ref($d) ) {
-                my @dd = @$d;
-                my $cmd = shift @dd;
-                $dispatch{ $cmd }->( \@dd, $level, $out );
+                $dispatch{ $d->[0] }->( $d, $level, $out );
             }
             else {
                 push @$out, $d;
@@ -45,25 +64,25 @@ package Perlito5::PrettyPrint {
 
     sub block {
         my ( $data, $level, $out ) = @_;
-        if ( @$data == 0 ) {
+        my @dd = @$data;
+        my $cmd = $dd[0];
+        if ( @dd == 1 ) {
             push @$out, "{}";
             return;
         }
         push @$out, '{', "\n";
         $level++;
-        for my $line ( 0 .. $#$data ) {
-            my $d    = $data->[$line];
+        for my $line ( 1 .. $#dd ) {
+            my $d    = $dd[$line];
             my $out1 = [];
             if ( ref($d) ) {
-                my @dd = @$d;
-                my $cmd = shift @dd;
-                $dispatch{ $cmd }->( \@dd, $level, $out1 );
+                $dispatch{ $d->[0] }->( $d, $level, $out1 );
             }
             else {
                 push @$out1, $d;
             }
             push @$out, tab($level), @$out1;
-            push @$out, ';' if $line != $#$data;
+            push @$out, ';' if $line != $#dd;
             push @$out, "\n";
         }
         $level--;
@@ -72,23 +91,22 @@ package Perlito5::PrettyPrint {
 
     sub list {
         my ( $data, $level, $out ) = @_;
-        if ( @$data == 0 ) {
-            return;
-        }
-        my $op = shift @$data;
+        my @dd = @$data;
+        my $cmd = $dd[0];
+        my $op = $dd[1];
         push @$out, '(';
         $level++;
-        for my $line ( 0 .. $#$data ) {
-            my $d    = $data->[$line];
+        for my $line ( 2 .. $#dd ) {
+            my $d    = $dd[$line];
             my $out1 = [];
             if ( ref($d) ) {
-                $dispatch{ $d->[0] }->( $d->[1], $level, $out1 );
+                $dispatch{ $d->[0] }->( $d, $level, $out1 );
             }
             else {
                 push @$out1, $d;
             }
             push @$out, @$out1;
-            push @$out, $op if $line != $#$data;
+            push @$out, $op if $line != $#dd;
         }
         $level--;
         push @$out, ')';
@@ -98,10 +116,11 @@ package Perlito5::PrettyPrint {
 
 {
     my $data = [
+        'block',
         [ 'stmt', [ keyword => 'if' ] ],
         [ 'block', [ 'stmt' => '2' ], [ 'stmt' => '3' ], ],
         ['block'],
-        [ 'list', ', ', '2', '3' ],
+        [ 'list', ', ', '2', '3', [ 'op', 'infix:<+>', 4, 5 ] ],
     ];
     my $out = [];
     Perlito5::PrettyPrint::block( $data, 0, $out );