Saturday, November 11, 2006

 

A Simple RPN Calculator in Haskell

Of late I have been playing around with Haskell, a pure functional programming language. Last night I hacked up a quick RPN calculator and was pleasantly surprised at how easy it was. Example usage: (Note that because the stack is implemented as a list, the top of the stack is the first element of the list)

> 5 4 *
[20.0]
> 14
[14.0,20.0]
> *
[280.0]
> 2 * 48 -
[512.0]
> log 2 log /
[9.0]
> 2
[2.0,9.0]
> swap
[9.0,2.0]
> **
[512.0]
> 2 * sqrt
[32.0]

Here's the code:

import Char
import IO

type RPNNumber = Double
type Stack = [RPNNumber]
type Operator = (Stack -> Stack)

parse :: [Char] -> [Operator]
parse = map parseOp . words

binaryOp :: (RPNNumber -> RPNNumber -> RPNNumber) -> Operator
binaryOp f = (\ (a:b:stack) -> f b a : stack)

unaryOp :: (RPNNumber -> RPNNumber) -> Operator
unaryOp f = (\ (a:stack) -> f a : stack)

parseOp :: [Char] -> Operator
parseOp "+" = binaryOp (+)
parseOp "-" = binaryOp (-)
parseOp "*" = binaryOp (*)
parseOp "/" = binaryOp (/)
parseOp "**" = binaryOp (**)
parseOp "log" = unaryOp log
parseOp "sqrt" = unaryOp sqrt
parseOp "dup" = (\ (x:xs) -> x:x:xs)
parseOp "swap" = (\ (a:b:xs) -> b:a:xs)
parseOp "pop" = tail
parseOp number = (\stack -> (read number) : stack)

eval :: Stack -> [Operator] -> Stack
eval = foldl $ flip ($)

repl :: Stack -> IO ()
repl stack = do
  putStr "> " 
  hFlush stdout
  line <- getLine
  newstack <- return $ eval stack (parse line)
  putStrLn $ show newstack
  repl newstack

main = do repl []

That's only 42 lines of code, 25 without the optional type declarations and whitespace. The structure is pretty simple: A stack is a list of numbers, an operator is function that takes a stack and returns a new stack. The "parser" just splits a string into words and the maps each of those words to an operator.

binaryOp and unaryOp are helper functions that take functions and make them into operators. parseOp takes a string an returns the appropriate operator. Or, if its argument isn't recognized as an operator, parseOp assumes that it's a number and returns an operator that pushs it onto the stack.

The only function I'll admit to golfing is the "eval" function. Originally, I had it defined as:

eval stack [] = stack
eval stack (f:fs) = eval (f stack) fs

I kept thinking, "that really looks like a fold". The next step was:

eval = foldl (\stack f = f stack)

And from there it was simple to realize that all I had to do was flip the function application operator:

eval = foldl $ flip ($)

Comments:
A quick refactor for fun, here.
 
let create_table size init =
let tbl = Hashtbl.create size in
List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
tbl

let unaryOp f = function | a::s -> f a :: s
let binaryOp f = function | a::b::s -> f b a :: s

let tz line = match line with
| "+" -> binaryOp (+)
| "-" -> binaryOp (-)
| "*" -> binaryOp ( * )
| "/" -> binaryOp (/)
| "dup" -> (fun (x::xs) -> x::x::xs)
| "swap" -> (fun (a::b::xs) -> b::a::xs)
| "pop" -> List.tl
| _ as n -> (fun s -> (int_of_string n) :: s)

let rec eval s = function
| [] -> s
| h::t -> eval (h s) t

let parse line = List.map tz line
;;

let v = ["2";"23";"*";"17";"-";"444";"pop";"10";"/";] in
let e = eval [] (parse v) in e
;;
 
Ah, cool, an Ocaml hacker comes out of the woodwork. I haven't look into Ocaml in a while. I probably should take another look, "one of these days"...

What's the "let create_table ..." bit for? it doesn't seem to be referenced in the rest of your code.
 
Yes, you're right, let create_table... is redundant, the first attempt was to try to use hash table lookup instead of pattern matching.
 
For a laugh (and since I was bored at work), I translated this as directly as I could into Python. In the process I discovered a hack for simulating list pattern matching using varargs ;-)

Indentation is lost, of course...

import operator, math

def binaryOp(op):
return lambda a,b,*stack: (op(a,b),) + stack

def unaryOp(op):
return lambda a,*stack: (op(a),) + stack

ops = {
"+" : binaryOp(operator.add),
"-" : binaryOp(operator.sub),
"*" : binaryOp(operator.mul),
"/" : binaryOp(operator.div),
"**" : binaryOp(operator.pow),
"log" : unaryOp(math.log),
"sqrt" : unaryOp(math.sqrt),
"dup" : lambda a,*stack: (a,a) + stack,
"swap" : lambda a,b,*stack: (b,a) + stack,
"pop" : lambda a,*stack: stack,
}

def parseOp(x):
return ops[x] if x in ops else lambda *stack: (int(x),) + stack

def parse(s):
return map(parseOp, s.split())

def eval(words, stack):
if not words:
return stack
else:
return eval(words[1:], words[0](*stack))

def repl(stack=()):
line = raw_input("> ")
stack = eval(parse(line), stack)
print stack
repl(stack)

try:
repl()
except EOFError:
pass
 
Oops-- bug, binaryOp should be:

def binaryOp(op):
return lambda a,b,*stack: (op(b,a),) + stack
 
calc :: String -> [Float]
calc = foldl f [] . words
where
f (x:y:zs) "+" = y+x:zs
f (x:y:zs) "-" = y-x:zs
f (x:y:zs) "*" = y*x:zs
f (x:y:zs) "/" = y/x:zs
f xs y = read y : xs
 
I know the OCaml code above was supposed to be a direct translation, but you could do it much easier with OCaml's Stack module.
 
Post a Comment

<< Home

This page is powered by Blogger. Isn't yours?