Parsing/Shunting-yard algorithm: Difference between revisions
Content added Content deleted
m (→{{header|Phix}}: syntax coloured) |
|||
Line 4,087: | Line 4,087: | ||
=={{header|Raku}}== |
=={{header|Raku}}== |
||
(formerly Perl 6) |
(formerly Perl 6) |
||
<lang perl6> |
<lang perl6> |
||
my %prec = |
|||
'^' => 4, |
'^' => 4, |
||
'*' => 3, |
'*' => 3, |
||
Line 4,094: | Line 4,095: | ||
'-' => 2, |
'-' => 2, |
||
'(' => 1; |
'(' => 1; |
||
⚫ | |||
my %assoc = |
my %assoc = |
||
'^' => 'right', |
'^' => 'right', |
||
'*' => 'left', |
'*' => 'left', |
||
Line 4,101: | Line 4,102: | ||
'+' => 'left', |
'+' => 'left', |
||
'-' => 'left'; |
'-' => 'left'; |
||
sub shunting-yard ($prog) { |
sub shunting-yard ($prog) { |
||
my @inp = $prog.words; |
my @inp = $prog.words; |
||
my @ops; |
my @ops; |
||
my @res; |
my @res; |
||
sub report($op) { printf "%25s %-7s %10s %s\n", ~@res, ~@ops, $op, ~@inp } |
sub report($op) { printf "%25s %-7s %10s %s\n", ~@res, ~@ops, $op, ~@inp } |
||
sub shift($t) { report( "shift $t"); @ops.push: $t } |
sub shift($t) { report( "shift $t"); @ops.push: $t } |
||
sub reduce($t) { report("reduce $t"); @res.push: $t } |
sub reduce($t) { report("reduce $t"); @res.push: $t } |
||
while @inp { |
while @inp { |
||
given @inp.shift { |
|||
when /\d/ { reduce $_ }; |
|||
when '(' { shift $_ } |
|||
when ')' { while @ops and (my $x = @ops.pop and $x ne '(') { 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 @ops.pop; |
|||
} |
|||
} |
|||
shift $_; |
|||
} |
|||
} |
|||
⚫ | |||
} |
} |
||
reduce @ops.pop while @ops; |
reduce @ops.pop while @ops; |
||
@res; |
@res; |
||
} |
} |
||
say shunting-yard '3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3'; |
say shunting-yard '3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3'; |
||
</lang> |
|||
{{out}} |
{{out}} |
||
<pre> reduce 3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3 |
<pre> reduce 3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3 |