#################################################################### # # This file was generated using Parse::Yapp version 1.05. # # Don't edit this file, use source file instead. # # ANY CHANGE MADE HERE WILL BE LOST ! # #################################################################### package Math::Symbolic::Parser::Yapp; use vars qw ( @ISA ); use strict; @ISA= qw ( Math::Symbolic::Parser::Yapp::Driver ); #Included Parse/Yapp/Driver.pm file---------------------------------------- { # # Module Parse::Yapp::Driver # # This module is part of the Parse::Yapp package available on your # nearest CPAN # # Any use of this module in a standalone parser make the included # text under the same copyright as the Parse::Yapp module itself. # # This notice should remain unchanged. # # (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved. # (see the pod text in Parse::Yapp module for use and distribution rights) # package Math::Symbolic::Parser::Yapp::Driver; require 5.004; use strict; use vars qw ( $VERSION $COMPATIBLE $FILENAME ); $VERSION = '1.05'; $COMPATIBLE = '0.07'; $FILENAME=__FILE__; use Carp; #Known parameters, all starting with YY (leading YY will be discarded) my(%params)=(YYLEX => 'CODE', 'YYERROR' => 'CODE', YYVERSION => '', YYRULES => 'ARRAY', YYSTATES => 'ARRAY', YYDEBUG => ''); #Mandatory parameters my(@params)=('LEX','RULES','STATES'); sub new { my($class)=shift; my($errst,$nberr,$token,$value,$check,$dotpos); my($self)={ ERROR => \&_Error, ERRST => \$errst, NBERR => \$nberr, TOKEN => \$token, VALUE => \$value, DOTPOS => \$dotpos, STACK => [], DEBUG => 0, CHECK => \$check }; _CheckParams( [], \%params, \@_, $self ); exists($$self{VERSION}) and $$self{VERSION} < $COMPATIBLE and croak "Yapp driver version $VERSION ". "incompatible with version $$self{VERSION}:\n". "Please recompile parser module."; ref($class) and $class=ref($class); bless($self,$class); } sub YYParse { my($self)=shift; my($retval); _CheckParams( \@params, \%params, \@_, $self ); if($$self{DEBUG}) { _DBLoad(); $retval = eval '$self->_DBParse()';#Do not create stab entry on compile $@ and die $@; } else { $retval = $self->_Parse(); } $retval } sub YYData { my($self)=shift; exists($$self{USER}) or $$self{USER}={}; $$self{USER}; } sub YYErrok { my($self)=shift; ${$$self{ERRST}}=0; undef; } sub YYNberr { my($self)=shift; ${$$self{NBERR}}; } sub YYRecovering { my($self)=shift; ${$$self{ERRST}} != 0; } sub YYAbort { my($self)=shift; ${$$self{CHECK}}='ABORT'; undef; } sub YYAccept { my($self)=shift; ${$$self{CHECK}}='ACCEPT'; undef; } sub YYError { my($self)=shift; ${$$self{CHECK}}='ERROR'; undef; } sub YYSemval { my($self)=shift; my($index)= $_[0] - ${$$self{DOTPOS}} - 1; $index < 0 and -$index <= @{$$self{STACK}} and return $$self{STACK}[$index][1]; undef; #Invalid index } sub YYCurtok { my($self)=shift; @_ and ${$$self{TOKEN}}=$_[0]; ${$$self{TOKEN}}; } sub YYCurval { my($self)=shift; @_ and ${$$self{VALUE}}=$_[0]; ${$$self{VALUE}}; } sub YYExpect { my($self)=shift; keys %{$self->{STATES}[$self->{STACK}[-1][0]]{ACTIONS}} } sub YYLexer { my($self)=shift; $$self{LEX}; } ################# # Private stuff # ################# sub _CheckParams { my($mandatory,$checklist,$inarray,$outhash)=@_; my($prm,$value); my($prmlst)={}; while(($prm,$value)=splice(@$inarray,0,2)) { $prm=uc($prm); exists($$checklist{$prm}) or croak("Unknow parameter '$prm'"); ref($value) eq $$checklist{$prm} or croak("Invalid value for parameter '$prm'"); $prm=unpack('@2A*',$prm); $$outhash{$prm}=$value; } for (@$mandatory) { exists($$outhash{$_}) or croak("Missing mandatory parameter '".lc($_)."'"); } } sub _Error { print "Parse error.\n"; } sub _DBLoad { { no strict 'refs'; exists(${__PACKAGE__.'::'}{_DBParse})#Already loaded ? and return; } my($fname)=__FILE__; my(@drv); open(DRV,"<$fname") or die "Report this as a BUG: Cannot open $fname"; while() { /^\s*sub\s+_Parse\s*{\s*$/ .. /^\s*}\s*#\s*_Parse\s*$/ and do { s/^#DBG>//; push(@drv,$_); } } close(DRV); $drv[0]=~s/_P/_DBP/; eval join('',@drv); } #Note that for loading debugging version of the driver, #this file will be parsed from 'sub _Parse' up to '}#_Parse' inclusive. #So, DO NOT remove comment at end of sub !!! sub _Parse { my($self)=shift; my($rules,$states,$lex,$error) = @$self{ 'RULES', 'STATES', 'LEX', 'ERROR' }; my($errstatus,$nberror,$token,$value,$stack,$check,$dotpos) = @$self{ 'ERRST', 'NBERR', 'TOKEN', 'VALUE', 'STACK', 'CHECK', 'DOTPOS' }; #DBG> my($debug)=$$self{DEBUG}; #DBG> my($dbgerror)=0; #DBG> my($ShowCurToken) = sub { #DBG> my($tok)='>'; #DBG> for (split('',$$token)) { #DBG> $tok.= (ord($_) < 32 or ord($_) > 126) #DBG> ? sprintf('<%02X>',ord($_)) #DBG> : $_; #DBG> } #DBG> $tok.='<'; #DBG> }; $$errstatus=0; $$nberror=0; ($$token,$$value)=(undef,undef); @$stack=( [ 0, undef ] ); $$check=''; while(1) { my($actions,$act,$stateno); $stateno=$$stack[-1][0]; $actions=$$states[$stateno]; #DBG> print STDERR ('-' x 40),"\n"; #DBG> $debug & 0x2 #DBG> and print STDERR "In state $stateno:\n"; #DBG> $debug & 0x08 #DBG> and print STDERR "Stack:[". #DBG> join(',',map { $$_[0] } @$stack). #DBG> "]\n"; if (exists($$actions{ACTIONS})) { defined($$token) or do { ($$token,$$value)=&$lex($self); #DBG> $debug & 0x01 #DBG> and print STDERR "Need token. Got ".&$ShowCurToken."\n"; }; $act= exists($$actions{ACTIONS}{$$token}) ? $$actions{ACTIONS}{$$token} : exists($$actions{DEFAULT}) ? $$actions{DEFAULT} : undef; } else { $act=$$actions{DEFAULT}; #DBG> $debug & 0x01 #DBG> and print STDERR "Don't need token.\n"; } defined($act) and do { $act > 0 and do { #shift #DBG> $debug & 0x04 #DBG> and print STDERR "Shift and go to state $act.\n"; $$errstatus and do { --$$errstatus; #DBG> $debug & 0x10 #DBG> and $dbgerror #DBG> and $$errstatus == 0 #DBG> and do { #DBG> print STDERR "**End of Error recovery.\n"; #DBG> $dbgerror=0; #DBG> }; }; push(@$stack,[ $act, $$value ]); $$token ne '' #Don't eat the eof and $$token=$$value=undef; next; }; #reduce my($lhs,$len,$code,@sempar,$semval); ($lhs,$len,$code)=@{$$rules[-$act]}; #DBG> $debug & 0x04 #DBG> and $act #DBG> and print STDERR "Reduce using rule ".-$act." ($lhs,$len): "; $act or $self->YYAccept(); $$dotpos=$len; unpack('A1',$lhs) eq '@' #In line rule and do { $lhs =~ /^\@[0-9]+\-([0-9]+)$/ or die "In line rule name '$lhs' ill formed: ". "report it as a BUG.\n"; $$dotpos = $1; }; @sempar = $$dotpos ? map { $$_[1] } @$stack[ -$$dotpos .. -1 ] : (); $semval = $code ? &$code( $self, @sempar ) : @sempar ? $sempar[0] : undef; splice(@$stack,-$len,$len); $$check eq 'ACCEPT' and do { #DBG> $debug & 0x04 #DBG> and print STDERR "Accept.\n"; return($semval); }; $$check eq 'ABORT' and do { #DBG> $debug & 0x04 #DBG> and print STDERR "Abort.\n"; return(undef); }; #DBG> $debug & 0x04 #DBG> and print STDERR "Back to state $$stack[-1][0], then "; $$check eq 'ERROR' or do { #DBG> $debug & 0x04 #DBG> and print STDERR #DBG> "go to state $$states[$$stack[-1][0]]{GOTOS}{$lhs}.\n"; #DBG> $debug & 0x10 #DBG> and $dbgerror #DBG> and $$errstatus == 0 #DBG> and do { #DBG> print STDERR "**End of Error recovery.\n"; #DBG> $dbgerror=0; #DBG> }; push(@$stack, [ $$states[$$stack[-1][0]]{GOTOS}{$lhs}, $semval ]); $$check=''; next; }; #DBG> $debug & 0x04 #DBG> and print STDERR "Forced Error recovery.\n"; $$check=''; }; #Error $$errstatus or do { $$errstatus = 1; &$error($self); $$errstatus # if 0, then YYErrok has been called or next; # so continue parsing #DBG> $debug & 0x10 #DBG> and do { #DBG> print STDERR "**Entering Error recovery.\n"; #DBG> ++$dbgerror; #DBG> }; ++$$nberror; }; $$errstatus == 3 #The next token is not valid: discard it and do { $$token eq '' # End of input: no hope and do { #DBG> $debug & 0x10 #DBG> and print STDERR "**At eof: aborting.\n"; return(undef); }; #DBG> $debug & 0x10 #DBG> and print STDERR "**Dicard invalid token ".&$ShowCurToken.".\n"; $$token=$$value=undef; }; $$errstatus=3; while( @$stack and ( not exists($$states[$$stack[-1][0]]{ACTIONS}) or not exists($$states[$$stack[-1][0]]{ACTIONS}{error}) or $$states[$$stack[-1][0]]{ACTIONS}{error} <= 0)) { #DBG> $debug & 0x10 #DBG> and print STDERR "**Pop state $$stack[-1][0].\n"; pop(@$stack); } @$stack or do { #DBG> $debug & 0x10 #DBG> and print STDERR "**No state left on stack: aborting.\n"; return(undef); }; #shift the error token #DBG> $debug & 0x10 #DBG> and print STDERR "**Shift \$error token and go to state ". #DBG> $$states[$$stack[-1][0]]{ACTIONS}{error}. #DBG> ".\n"; push(@$stack, [ $$states[$$stack[-1][0]]{ACTIONS}{error}, undef ]); } #never reached croak("Error in driver logic. Please, report it as a BUG"); }#_Parse #DO NOT remove comment 1; } #End of include-------------------------------------------------- sub new { my($class)=shift; ref($class) and $class=ref($class); my($self)=$class->SUPER::new( yyversion => '1.05', yystates => [ {#State 0 ACTIONS => { 'NUM' => 5, "-" => 1, "(" => 6, 'PRED' => 3, 'VAR' => 8, 'EFUNC' => 7, 'FUNC' => 4 }, GOTOS => { 'exp' => 2 } }, {#State 1 ACTIONS => { 'NUM' => 5, "-" => 1, "(" => 6, 'PRED' => 3, 'EFUNC' => 7, 'VAR' => 8, 'FUNC' => 4 }, GOTOS => { 'exp' => 9 } }, {#State 2 ACTIONS => { '' => 11, "-" => 10, "^" => 14, "*" => 15, "+" => 12, "/" => 13 } }, {#State 3 ACTIONS => { "{" => 16 } }, {#State 4 ACTIONS => { "(" => 17 } }, {#State 5 DEFAULT => -1 }, {#State 6 ACTIONS => { 'NUM' => 5, "-" => 1, "(" => 6, 'PRED' => 3, 'EFUNC' => 7, 'VAR' => 8, 'FUNC' => 4 }, GOTOS => { 'exp' => 18 } }, {#State 7 DEFAULT => -4 }, {#State 8 DEFAULT => -5 }, {#State 9 ACTIONS => { "^" => 14 }, DEFAULT => -10 }, {#State 10 ACTIONS => { 'NUM' => 5, "-" => 1, "(" => 6, 'PRED' => 3, 'EFUNC' => 7, 'VAR' => 8, 'FUNC' => 4 }, GOTOS => { 'exp' => 19 } }, {#State 11 DEFAULT => 0 }, {#State 12 ACTIONS => { 'NUM' => 5, "-" => 1, "(" => 6, 'PRED' => 3, 'EFUNC' => 7, 'VAR' => 8, 'FUNC' => 4 }, GOTOS => { 'exp' => 20 } }, {#State 13 ACTIONS => { 'NUM' => 5, "-" => 1, "(" => 6, 'PRED' => 3, 'EFUNC' => 7, 'VAR' => 8, 'FUNC' => 4 }, GOTOS => { 'exp' => 21 } }, {#State 14 ACTIONS => { 'NUM' => 5, "-" => 1, "(" => 6, 'PRED' => 3, 'EFUNC' => 7, 'VAR' => 8, 'FUNC' => 4 }, GOTOS => { 'exp' => 22 } }, {#State 15 ACTIONS => { 'NUM' => 5, "-" => 1, "(" => 6, 'PRED' => 3, 'EFUNC' => 7, 'VAR' => 8, 'FUNC' => 4 }, GOTOS => { 'exp' => 23 } }, {#State 16 ACTIONS => { 'NUM' => 5, "-" => 1, "(" => 6, 'PRED' => 3, 'EFUNC' => 7, 'VAR' => 8, 'FUNC' => 4 }, GOTOS => { 'exp' => 24 } }, {#State 17 ACTIONS => { 'NUM' => 5, "-" => 1, "(" => 6, 'PRED' => 3, 'EFUNC' => 7, 'VAR' => 8, 'FUNC' => 4 }, GOTOS => { 'exp' => 25, 'list' => 26 } }, {#State 18 ACTIONS => { "-" => 10, "^" => 14, "*" => 15, "+" => 12, "/" => 13, ")" => 27 } }, {#State 19 ACTIONS => { "/" => 13, "^" => 14, "*" => 15 }, DEFAULT => -7 }, {#State 20 ACTIONS => { "/" => 13, "^" => 14, "*" => 15 }, DEFAULT => -6 }, {#State 21 ACTIONS => { "^" => 14 }, DEFAULT => -9 }, {#State 22 ACTIONS => { "^" => 14 }, DEFAULT => -11 }, {#State 23 ACTIONS => { "^" => 14 }, DEFAULT => -8 }, {#State 24 ACTIONS => { "}" => 28, "-" => 10, "^" => 14, "*" => 15, "+" => 12, "/" => 13 } }, {#State 25 ACTIONS => { "-" => 10, "^" => 14, "*" => 15, "+" => 12, "/" => 13, "," => 29 }, DEFAULT => -14 }, {#State 26 ACTIONS => { ")" => 30 } }, {#State 27 DEFAULT => -12 }, {#State 28 DEFAULT => -3 }, {#State 29 ACTIONS => { 'NUM' => 5, "-" => 1, "(" => 6, 'PRED' => 3, 'EFUNC' => 7, 'VAR' => 8, 'FUNC' => 4 }, GOTOS => { 'exp' => 25, 'list' => 31 } }, {#State 30 DEFAULT => -2 }, {#State 31 DEFAULT => -13 } ], yyrules => [ [#Rule 0 '$start', 2, undef ], [#Rule 1 'exp', 1, sub { $_[1] } ], [#Rule 2 'exp', 4, sub { if (exists($Math::Symbolic::Parser::Parser_Functions{$_[1]})) { $Math::Symbolic::Parser::Parser_Functions{$_[1]}->($_[1], @{$_[3]}) } else { Math::Symbolic::Operator->new($_[1], @{$_[3]}) } } ], [#Rule 3 'exp', 4, sub { Math::Symbolic::Variable->new( 'TRANSFORMATION_HOOK', [$_[1], $_[3]] ); } ], [#Rule 4 'exp', 1, sub { $_[1] =~ /^([^(]+)\((.+)\)$/o or die; $Math::SymbolicX::ParserExtensionFactory::Functions->{$1}->($2) } ], [#Rule 5 'exp', 1, sub { $_[1] } ], [#Rule 6 'exp', 3, sub { Math::Symbolic::Operator->new('+', $_[1], $_[3]) } ], [#Rule 7 'exp', 3, sub { Math::Symbolic::Operator->new('-', $_[1], $_[3]) } ], [#Rule 8 'exp', 3, sub { Math::Symbolic::Operator->new('*', $_[1], $_[3]) } ], [#Rule 9 'exp', 3, sub { Math::Symbolic::Operator->new('/', $_[1], $_[3]) } ], [#Rule 10 'exp', 2, sub { Math::Symbolic::Operator->new('neg', $_[2]) } ], [#Rule 11 'exp', 3, sub { Math::Symbolic::Operator->new('^', $_[1], $_[3]) } ], [#Rule 12 'exp', 3, sub { $_[2] } ], [#Rule 13 'list', 3, sub { unshift @{$_[3]}, $_[1]; $_[3] } ], [#Rule 14 'list', 1, sub { [$_[1]] } ] ], @_); bless($self,$class); } use strict; use warnings; use Math::Symbolic qw//; use constant DAT => 0; use constant OP => 1; sub _Error { exists $_[0]->YYData->{ERRMSG} and do { my $x = $_[0]->YYData->{ERRMSG}; delete $_[0]->YYData->{ERRMSG}; die $x; }; die "Syntax error in input string while parsing the following string: '".$_[0]->{USER}{INPUT}."'\n"; } my $Num = qr/[+-]?(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee]([+-]?\d+))?/o; my $Ident = qr/[a-zA-Z][a-zA-Z0-9_]*/o; my $Op = qr/\+|\-|\*|\/|\^/o; my $Func = qr/log|partial_derivative|total_derivative|a?(?:sin|sinh|cos|cosh|tan|cot)|exp|sqrt/; my $Unary = qr/\+|\-/o; # taken from perlre my $balanced_parens_re; $balanced_parens_re = qr{\((?:(?>[^()]+)|(??{$balanced_parens_re}))*\)}; # This is a hack so we can hook into the new() method. { no warnings; no strict; *real_new = \&new; *new = sub { my $class = shift; my %args = @_; my $predicates = $args{predicates}; delete $args{predicates}; my $parser = real_new($class, %args); if ($predicates) { $parser->{__PREDICATES} = $predicates; } return $parser; }; } sub _Lexer { my($parser)=shift; my $ExtFunc = $Math::SymbolicX::ParserExtensionFactory::RegularExpression || qr/(?!)/o; my $data = $parser->{USER}; my $predicates = $parser->{__PREDICATES}; pos($data->{INPUT}) < length($data->{INPUT}) or return('',undef); # This is a huge hack if (defined $predicates) { for ($data->{INPUT}) { if ($data->{STATE} == DAT) { if ($data->{INPUT} =~ /\G($Func)(?=\()/cg) { return('FUNC', $1); } elsif ($data->{INPUT} =~ /\G($ExtFunc$balanced_parens_re)/cg) { $data->{STATE} = OP; return('EFUNC', $1); } elsif ($data->{INPUT} =~ /\G($predicates)(?=\{)/cg) { return('PRED', $1); } elsif ($data->{INPUT} =~ /\G($Ident)(?:\(($Ident(?:,$Ident)*)\))?/cgo) { $data->{STATE} = OP; if (defined $2) { return( 'VAR', Math::Symbolic::Variable->new({name=>$1, signature=>[split /,/, $2]}) ); } else { return('VAR', Math::Symbolic::Variable->new({name=>$1})); } } elsif ($data->{INPUT} =~ /\G\(/cgo) { return('(', '('); } elsif ($data->{INPUT} =~ /\G\{/cgo) { return('{', '{'); } elsif ($data->{INPUT} =~ /\G($Num)/cgo) { $data->{STATE} = OP; return('NUM', Math::Symbolic::Constant->new($1)); } elsif ($data->{INPUT} =~ /\G($Unary)/cgo) { return($1, $1); } else { my $pos = pos($data->{INPUT}); die "Parse error at position $pos of string '$data->{INPUT}'.\nCould not find a suitable token while expecting data (identifier, function, number, etc.)."; } } else { # $data->{STATE} == OP if ($data->{INPUT} =~ /\G\)/cgo) { return(')', ')'); } elsif ($data->{INPUT} =~ /\G\}/cgo) { return('}', '}'); } elsif ($data->{INPUT} =~ /\G($Op)/cgo) { $data->{STATE} = DAT; return($1, $1); } elsif ($data->{INPUT} =~ /\G,/cgo) { $data->{STATE} = DAT; return(',', ','); } else { my $pos = pos($data->{INPUT}); die "Parse error at position $pos of string '$data->{INPUT}'.\nCould not find a suitable token while expecting an operator (+, -, etc)."; } } } } # }}} end if defined $predicates else { # {{{ not defined $predicates for ($data->{INPUT}) { if ($data->{STATE} == DAT) { if ($data->{INPUT} =~ /\G($Func)(?=\()/cg) { return('FUNC', $1); } elsif ($data->{INPUT} =~ /\G($ExtFunc$balanced_parens_re)/cg) { $data->{STATE} = OP; return('EFUNC', $1); } elsif ($data->{INPUT} =~ /\G($Ident)(?:\(($Ident(?:,$Ident)*)\))?/cgo) { $data->{STATE} = OP; if (defined $2) { return( 'VAR', Math::Symbolic::Variable->new({name=>$1, signature=>[split /,/, $2]}) ); } else { return('VAR', Math::Symbolic::Variable->new({name=>$1})); } } elsif ($data->{INPUT} =~ /\G\(/cgo) { return('(', '('); } elsif ($data->{INPUT} =~ /\G($Num)/cgo) { $data->{STATE} = OP; return('NUM', Math::Symbolic::Constant->new($1)); } elsif ($data->{INPUT} =~ /\G($Unary)/cgo) { return($1, $1); } else { my $pos = pos($data->{INPUT}); die "Parse error at position $pos of string '$data->{INPUT}'.\nCould not find a suitable token while expecting data (identifier, function, number, etc.)."; } } else { # $data->{STATE} == OP if ($data->{INPUT} =~ /\G\)/cgo) { return(')', ')'); } elsif ($data->{INPUT} =~ /\G($Op)/cgo) { $data->{STATE} = DAT; return($1, $1); } elsif ($data->{INPUT} =~ /\G,/cgo) { $data->{STATE} = DAT; return(',', ','); } else { my $pos = pos($data->{INPUT}); die "Parse error at position $pos of string '$data->{INPUT}'.\nCould not find a suitable token while expecting an operator (+, -, etc)."; } } } } # }}} end else => not defined $predicates } sub parse { my($self)=shift; my $in = shift; $in =~ s/\s+//g; $self->{USER}{STATE} = DAT; $self->{USER}{INPUT} = $in; pos($self->{USER}{INPUT}) = 0; return $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error ); } sub parsedebug { my($self)=shift; my $in = shift; $in =~ s/\s+//g; $self->{USER}{STATE} = DAT; $self->{USER}{INPUT} = $in; pos($self->{USER}{INPUT}) = 0; return $self->YYParse( yydebug => 0x1F, yylex => \&_Lexer, yyerror => \&_Error ); } 1; 1;