# File TSwithtreetransformations.eyp
%right  '='
%left   '-' '+'
%left   '*' '/'
%left   NEG

%{
=head1 SYNOPSIS

Execute it with: 

         eyapp TSwithtreetransformations2.eyp; ./usetswithtreetransformations2.pl

Give it as input s.t. like: C<a=b*(2-2)>. The Optimizing 
transformations reduce the AST to:

      PROG(EXP(ASSIGN(TERMINAL[a],NUM(TERMINAL[0]))))

This is a rather complicated example that combines translation schemes and tree
transformations. 

=cut

  use Parse::Eyapp::Treeregexp;
  use Data::Dumper;
  $Data::Dumper::Indent = 1;
  $Data::Dumper::Deepcopy = 1;
  $Data::Dumper::Deparse = 1;
%}

%lexer {
   s/^\s+//;

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


%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 Run {
    my($self)=shift;
    my $x = <>;
    $self->input(\$x);
    my $tree = $self->YYParse( );

    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() }

        # A family of two transformations
        delete = delete_code delete_tokens;

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

        # 8*4 = 32 8/4 = 2, etc.
        constantfold: /TIMES|PLUS|DIV|MINUS/:bin(NUM($z), ., NUM($y)) => { 
          $z->{attr} = eval  "$z->{attr} $W->{attr} $y->{attr}";
          $_[0] = $NUM[0]; 
        }

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

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

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

        algebraic_transformations = constantfold zero_times times_zero;

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

    # Create the transformer
    $transform->generate();
    # Get the AST

    our ($uminus);
    $uminus->s($tree);

    our (@algebraic_transformations);
    $tree->s(@algebraic_transformations);
    print Dumper($tree);

    # Warning. This type of transformation may lead to infinite loops
    #our ($commutative_add);
    #$commutative_add->s($tree);
    #print Dumper($tree);

    our ($comasocfold);
    $comasocfold->s($tree);
    print Dumper($tree);

    $tree->s(@algebraic_transformations);

    $tree->translation_scheme();
    
    # Delete CODE and token nodes
    our (@delete);
    $tree->s(@delete);

    print $tree->str."\n";
}

sub TERMINAL::info { $_[0]->attr }