Código de Calc.yp

 1 #
 2 # Calc.yp
 3 # 
 4 # Parse::Yapp input grammar example.
 5 #
 6 # This file is PUBLIC DOMAIN 
 7 #
 8 #
 9 %right  '='
10 %left   '-' '+'
11 %left   '*' '/'
12 %left   NEG
13 %right  '^'
14 
15 %%
16 input:  #empty
17         |   input line  { push(@{$_[1]},$_[2]); $_[1] }
18 ;
19 
20 line:       '\n'                { $_[1] }
21         |   exp '\n'            { print "$_[1]\n" }
22         |   error '\n' { $_[0]->YYErrok }
23 ;
24 
25 exp:        NUM
26         |   VAR                 { $_[0]->YYData->{VARS}{$_[1]} }
27         |   VAR '=' exp         { $_[0]->YYData->{VARS}{$_[1]}=$_[3] }
28         |   exp '+' exp         { $_[1] + $_[3] }
29         |   exp '-' exp         { $_[1] - $_[3] }
30         |   exp '*' exp         { $_[1] * $_[3] }
31         |   exp '/' exp         {
32                                       $_[3]
33                                   and return($_[1] / $_[3]);
34                                   $_[0]->YYData->{ERRMSG}
35                                     =   "Illegal division by zero.\n";
36                                   $_[0]->YYError;
37                                   undef
38                                 }
39         |   '-' exp %prec NEG   { -$_[2] }
40         |   exp '^' exp         { $_[1] ** $_[3] }
41         |   '(' exp ')'         { $_[2] }
42 ;
43 
44 %%
45 
46 sub _Error {
47         exists $_[0]->YYData->{ERRMSG}
48     and do {
49         print $_[0]->YYData->{ERRMSG};
50         delete $_[0]->YYData->{ERRMSG};
51         return;
52     };
53     print "Syntax error.\n";
54 }
55 
56 sub _Lexer {
57     my($parser)=shift;
58 
59         $parser->YYData->{INPUT}
60     or  $parser->YYData->{INPUT} = <STDIN>
61     or  return('',undef);
62 
63     $parser->YYData->{INPUT}=~s/^[ \t]//;
64 
65     for ($parser->YYData->{INPUT}) {
66         s/^([0-9]+(?:\.[0-9]+)?)//
67                 and return('NUM',$1);
68         s/^([A-Za-z][A-Za-z0-9_]*)//
69                 and return('VAR',$1);
70         s/^(.)//s
71                 and return($1,$1);
72     }
73 }
74 
75 sub Run {
76     my($self)=shift;
77     $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error) #, yydebug => 0x10 );
78 }
79