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).
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 (fst 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:zsto:
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) (ReaderT x IO x) and feels very lostDidn't you write that code? yeah. and it works 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.
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
- [id://79436]
- [id://423305]
- [id://369174]
- [id://205797]
- [id://450922]
- TPR(0,5a)
- Pugs svn (code in this article lives here)
- On CPAN: Math::RPN, Parse::RPN, Affix::Infix2Postfix.
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]).
#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
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...
$x = "12plus some garbage"; $y = "5+-*&^%$#@!"; $sixty = $x * $y; print "$sixty\n"
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.
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
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];
}