#!/usr/bin/perl -w use strict; #use Test::More qw(no_plan); use Test::More tests => 9; use_ok qw(Parse::Eyapp) or exit; use Data::Dumper; use_ok qw( Parse::Eyapp::Treeregexp) or exit; my $grammar = q{ %{ use Data::Dumper; %} %right '=' %left '-' '+' %left '*' '/' %left NEG %tree %% block: exp { $_[1] } ; exp: %name NUM NUM | %name WHILE 'while' exp '{' block '}' | %name VAR VAR | %name ASSIGN VAR '=' exp | %name PLUS exp '+' exp | %name MINUS exp '-' exp | %name TIMES exp '*' exp | %name DIV exp '/' exp | %name UMINUS '-' exp %prec NEG | '(' exp ')' { $_[2] } /* Let us simplify a bit the tree */ ; %% sub _Error { exists $_[0]->YYData->{ERRMSG} and do { #print $_[0]->YYData->{ERRMSG}; delete $_[0]->YYData->{ERRMSG}; die; }; die "Syntax error near ".(($a = $_[0]->YYCurval)?"token $a":"end of file\n"); } sub _Lexer { my($parser)=shift; defined($parser->YYData->{INPUT}) or return('',undef); for ($parser->YYData->{INPUT}) { s/^\s+//; s/^([0-9]+(?:\.[0-9]+)?)// and return('NUM',$1); s/^while// and return('while', 'while'); s/^([A-Za-z][A-Za-z0-9_]*)// and return('VAR',$1); s/^(\S)//s and return($1,$1); return('',undef); } } sub Run { my($self)=shift; $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error, #yydebug =>0xFF ); } }; # end grammar Parse::Eyapp::Treeregexp->new( STRING => q{ is_bin: /TIMES|PLUS|DIV|MINUS/i($n, $m) zero_times_whatever: TIMES(NUM($x), .) and { $x->{attr} == 0 } whatever_times_zero: TIMES(., NUM($x)) and { $x->{attr} == 0 } })->generate(); our ($is_bin, $zero_times_whatever, $whatever_times_zero); our @b = ($is_bin, $zero_times_whatever, $whatever_times_zero); sub Rule6::test { my $parser = shift; my $input = $parser->YYData->{INPUT} = shift; my @expected = @_; my $t = $parser->Run; #print "\n***** Matching: Array context $input ******\n"; my @m = $t->m(@b); my $i = 0; for my $n (@m) { my @names = map { $b[$_]->{NAME} } @{$n->{patterns}}; my $class = ref($n->{node}); my @patterns = @{$n->{patterns}}; is "$class @names @patterns", $expected[$i++], "m: array context @patterns $input"; #print "$class @names @patterns\n"; } @m = (); # #print "\n***** Matching: scalar context $input ******\n"; # my $f = $t->m(@b); # my $n; # push @m, $n while $n = $f->(); # $i = 0; # for my $n (@m) { # my @patterns = $n->patterns; # my @names = map { $b[$_]->{NAME} } @patterns; # my $class = ref($n->node); # #print "$class @names @patterns\n"; # is "$class @names @patterns", $expected[$i++], "m: scalar context @patterns $input"; # } } # Syntax analysis Parse::Eyapp->new_grammar( input=>$grammar, classname=>'Rule6', #outputfile => 'match.pm', firstline=>9, ); my $parser = Rule6->new(); $Data::Dumper::Indent = 1; #$Data::Dumper::Deepcopy = 1; my @expected= ( 'TIMES is_bin whatever_times_zero 0 2', 'TIMES is_bin whatever_times_zero 0 2' ); $parser->test('2*0*0', @expected); @expected= ( 'TIMES is_bin whatever_times_zero 0 2', 'TIMES is_bin zero_times_whatever whatever_times_zero 0 1 2' ); $parser->test('0*0*0', @expected); @expected= ( 'PLUS is_bin 0', 'TIMES is_bin zero_times_whatever whatever_times_zero 0 1 2', 'TIMES is_bin zero_times_whatever whatever_times_zero 0 1 2' ); $parser->test('0*0+0*0', @expected);