fREWdiculous!
27 Feb
I did this because of the excellent Higher-Order Perl.
Here is the Perl 5 code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | #!/usr/bin/perl use strict; use warnings; my $op_dispatch_table = { '+' => sub { my ($stack) = @_; push @$stack, pop(@$stack) + pop(@$stack); }, '-' => sub { my ($stack) = @_; my $s = pop(@$stack); push @$stack, pop(@$stack) - $s; }, '*' => sub { my ($stack) = @_; push @$stack, pop(@$stack) * pop(@$stack); }, '/' => sub { my ($stack) = @_; my $s = pop(@$stack); push @$stack, pop(@$stack) / $s; }, 'sqrt' => sub { my $stack = shift; push @$stack, sqrt(pop(@$stack)); }, }; my $result = evaluate($op_dispatch_table, $ARGV[0]); print "Result: $result\n"; sub evaluate { my $odt = shift; my @stack; my ($expr) = @_; my @tokens = split /\s+/, $expr; for my $token (@tokens) { if ($token =~ /\d+$/) { push @stack, $token; } else { if (my $fn = $odt->{$token}) { $fn->(\@stack); } else { die "Unrecognized token '$token'; aborting"; } } } return pop(@stack); } |
And here is the Perl 6:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | #!/home/frew/personal/rakudo/perl6 my %op_dispatch_table = { '+' => sub (@stack) { @stack.push(@stack.pop + @stack.pop); }, '-' => sub (@stack) { # this should probably be: # @stack.push(@stack.pop R- @stack.pop); my $s = @stack.pop; @stack.push(@stack.pop - $s); }, '*' => sub (@stack) { @stack.push(@stack.pop * @stack.pop); }, '/' => sub (@stack) { # this should probably be: # @stack.push(@stack.pop R/ @stack.pop); my $s = @stack.pop; @stack.push(@stack.pop / $s); }, 'sqrt' => sub (@stack) { @stack.push(@stack.pop.sqrt); }, }; sub evaluate (%odt, $expr) { my @stack; my @tokens = $expr.split(/\s+/); for @tokens -> $token { if $token ~~ /^\d+$/ { @stack.push($token); } else { if my &fn = %odt{$token} { &fn(@stack); } else { die "Unrecognized token '$token'; aborting"; } } } return @stack.pop; } say "Result: { evaluate(%op_dispatch_table, @*ARGS[0]) }"; |
Usage: ./calc.pl “5 6 +”
The main differences to notice are sigil invariance, subroutine signatures, and method instead of function syntax.
4 Responses for "Perl 5 to Perl 6: a Reverse Polish Notation Calculator"
Very very nice!
Note that @stack above probably needs to be declared ‘is rw’ above — by default it should be readonly, but Rakudo doesn’t implement the is readonly trait on arrays or hashes yet.
This prompted me to see if I could make a shorter version — I posted my version at http://use.perl.org/~pmichaud/journal/38580 .
And yes, I think I may go implement the R metaoperator now…
Thanks again!
Pm
[...] Perl 5 to Perl 6: a Reverse Polish Notation Calculator [...]
Would you mind if I include this as an example in perl6-examples ?
Scott
I tried the Perl 5 version on 5.10 and got warnings.
What is the syntax without an enter key?
I tried several “4 5 +” and got 4
5 + 5 and got 5.
It appears that the result is always the first number.
I am teaching my 14 year old grandson Technology and was hoping to use this as an example, but I need it to work.
What an I doing wrong?
Leave a reply