Server IP : 85.214.239.14 / Your IP : 13.59.82.60 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 : |
use v5.10; use warnings; # WHO IS NEXT TO WHOM? use Parse::RecDescent; $grammar = q{ <nocheck> inputs : input(s) input : who_question "\n" {1} | is_question "\n" {1} | statement "\n" {1} | /bye|quit|exit/ { exit } | <reject:!$text> <error> # ERROR IF NOT END OF TEXT | { print STDERR "resyncing\n" } { _error(@$_) foreach @{$thisparser->{errors}}; } <resync> statement: namelist are <commit> 'next' 'to' namelist { ::nextto $item[1], $item[6], $thisline; 1 } | <error?> <reject> who_question: 'who' <commit> are 'next' 'to' name '?' { ::whonextto $item[6] ; 1 } | <error?> <reject> is_question: 'is' <commit> name 'next' 'to' name '?' { ::isnextto($item[3], $item[6]); 1 } | <error?> <reject> namelist : name(s) 'and' <commit> namelist { [ @{$item[1]}, @{$item[3]} ] } | name(s) name : ...!'who' ...!'and' ...!are /[A-Za-z]+/ are : 'is' | 'are' }; $parse = new Parse::RecDescent ($grammar); $parse->{tokensep} = '[ \t]*'; $input = ''; print "> "; while (<>) { if (/^\.$/) { $parse->inputs($input) || print "huh?\n"; $input = '' } else { $input .= $_ } print "> "; } sub nextto($$$) { foreach $A ( @{$_[0]} ) { foreach $B ( @{$_[1]} ) { nexttoAB($A,$B,$_[2]); } } print "okay\n"; } sub nexttoAB($$$) { $nextto{$_[0]} or $nextto{$_[0]} = []; $nextto{$_[1]} or $nextto{$_[1]} = []; push @{$nextto{$_[0]}}, $_[1]; push @{$nextto{$_[1]}}, $_[0]; print "Learnt something from line $_[2]\n"; } sub whonextto($) { if (defined $nextto{$_[0]}) { print join(" and ", @{$nextto{$_[0]}}) . ".\n"; } else { print "sorry, I've never heard of $_[0].\n"; } } sub isnextto($$) { if (!$nextto{$_[0]}) { print "sorry, I've never heard of $_[0].\n"; } elsif (!$nextto{$_[1]}) { print "sorry, I've never heard of $_[1].\n"; } else { foreach $name (@{$nextto{$_[0]}}) { if ($name eq $_[1]) { print "yes\n"; return } } print "no\n"; } }