rpn.hs

import qualified Data.Char as Ctype


main = do cs <- getContents
          print $ calculate $ parse cs

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) =
        if isFunc token
        then calculate (callFunc token stk) rest
        else calculate [token] ++ stk rest
        where

        -- Call function and return result stack.
        callFunc token stk =
                let (TokenNumber i1) = stk !! 0
                    (TokenNumber i2) = stk !! 1
                    result = (getFunc token) i1 i2
                in [result] ++ drop 2 stk

        -- TODO: Don't repeat yourself
        isFunc Add       = True
        isFunc Subtract  = True
        isFunc Multiply  = True
        isFunc Divide    = True
        isFunc _         = False

        getFunc Add      = (+)
        getFunc Subtract = (-)
        getFunc Multiply = (*)
        getFunc Divide   = div
        getFunc token    = error "No such function: " ++ token


parse = parse' [getNum, getNum, getOp]
parse' :: [(String -> (Token, String))] -> String -> [Token]
parse' [] cs = []
parse' (tokenize:ts) cs =
        let (token, rest) = tokenize cs
        in token : (parse' ts $ dropWhile Ctype.isSpace rest)

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

getOp ('+':rest) = (Add, rest)
getOp ('-':rest) = (Subtract, rest)
getOp ('*':rest) = (Multiply, rest)
getOp ('/':rest) = (Divide, rest)
getOp (token:rest) = error $ "unknown token '" ++ [token] ++ "'."

-- TODO: 2桁以上、単項マイナスに対応
getNum (token:rest) | Ctype.isNumber token = (TokenNumber (read [token] :: Int), rest)
getNum (token:_) = error $ "expected number, but got token '" ++ [token] ++ "'."