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 ($)
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
;;
What's the "let create_table ..." bit for? it doesn't seem to be referenced in the rest of your code.
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
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
<< Home

