rpn.hs

import qualified Data.Char as Ctype


main = do cs <- getContents
          putStr $ unlines $ map (show . calculate . parse) $ lines cs

calculate :: [Token] -> Int
calculate cs = calculate' [] cs
    where
        calculate' :: [Token] -> [Token] -> Int
        calculate' (TokenNumber top:_) [] = top
        calculate' [] [] = error "stack is empty. no result."
        calculate' _  [] = error "top of stack is not TokenNumber."
        calculate' stk (token:rest) =
            case token of
                 (TokenNumber _) -> calculate' (token:stk) rest
                 otherwise       -> calculate' (callFunc token stk) rest
            where
                -- Call function and return result stack.
                callFunc token stk|length stk < 2 = error "stack underflow."
                callFunc token stk =
                        let (TokenNumber i1) = stk !! 0
                            (TokenNumber i2) = stk !! 1
                            result = (getFunc token) i1 i2
                        in TokenNumber result : drop 2 stk

                getFunc Add      = (+)
                getFunc Subtract = (-)
                getFunc Multiply = (*)
                getFunc Divide   = div


parse :: String -> [Token]
parse cs =
    case getToken cs of
         Just (token, rest) -> convertToken token : (parse $ dropWhile Ctype.isSpace rest)
         Nothing            -> []

data Token = Add | Subtract | Multiply | Divide
                 | TokenNumber Int
                 deriving Show

getToken :: String -> Maybe (String, String)
getToken [] = Nothing
getToken cs = return $ splitWhile (not . Ctype.isSpace) cs

splitWhile :: (a -> Bool) -> [a] -> ([a], [a])
splitWhile f xs = splitWhile' [] xs
    where
    splitWhile' left [] = (left, [])
    splitWhile' left (x:right)|f x = splitWhile' (left ++ [x]) right
    splitWhile' left right = (left, right)

convertToken :: String -> Token
convertToken "+" = Add
convertToken "-" = Subtract
convertToken "*" = Multiply
convertToken "/" = Divide

convertToken ('-':cs)|all Ctype.isNumber cs = TokenNumber (negate $ read cs :: Int)
convertToken ('+':cs)|all Ctype.isNumber cs = TokenNumber (read cs :: Int)
convertToken cs|all Ctype.isNumber cs       = TokenNumber (read cs :: Int)

convertToken cs = error $ "unknown token found: " ++ cs