Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Tales from writing a RPN evaluator in Perl 5, Perl 6 and Haskell

by eyepopslikeamosquito (Canon)
on Jan 04, 2006 at 09:23 UTC ( #520826=perlmeditation: print w/ replies, xml ) Need Help??

Perl makes easy things easy and hard things possible.

-- Official Perl Slogan, coined by Larry Wall

Haskell makes hard things easy and easy things weird.

-- Larry at it again, this time coining an unofficial Haskell slogan :-)

We want Perl 6 to make easy things trivial, hard things easy, and impossible things merely hard.

-- Damian Conway in A Taste of Perl 6, Linux Magazine, April 2003

After Audrey Tang's recent whirlwind Sydney tour, I felt inspired to get back into Pugs development. This time, however, I was determined to learn Haskell, so I could at least understand important parts of the Pugs code base.

To get started learning Haskell, I felt I needed to write something non-trivial yet attainable. Somewhat arbitrarily, I chose to write a tiny RPN evaluator in Perl 5, Perl 6, and Haskell ... then sit back and compare and contrast the code. Despite my dubious past, I wanted to write the code in a clear and natural style for each of the languages, avoiding clever golfish tricks like the plague. And being a testing Fascist, I certainly wanted to see how the unit tests looked in all three languages.

This meditation describes that endeavour.

Perl 5

I started with a straightforward Perl 5 version, in the form of a little Rpn.pm module:

package Rpn; use strict; use warnings; sub evaluate { my ($expr) = @_; my @stack; for my $tok (split ' ', $expr) { if ($tok =~ /^-?\d+$/) { push @stack, $tok; next; } my $x = pop @stack; defined $x or die "Stack underflow\n"; my $y = pop @stack; defined $y or die "Stack underflow\n"; if ($tok eq '+') { push @stack, $y + $x; } elsif ($tok eq '-') { push @stack, $y - $x; } elsif ($tok eq '*') { push @stack, $y * $x; } elsif ($tok eq '/') { push @stack, int($y / $x); } else { die "Invalid token:\"$tok\"\n"; } } @stack == 1 or die "Invalid stack:[@stack]\n"; return $stack[0]; } 1;
and an associated test driver:
use strict; use warnings; use Test::More; use Rpn; my @normal_tests = ( [ '1 2 +', 3 ], [ '1 -2 -', 3 ], [ '-1 2 +', 1 ], [ '1 2 -', -1 ], [ '1 2 + 3 -', 0 ], [ '1 2 - 3 -', -4 ], [ '1 2 - 5 +', 4 ], [ '1 2 - 5 + 2 -', 2 ], [ '1 1 1 1 1 2 + + + + +', 7 ], [ '1 -5 +', -4 ], [ '5 3 *', 15 ], [ '-2 -5 *', 10 ], [ '2 -5 *', -10 ], [ '6 4 /', 1 ], [ '0 1 /', 0 ], [ '1 0 *', 0 ], [ '00 1 +', 1 ], [ '1 00 -', 1 ], [ '00', 0 ], [ '-00', 0 ], [ '1 2 3 * +', 7 ], [ '3 4 * 2 3 * +', 18 ], [ '3 4 * 2 / 3 *', 18 ], [ '3 4 * 5 / 3 *', 6 ], [ '999999 1000 / 67 * 56 80 * 8 * -', 31093 ], [ '42', 42 ], ); my @exception_tests = ( [ '5 4 %', "Invalid token:\"%\"\n" ], [ '5 +', "Stack underflow\n" ], [ '+', "Stack underflow\n" ], [ '5 4 + 42', "Invalid stack:[9 42]\n" ], [ '', "Invalid stack:[]\n" ], ); plan tests => @normal_tests + @exception_tests; for my $t (@normal_tests) { cmp_ok(Rpn::evaluate($t->[0]), '==', $t->[1]); } for my $t (@exception_tests) { eval { Rpn::evaluate($t->[0]) }; is($@, $t->[1]); }
I trust this test driver makes clear the purpose of the Rpn::evaluate function.

Perl 6

Here's a straightforward Perl 6 translation that runs today on Pugs:

module Rpn-0.0.1-cpan:ASAVIGE; sub evaluate (Str $expr) returns Int { my @stack; for ($expr.split()) -> $tok { if $tok ~~ rx:Perl5/^-?\d+$/ { @stack.push($tok); next; } my $x = @stack.pop() err die "Stack underflow\n"; my $y = @stack.pop() err die "Stack underflow\n"; given $tok { when '+' { @stack.push($y + $x) } when '-' { @stack.push($y - $x) } when '*' { @stack.push($y * $x) } when '/' { @stack.push(int($y / $x)) } default { die "Invalid token:\"$tok\"\n" } } } @stack.elems == 1 or die "Invalid stack:[@stack[]]\n"; return @stack[0]; }

Points to note:

  • The cute versioning in the module header, allowing multiple versions by different authors to coexist (see S11).
  • The (optional) type signature on the sub (see S06).
  • The err "defined or" operator (see S03).
  • The given/when "switch" statement (see S04).
  • The OO-style pushin' n' poppin' (see S12).
When Pugs implements it, I'll change the die above to fail. Generally, fail is preferred in library code since it offers the library user a choice of error handling idiom: either throwing an exception (a la die above) or returning undef.

Though all these Perl 6 improvements are certainly welcome, notice that the overall feel of the code remains Perlish.

Perl 6 is still Perlish, but a revolutionary step in refreshing new directions.

-- chromatic in Porting Test::Builder to Perl 6

It's heartening to note that a number of Perl 6 improvements are being retrofitted to Perl 5. Of the improvements mentioned above, as noted in chromatic's The Year in Perl 2005, both the "defined-or" operator and an improved Switch module are slated for inclusion in the upcoming Perl 5.10 release.

The Perl 6/Pugs companion test driver for Rpn.pm is little changed from its Perl 5 cousin:

#!/usr/bin/pugs use v6; use Test; use Rpn; my @normal_tests = ( [ '1 2 +', 3 ], [ '1 -2 -', 3 ], [ '-1 2 +', 1 ], [ '1 2 -', -1 ], [ '1 2 + 3 -', 0 ], [ '1 2 - 3 -', -4 ], [ '1 2 - 5 +', 4 ], [ '1 2 - 5 + 2 -', 2 ], [ '1 1 1 1 1 2 + + + + +', 7 ], [ '1 -5 +', -4 ], [ '5 3 *', 15 ], [ '-2 -5 *', 10 ], [ '2 -5 *', -10 ], [ '6 4 /', 1 ], [ '0 1 /', 0 ], [ '1 0 *', 0 ], [ '00 1 +', 1 ], [ '1 00 -', 1 ], [ '00', 0 ], [ '-00', 0 ], [ '1 2 3 * +', 7 ], [ '3 4 * 2 3 * +', 18 ], [ '3 4 * 2 / 3 *', 18 ], [ '3 4 * 5 / 3 *', 6 ], [ '999999 1000 / 67 * 56 80 * 8 * -', 31093 ], [ '42', 42 ], ); my @exception_tests = ( [ '5 4 %', "Invalid token:\"%\"\n" ], [ '5 +', "Stack underflow\n" ], [ '+', "Stack underflow\n" ], [ '5 4 + 42', "Invalid stack:[9 42]\n" ], [ '', "Invalid stack:[]\n" ], ); plan @normal_tests.elems + @exception_tests.elems; for @normal_tests -> $t { cmp_ok(Rpn::evaluate($t[0]), &infix:<==>, $t[1]); } for @exception_tests -> $t { try { Rpn::evaluate($t[0]) }; is($!, $t[1]); }
The observant reader will have noticed that the old Perl 5 block eval is now (less confusingly) spelled try.

This little example demonstrates that converting most Perl 5 programs to Perl 6 will be straightforward. Indeed, so straightforward that Larry is working on an automated way to do it. To find out what he's been up to, keep an eye on his "Translating Perl 5 to Perl 5" talk at the upcoming OSDC::Israel::2006 in February.

Haskell

Using Haskell is like having The Power of Reason.

-- autrijus/gaal on #perl6 IRC channel cited at hawiki quotes page

: I cannot decide if your analogies are false since I cannot make heads or tails of them.

You should try to make CARs and CDRs of them instead.

-- Larry Wall on comp.lang.lisp, Jan 21 1993

While translating Rpn from Perl 5 to Perl 6 was both pleasing and straightforward, translating it to Haskell felt, er, ... surreal-in-the-extreme, perhaps because I'd never programmed in a functional language before. It takes a while to get used to programming without variables, you see. ;-)

Anyway, after considerable study and much help from the wonderful PhD-powered Haskell community, I finally have a Haskell version of Rpn that I'm happy with:

{-# OPTIONS_GHC -fglasgow-exts -Wall #-} module Rpn (evaluate) where import Char isStrDigit :: String -> Bool isStrDigit = all isDigit -- Check that a string matches regex /^-?\d+$/. isSNum :: String -> Bool isSNum [] = False isSNum "-" = False isSNum ('-':xs) = isStrDigit xs isSNum xs = isStrDigit xs calc :: Int -> String -> Int -> Int calc x "+" y = x+y calc x "-" y = x-y calc x "*" y = x*y calc x "/" y = x`div`y calc _ tok _ = error $ "Invalid token:" ++ show tok evalStack :: [Int] -> String -> [Int] evalStack xs y | isSNum y = (read y):xs | (a:b:cs) <- xs = (calc b y a):cs | otherwise = error "Stack underflow" evaluate :: String -> Int evaluate expr | [e] <- el = e | otherwise = error $ "Invalid stack:" ++ show el where el = foldl evalStack [] $ words expr

Though I'm elated with this code, I urge any Haskell boffins listening to please respond away if you just saw something that made you pull a face.

Believe it or not, this Haskell code uses essentially the same algorithm as the Perl version. Notice that there is little need for a Stack abstract data type in Haskell (and I couldn't find one in the GHC libraries) because a built-in list can easily be used as a stack (just as it can be in Perl, via push and pop).

Here is the rough equivalence between the Perl 5 code and the Haskell code:

  • Perl split function <=> Haskell words function.
  • Perl for loop <=> Haskell foldl function to "fold" the evalStack function into the words list.
  • Perl @stack state variable <=> Haskell evalStack function.
  • Perl /-?\d+/ regex <=> Haskell isSNum function.
  • Perl if/elsif/else statement <=> Haskell calc function (using pattern matching).
  • Perl @stack == 1 test <=> Haskell [e] <- el pattern match.

Surprisingly, writing the test driver took me much longer than the Rpn module, mainly because I didn't grok monads.

Though QuickCheck (Perl equivalent: Test::LectroTest) is perhaps more Haskelly, I employed the ubiquitous xUnit port, HUnit for Haskell, as follows:

{-# OPTIONS_GHC -fglasgow-exts -Wall #-} -- t1.hs: build with: ghc --make -o t1 t1.hs Rpn.hs module Main where import Test.HUnit import Control.Exception import Rpn type NormalExpected = (String, Int) makeNormalTest :: NormalExpected -> Test makeNormalTest e = TestCase ( assertEqual "" (snd e) (Rpn.evaluate (fs +t e)) ) normalTests :: Test normalTests = TestList ( map makeNormalTest [ ( "1 2 +", 3 ), ( "1 -2 -", 3 ), ( "-1 2 +", 1 ), ( "1 2 -", -1 ), ( "1 2 + 3 -", 0 ), ( "1 2 - 3 -", -4 ), ( "1 2 - 5 +", 4 ), ( "1 2 - 5 + 2 -", 2 ), ( "1 1 1 1 1 2 + + + + +", 7 ), ( "1 -5 +", -4 ), ( "5 3 *", 15 ), ( "-2 -5 *", 10 ), ( "2 -5 *", -10 ), ( "6 4 /", 1 ), ( "0 1 /", 0 ), ( "1 0 *", 0 ), ( "00 1 +", 1 ), ( "1 00 -", 1 ), ( "00", 0 ), ( "-00", 0 ), ( "1 2 3 * +", 7 ), ( "3 4 * 2 3 * +", 18 ), ( "3 4 * 2 / 3 *", 18 ), ( "3 4 * 5 / 3 *", 6 ), ( "999999 1000 / 67 * 56 80 * 8 * -", 31093 ), ( "42", 42 ) ]) -- Exception wrapper for Rpn.evaluate -- The idea is to catch calls to the error function and verify -- that the expected error string was indeed written. evaluateWrap :: String -> IO String evaluateWrap x = do res <- tryJust errorCalls (Control.Exception.evaluate (Rpn.evaluate + x)) case res of Right r -> return (show r) Left r -> return r type ExceptionExpected = (String, String) makeExceptionTest :: ExceptionExpected -> Test makeExceptionTest e = TestCase ( do x <- evaluateWrap (fst e) assertEqual "" (snd e) x ) exceptionTests :: Test exceptionTests = TestList ( map makeExceptionTest [ ( "5 4 %", "Invalid token:\"%\"" ), ( "5 +", "Stack underflow" ), ( "+", "Stack underflow" ), ( "5 4 + 42", "Invalid stack:[42,9]" ), ( "", "Invalid stack:[]" ) ]) main :: IO Counts main = do runTestTT normalTests runTestTT exceptionTests

Exception Handling

Exception handling doesn't mix particularly well with pure lazy functional programming. For example, I couldn't get my test driver to work when testing calls to the error function until I added a Control.Exception.evaluate call here:

(Control.Exception.evaluate (Rpn.evaluate x))
to force evaluation of the function -- without it, an unevaluated thunk is (lazily) returned.

The best choice for exception handling in Haskell seems to be GHC Control.Exception. See also Simon Peyton Jones proposal for A semantics for imprecise exceptions.

Tracing and Debugging

My productivity increased when Autrijus told me about Haskell's trace function. He called it a refreshing desert in the oasis of referential transparency.

-- chromatic in Porting Test::Builder to Perl 6

Like the awkwardly cased chromatic, finding the trace function was a breakthrough moment during my first week of Haskell programming. For example, by changing:

f (x:y:zs) "+" = y+x:zs
to:
import Debug.Trace -- ... f (x:y:zs) "+" = trace ("+" ++ show x ++ ":" ++ show y ++ ":" ++ show +zs) (y+x:zs)
I could see what shenanigans Haskell was getting up to under the covers -- which I found an invaluable aid.

First Impressions

autrijus stares at type Eval x = forall r. ContT r (ReaderT x IO) (Rea +derT x IO x) and feels very lost <shapr> Didn't you write that code? <autrijus> yeah. and it works <autrijus> I just don't know what it means.

-- autrijus/shapr on #perl6 IRC channel cited at hawiki quotes page

What I enjoyed about Haskell in my first two weeks:

  • Pattern matching.
  • All the list stuff, especially list comprehensions.
  • Higher-order functions.
  • The rich type system.
  • It's "purity" and lack of side effects.
  • The "ghetto-ization" of IO.
  • The friendly, brainy, and helpful Haskell community.

What I did not enjoy about Haskell in my first two weeks:

  • Exception Handling.
  • The demands of the language sometimes got in my way.

Or as TheDamian might put it:

And that's what attracts me to Perl. The demands of the language itself don't get in the way of *using* the language.

-- Damian Conway in Builder AU interview

References

Acknowledgements

I'd like to thank the helpful IRC #perl6 folks (especially audreyt, luqui, gaal, aufrank, nnunley) for answering my questions and Cale Gibbard of Haskell-Cafe for explaining Control.Exception.evaluate to me.

Updated 5-jan: added ^$ anchors to regex in Rpn.pm (thanks ambrus).

Comment on Tales from writing a RPN evaluator in Perl 5, Perl 6 and Haskell
Select or Download Code
Re: Tales from writing a RPN evaluator in Perl 5, Perl 6 and Haskell
by Anonymous Monk on Jan 04, 2006 at 19:14 UTC
    Just thought I'd try my hand at creating the drop dead most simple examples I could. Doesn't handle errors as nicely.
    #Perl5 $rpn = "3 10 * 20 5 / +"; $dig = qr/-?\d+\s+/; $op = qr/[+\-*\/]/; %f = ("+" => sub{$_[0] + $_[1]}, "-" => sub{$_[0] - $_[1]}, "*" => sub{$_[0] * $_[1]}, "/" => sub{$_[0] / $_[1]}); 1 while($rpn =~ s/^(.*?)($dig)($dig)($op)/$1.($f{$4}->($2,$3))/e); print "$rpn\n";
    ...and...
    //Haskell main = print $ foldl eval [] $ words "3 10 * 20 5 / +" -- 34 eval (x:y:xs) "+" = y+x : xs eval (x:y:xs) "-" = y-x : xs eval (x:y:xs) "*" = y*x : xs eval (x:y:xs) "/" = y`div`x : xs eval xs dig = (read dig):xs
Re: Tales from writing a RPN evaluator in Perl 5, Perl 6 and Haskell
by SamCG (Hermit) on Jan 04, 2006 at 21:09 UTC
    Drat you.

    I've been toying with the idea of learning a bit of Haskell or Perl 6, and now you've made me want to learn both. And I still have so much plain old Perl 5 to learn!

    I'm only a part-time programmer! Have mercy, please...
Re: Tales from writing a RPN evaluator in Perl 5, Perl 6 and Haskell
by ambrus (Abbot) on Jan 04, 2006 at 22:20 UTC
    $tok =~ /-?\d+/ only checks whether the token contains an integer, so the token can be an integer and some junk before and after it. If I were you, I'd either use anchors like $tok =~ /^-?\d+$/ or at least use only the integer-looking part: if ($tok =~ /(-?\d+)/) { push @stack, $1; ...
      TIMTOWTDI...
      $x = "12plus some garbage"; $y = "5+-*&^%$#@!"; $sixty = $x * $y; print "$sixty\n"

        Yes, but not for strings like "12.99999e-2" or "somejunk42".

      You are right. My intent was to use /^-?\d+$/ but somehow I "forgot" to insert the anchors. :-( Curiously, when emulating the regex in hand-rolled Haskell code, I somehow "remembered" to insert the anchors. :-) I've updated the Perl code in the root node by inserting the anchors. The Haskell isStrDigit function already checks for all digits (equivalent to using the anchors) and so does not require update. Thanks ambrus.

        This sort of mistake is one of the reasons we're thinking about distinguishing two different levels of pattern match in Perl 6, which we're currently calling "token" matching and "rule" matching, for lack of better names. Rule matching does scanning while token matching doesn't. When a token is matched from within a rule it has to match at the current location, and it's the embedding of the token within the rule match that allows other stuff to match after the token. By itself, a token must match an entire string (maybe with surrounding whitespace). So eventually we should have a way to just ask if the string matches a "num" or "int" pattern of some sort by pretending the token matcher is a subroutine or method of some sort. Perhaps somewhere in the relationship between tokens and rules we also can manage whitespace without scattering modifiers everywhere.
Re: Tales from writing a RPN evaluator in Perl 5, Perl 6 and Haskell
by Anonymous Monk on Jan 13, 2006 at 03:58 UTC
    Here's a Ruby version:
    def evaluate expr stack = [] expr.split(/\s+/).each do |token| stack << case token when /^-?\d*$/ token.to_i when /^[+\-*\/]$/ right, left = stack.pop, stack.pop raise "Stack underflow" unless left and right left.send token, right else raise "Invalid token: #{token}" end end stack.length == 1 or raise "Invalid stack: #{stack}" stack[0] end
      That's pretty nice... Here is a straight port from Ruby to Perl6:
      sub evaluate ($expr) { my @stack; for $expr.split { @stack.push: do { when /^ -?\d* $/ { $_ } when <+ - * /> { my $right = @stack.pop; my $left = @stack.pop; defined($left & $right) or fail "Stack underflow"; $left.$_: $right; } fail "Invalid token: $_"; } } @stack == 1 or fail "Invalid stack: @stack"; @stack[0]; }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://520826]
Approved by Corion
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (16)
As of 2014-07-28 19:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (207 votes), past polls