December 18, 2011 23:13 · Dec 18, 2011
diff --git a/rpn.hs b/rpn.hs
@@ -0,0 +1,58 @@
+
+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] ++ "'."