HEX

Warning: set_time_limit() [function.set-time-limit]: Cannot set time limit - prohibited by configuration in /home/u547966/brikov.ru/www/wp-content/plugins/admin-menu-editor/menu-editor.php on line 745
Server: Apache
System: Linux 4.19.0-0.bpo.9-amd64 x86_64 at red40
User: u547966 (5490)
PHP: 5.3.29-mh2
Disabled: syslog, dl, popen, proc_open, proc_nice, proc_get_status, proc_close, proc_terminate, posix_mkfifo, chown, chgrp, accelerator_reset, opcache_reset, accelerator_get_status, opcache_get_status, 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_dispatch, pcntl_get_last_error, pcntl_strerror, pcntl_sigprocmask, pcntl_sigwaitinfo, pcntl_sigtimedwait, pcntl_exec, pcntl_getpriority, pcntl_setpriority
Upload Files
File: //usr/share/doc/libparse-recdescent-perl/examples/demo_eval.pl
#!/usr/bin/perl -w

use Parse::RecDescent;

$text = "1 + 2 * 3 ** 4";

$grammar = q{
        <autotree>

        expr	:	<leftop: conj /\|\|/ conj>

        conj	:	<leftop: addn /&&/ addn>

        addn	:	<leftop: mult /[+-]/ mult >

        mult	:	<leftop: expo /[*\/\%]/ expo >

        expo	:	<leftop: value /\^|\*\*/ value >

        value	:	/\d+(\.\d+)?/
};

my $extract_tree = Parse::RecDescent->new($grammar);

my $tree = $extract_tree->expr($text);

use Data::Dumper 'Dumper';
print Dumper $tree;

print $tree->eval();

package expr;
use List::Util  'reduce';
sub eval { reduce {$_[0] || $_[1]} map $_->eval(), @{$_[0]{__DIRECTIVE1__}} }

package conj ;
use List::Util  'reduce';
sub eval { reduce {$_[0] && $_[1]} map $_->eval(), @{$_[0]{__DIRECTIVE1__}} }

package addn ;
use List::Util  'reduce';
sub eval { reduce {$_[0] + $_[1]} map $_->eval(), @{$_[0]{__DIRECTIVE1__}} }

package mult ;
use List::Util  'reduce';
sub eval { reduce {$_[0] * $_[1]} map $_->eval(), @{$_[0]{__DIRECTIVE1__}} }

package expo ;
use List::Util  'reduce';
sub eval { reduce {$_[0] ** $_[1]} map $_->eval(), @{$_[0]{__DIRECTIVE1__}} }

package value ;
sub eval { return $_[0]{__VALUE__} }