| Server IP : 85.214.239.14 / Your IP : 3.15.141.184 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/share/doc/libparse-recdescent-perl/examples/ |
Upload File : |
#!/usr/bin/perl -sw
# PARSE AND EVALUATE LOGICAL EXPRESSIONS WITH A OO PARSE TREE
$::RD_AUTOACTION =
q{ bless [$item[-1]], $item[0] };
use Parse::RecDescent;
my $parse = Parse::RecDescent->new(<<'EOG');
expr : set | clear | disj
set : 'set' atom
clear : 'clear' atom
disj : <leftop: conj 'or' conj>
{ bless $item[-1], $item[0] }
conj : <leftop: unary 'and' unary>
{ bless $item[-1], $item[0] }
unary : neg | bracket | atom
bracket : '(' expr ')' { $item[2] }
neg : 'not' unary
atom : /[a-z]+/i
EOG
while (<>)
{
my $tree = $parse->expr($_);
print $tree->eval(), "\n" if $tree;
}
BEGIN {@var{qw(a c e)} = (1,1,1);}
sub returning
{
# local $^W;
# print +(caller(1))[3], " returning ($_[0])\n";
$_[0];
}
sub expr::eval { returning $_[0][0]->eval() }
sub disj::eval { returning join '', map {$_->eval()} @{$_[0]} }
sub conj::eval { returning ! join '', map {! $_->eval()} @{$_[0]} }
sub unary::eval { returning $_[0][0]->eval() }
sub neg::eval { returning ! $_[0][0]->eval() }
sub set::eval { returning $::var{$_[0][0]->name()} = 1 }
sub clear::eval { returning $::var{$_[0][0]->name()} = 0 }
sub atom::eval { returning $::var{$_[0][0]} }
sub atom::name { returning $_[0][0] }