Saturday, October 13, 2007

A simple infix calculator in Haskell

I saw this on reddit and knew that my infix calculator was hanging around, so I decided to post it for some contrast.

There are a few problems, mainly that I had this desire to "not cheat" when I wrote it so I didn't use nearly as many Parsec functions as I could have. Also it's not very user-friendly, the only way to quit is Ctrl-C or EOF and EOF causes an error to be displayed. That said, here it is in all it's "glory". Compile with ghc --make Main.hs (or whatever you named the file, if you bothered).


module Main where
import Text.ParserCombinators.Parsec
import Control.Monad
import Control.Monad.Error
import System.IO

data Expr a = Number a
| Add (Expr a) (Expr a)
| Mul (Expr a) (Expr a)
| Sub (Expr a) (Expr a)
| Div (Expr a) (Expr a)
| Negate (Expr a)
deriving (Show, Eq)

data AddOp = Plus | Minus
data MulOp = Times | Over

evaluate :: (Fractional a, Monad m) => Expr a -> m a
evaluate (Negate x) = liftM negate (evaluate x)
evaluate (Div x y) = do x' <- (evaluate x)
y' <- (evaluate y)
if y' == 0 then fail "Division by zero"
else return $ x' / y'
evaluate (Sub x y) = liftM2 (-) (evaluate x) (evaluate y)
evaluate (Mul x y) = liftM2 (*) (evaluate x) (evaluate y)
evaluate (Add x y) = liftM2 (+) (evaluate x) (evaluate y)
evaluate (Number x) = return x



pDigit = oneOf ['0'..'9']
pSign = option '+' $ oneOf "-+"
pDigits = many1 pDigit
pDecimalPoint = char '.'
pFracPart = option "0" (pDecimalPoint >> pDigits)

number = do sign <- pSign
integerPart <- pDigits
fracPart <- pFracPart
expPart <- pExp
let i = read integerPart
let f = read fracPart
let e = expPart
let value = (i + (f / 10^(length fracPart))) * 10 ^^ e
return $ Number $ case sign of
'+' -> value
'-' -> negate value
where pExp = option 0 $ do
oneOf "eE"
sign <- pSign
num <- pDigits
let n = read num
return $ if sign == '-' then negate n else n

whitespace = many $ oneOf "\n\t\r\v "

term = do t <- term'
whitespace
return t
where term' = (try number) <|> negTerm <|> parenExpr

negTerm = do
char '-'
whitespace
e <- term
return $ Negate e

expr = do
first <- mulTerm
ops <- addOps
return $ foldl buildExpr first ops
where buildExpr acc (Plus, x) = Add acc x
buildExpr acc (Minus, x) = Sub acc x

addOp = do operator <- oneOf "+-"
whitespace
t <- mulTerm
return $ case operator of
'-' -> (Minus, t)
'+' -> (Plus, t)

addOps = many addOp


parenExpr = do char '('
e <- expr
char ')'
return e

mulTerm = do first <- term
ops <- mulOps
return $ foldl buildExpr first ops
where buildExpr acc (Times, x) = Mul acc x
buildExpr acc (Over, x) = Div acc x

mulOp = do operator <- oneOf "*/"
whitespace
t <- term
return $ case operator of
'*' -> (Times, t)
'/' -> (Over, t)

mulOps = many mulOp
calculation = do whitespace
e <- expr
eof
return e

evalPrint s = case (parse calculation "" s) of
Right x -> case evaluate x of
Right v -> print v
Left err -> putStrLn $ "Error: " ++ err
Left err -> putStr "parse error at " >> print err

main = getLine >>= evalPrint >> main

3 comments:

Anonymous said...

[url=http://www.23planet.com]online casino[/url], also known as covenanted casinos or Internet casinos, are online versions of weighty ("chunk and mortar") casinos. Online casinos legalization gamblers to affect up and wager on casino games with the hand out the Internet.
Online casinos superficially invite odds and payback percentages that are comparable to land-based casinos. Some online casinos avow on higher payback percentages as a countermeasure to the extent of r“le of cadre games, and some bruit down payout correlation audits on their websites. Assuming that the online casino is using an aptly programmed unsystematic consolidate up generator, gaming-table games like blackjack clothed an established repress edge. The payout cut up up after these games are established on non-standard owing to the rules of the game.
Uncountable online casinos license completely or discern their software from companies like Microgaming, Realtime Gaming, Playtech, Supranational Cunning Technology and CryptoLogic Inc.

Anonymous said...

Keep on working, great job!

my homepage :: jocuri online masini

Anonymous said...

Hi there I am so grateful I found your blog page, I really found you by mistake, while I was researching on Yahoo for something else, Regardless I am here now and would just like to say many thanks
for a remarkable post and a all round exciting blog (I also love the
theme/design), I don’t have time to read it all at the moment but I have book-marked it and also included your RSS feeds, so when I have
time I will be back to read a great deal more, Please do keep up the great work.


Stop by my web page: jocuri gratis onlin