# 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 }