aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Just another update

Browse source
This commit is contained in:
Ingy döt Net 2015-02-20 00:35:01 -05:00
parent a25938f123
commit 00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
Download patch file Download diff file Expand all files Collapse all files

76
Task/Parsing-Shunting-yard-algorithm/Perl/parsing-shunting-yard-algorithm.pl
View file

@ -1,51 +1,49 @@
use 5.010;
use strict;
use warnings;
my %prec = (
'^' => 4,
'*' => 3,
'/' => 3,
'+' => 2,
'-' => 2,
'(' => 1);
'^' => 4,
'*' => 3,
'/' => 3,
'+' => 2,
'-' => 2,
'(' => 1
);
my %assoc = (
'^' => 'right',
'*' => 'left',
'/' => 'left',
'+' => 'left',
'-' => 'left');
'^' => 'right',
'*' => 'left',
'/' => 'left',
'+' => 'left',
'-' => 'left'
);
sub shunting_yard {
my @inp = split ' ', $_[0];
my @ops;
my @res;
my @inp = split ' ', $_[0];
my @ops;
my @res;
my $report = sub { printf "%25s %-7s %10s %s\n", "@res", "@ops", $_[0], "@inp" };
my $shift = sub { $report->( "shift @_"); push @ops, @_ };
my $reduce = sub { $report->("reduce @_"); push @res, @_ };
my $report = sub { printf "%25s %-7s %10s %s\n", "@res", "@ops", $_[0], "@inp" };
my $shift = sub { $report->("shift @_"); push @ops, @_ };
my $reduce = sub { $report->("reduce @_"); push @res, @_ };
while( @inp ) {
given( shift @inp ) {
when ( /\d/ ) { $reduce->($_) }
when ( '(' ) { $shift->($_) }
when ( ')' ) { while( @ops and "(" ne (my $x = pop @ops) ) { $reduce->( $x ) } }
default {
my $newprec = $prec{$_};
while( @ops ) {
my $oldprec = $prec{$ops[-1]};
last if $newprec > $oldprec;
last if $newprec == $oldprec and $assoc{$_} eq 'right';
$reduce->( pop @ops );
}
$shift->( $_ );
}
}
}
while (@inp) {
my $token = shift @inp;
if ( $token =~ /\d/ ) { $reduce->($token) }
elsif ( $token eq '(' ) { $shift->($token) }
elsif ( $token eq ')' ) {
while ( @ops and "(" ne ( my $x = pop @ops ) ) { $reduce->($x) }
} else {
my $newprec = $prec{$token};
while (@ops) {
my $oldprec = $prec{ $ops[-1] };
last if $newprec > $oldprec;
last if $newprec == $oldprec and $assoc{$token} eq 'right';
$reduce->( pop @ops );
}
$shift->($token);
}
}
$reduce->( pop @ops ) while @ops;
@res;
}
local $, = " ";
say shunting_yard '3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3' ;
print shunting_yard '3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3';