#!/usr/bin/perl -w
use strict;
#use Test::More qw(no_plan);
use Test::More tests => 3;

#use Test::Exception;

use_ok qw(Parse::Eyapp) or exit;
use_ok qw(Parse::Eyapp::Treeregexp) or exit;

my $grammar = q{
  %right  '='
  %left   '-' '+'
  %left   '*' '/'
  %left   NEG

  %{
    use Parse::Eyapp::Treeregexp;
    use Data::Dumper;
    $Data::Dumper::Indent = 1;
    $Data::Dumper::Deepcopy = 1;
    $Data::Dumper::Deparse = 1;
    our $test_exception_installed;
    BEGIN { 
      $test_exception_installed = 1;
      eval { require Test::Exception };
      $test_exception_installed = 0 if $@;
    }
  %}

  %metatree

  %defaultaction { 
    if (@_==4) { # binary operations: 4 = lhs, left, operand, right
      $lhs->{t} = "$_[1]->{t} $_[3]->{t} $_[2]->{attr}";
      return  
    }
    die "Fatal Error. Unexpected input\n".Dumper(@_);
  }

  %%
  line: %name PROG
         exp <%name EXP + ';'> 
           { @{$lhs->{t}} = map { $_->{t}} ($lhs->child(0)->Children()); }
           
  ;

  exp:      %name NUM     NUM         { $lhs->{t} = $_[1]->{attr}; }    
          | %name VAR     VAR         { $lhs->{t} = $_[1]->{attr}; } 
          | %name ASSIGN  VAR '=' exp { $lhs->{t} = "$_[1]->{attr} $_[3]->{t} =" }
          | %name PLUS    exp '+' exp         
          | %name MINUS   exp '-' exp        
          | %name TIMES   exp '*' exp       
          | %name DIV     exp '/' exp      
          | %name UMINUS  '-' exp %prec NEG { $_[0]->{t} = "$_[2]->{t} NEG" }
          |               '(' exp ')' %begin { $_[2] } /* skip parenthesis */     
  ;

  %%

  sub _Error {
      my($token)=$_[0]->YYCurval;

      my($what)= $token ? "input: '$token'" : "end of input";
      die "Syntax error near $what.\n";
  }

  my $x; # Used for input

  sub _Lexer {
      my($parser)=shift;

      $x =~ s/^\s+//;
      return('',undef) if $x eq '';


      $x =~ s/^([0-9]+(?:\.[0-9]+)?)//   and return('NUM',$1);
      $x =~ s/^([A-Za-z][A-Za-z0-9_]*)// and return('VAR',$1);
      $x =~ s/^(.)//s                    and return($1,$1);
  }

  sub Run {
      my($self)=shift;

      $x = 'a=-2; b=2/a*-3';
      my $tree = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error,
        #yydebug => 0xFF
      );

      my $transform = Parse::Eyapp::Treeregexp->new( STRING => q{

        delete_code : CODE => { $delete_code->delete() }

        {
          sub not_semantic {
            my $self = shift;
            return  1 if $self->{token} eq $self->{attr};
            return 0;
          }
        }

        delete_tokens : TERMINAL and { not_semantic($TERMINAL) } => { $delete_tokens->delete() }

        delete = delete_code delete_tokens;

        uminus: UMINUS(., NUM($x), .) => { $x->{attr} = -$x->{attr}; $_[0] = $NUM }

        constantfold: /TIMES|PLUS|DIV|MINUS/(NUM($W), ., NUM($y)) 
           => { 
          $W[0]->{attr} = eval  "$W[0]->{attr} $W[1]->{attr} $y->{attr}";
          $_[0] = $NUM[0]; 
        }

        commutative_add: PLUS($x, ., $y, .)  
          => { my $t = $x; $_[0]->child(0, $y); $_[0]->child(2, $t)}

        comasocfold: TIMES(DIV(NUM($x), ., $b), ., NUM($y)) 
           => { 
          $x->{attr} = $x->{attr} * $y->{attr};
          $_[0] = $DIV; 
        }

        zero_times: TIMES(NUM($x), ., .) and { $x->{attr} == 0 } => { $_[0] = $NUM }
        times_zero: TIMES(., ., NUM($x)) and { $x->{attr} == 0 } => { $_[0] = $NUM }

        algebraic_transformations = constantfold zero_times times_zero comasocfold;

      }, 
      #OUTPUTFILE => 'main.pm',
      SEVERITY => 0,
      NUMBERS => 0,
      );


    SKIP: {
      skip "Test::Exception not installed", 1 unless $test_exception_installed;
      # Create the transformer
      Test::Exception::throws_ok { 
          $transform->generate() 
        } 
        qr/Error in file .*: Can't use .W to identify an scalar treeregexp, at line/
        , "Can't use \$W to identify an scalar treeregexp";
    }
  } #  sub Run
}; # grammar

#### main #########
my $p = Parse::Eyapp->new_grammar(
  input=>$grammar,
  classname=>'main',
  firstline => 9,
  #outputfile => 'main.pm'
);
die $p->Warnings."\nSolve Ambiguities. See file main.output\n"  if $p->Warnings;
my $parser = main->new();
$parser->Run();