#!/usr/bin/perl

use Data::Dumper;

sub generic_node {
        my ($re, $tree) = @_;
        $current =~ s/^\s*//;
        if ($current !~ /$re/i) {
                return 0;
        }
        $current =~ s/$re//i;
        push @{$tree}, $1;
        return 1;
};

sub generic_node_create {
        my ($re, $tree, $name) = @_;
        $current =~ s/^\s*//;
        if ($current !~ /$re/i) {
                return 0;
        }
        $current =~ s/$re//i;
        push @{$tree}, [$name, $1];
        return 1;
};

sub generic_check {
        my ($re, $tree) = @_;
        $current =~ s/^\s*//;
        return $current =~ s/$re//i;
};

sub operator {
        generic_node_create('^([+-=*\/])',shift,"OPERATOR");
};

sub number {
        generic_node_create('^(\d+)',shift,"NUMBER");
};

sub string {
        generic_node_create('^\"([^\"]+)\"',shift,"STRING");
};

sub numeric_variable {
        generic_node_create('^([A-Z]\d)',shift,"NUMERIC_VAR");
};

sub string_variable {
        generic_node_create('^([A-Z]\$)',shift,"STRING_VAR");
};

sub equals {
        generic_node_create('^([=])',shift,"EQUALS");
};

sub expression {
        my $tree = shift;
        my $t = [EXPRESSION];

        string_variable($t) ||
        numeric_variable($t) ||
        string($t) ||
        number($t) ||
        (generic_check('^[\(]',$t) && expression($t) && generic_check('^[\)]',$t)) ||
        return 0;
        
        if (operator($t)) {
                expression($t) || return 0;
        }

        push @{$tree},$t;       
        return 1;
};

sub assignment {
        my $tree = shift;
        my $t = [ASSIGNMENT];

        numeric_variable($t) || string_variable($t) || return 0;


        equals($t) || return 0;

        expression($t) || return 0;

        push @{$tree},$t;
        return 1;
};

sub comment {
        if (generic_check('^REM')) {
                return 1;
        }
};

sub if_condition {
        my $tree = shift;
        my $t = [IF_CONDITION];

        generic_check('^IF',$t) || return 0;

        expression($t) || die "Invalid IF statement, expected expression";

        generic_check('^THEN',$t) || die "Invalid IF statement, expected THEN";

        statement($t) || die "Invalid IF construct, expected statement after THEN";

        if (generic_check('^ELSE',$t)) {
                statement($t) || die "Invalid IF/ELSE construct, expected statement after ELSE";
        }

        push @{$tree},$t;
        
        return 1;       
};

sub goto_statement {
        my $tree = shift;
        my $t = [GOTO];

        generic_check('^GOTO',$t) || return 0;

        number($t) || die 'GOTO must be followed by a number';

        push @{$tree},$t;
};

sub statement {
        my $tree = shift;
        my $t = [STATEMENT];

        assignment($t) ||
        comment($t) ||
        if_condition($t) ||
        goto_statement($t) ||
        return 0;

        push @{$tree},$t;
};


#
# Pretty-print routines
#

sub print_expression {
        my ($subelement) = @_;

        if ($subelement->[0] eq "EXPRESSION") {
                if ($subelement->[2][0] ne "OPERATOR") {
                        return "(".print_expression($subelement->[1]).")";
                } else {
                        return "(".print_expression($subelement->[1])." ".$subelement->[2][1]." ".prin
t_expression($subelement->[3]).")";
                }
        }
        if ($subelement->[0] eq "NUMBER") {
                return $subelement->[1];
        }
        if ($subelement->[0] eq "STRING") {
                return '"'.$subelement->[1].'"';
        }       
        if ($subelement->[0] eq "STRING_VAR") {
                return $subelement->[1];
        }       
        if ($subelement->[0] eq "NUMBER_VAR") {
                return $subelement->[1];
        }       
        
};

sub print_statement {
        my ($statement) = @_;
        my $s = "";
        $level++;
        my $subelement = $statement->[1];
        if ($subelement->[0] eq "IF_CONDITION") {

                add_line("IF ".print_expression($subelement->[1])." THEN GOTO THEN_$level");
                if ($subelement->[3]) {
                        print_statement($subelement->[3]);
                }
                add_line("GOTO END_$level");
                add_line("THEN_$level:");
                print_statement($subelement->[2]);                      
                add_line("END_$level:");
        }
        if ($subelement->[0] eq "GOTO") {
                add_line("GOTO ".$subelement->[1][1]);
        }
        if ($subelement->[0] eq "ASSIGNMENT") {
                add_line($subelement->[1][1]." = ".print_expression($subelement->[3]));
        }
        if ($subelement->[0] eq "COMMENT") {
                add_line("REM - comment here");
        }
        $level--;
};

sub add_line {
        push @lines, [$current_line, shift];
};

sub pretty_print {
        my $tree = shift;
        
        $ln = shift(@{$tree});
        
        print_statement($tree->[0]);
};



while (<>) {
        chomp($_);
        $current = $_;

        $tree = [];

        generic_node('^(\d+)', $tree) || die "Line number invalid";
        $current_line = $tree->[0];
        
        statement($tree) || die "Invalid statement";
        print Dumper($tree);
        $level = 0;
        pretty_print($tree);
};

for (@lines) {
        print $_->[0]." ".$_->[1]."\n";
}