Калькулятор с обратной польской записью

import System.IO
import Data.Maybe
import Control.Monad
import qualified Data.Map as M
import Text.ParserCombinators.Parsec hiding (space)
 
data Token = Number Integer
           | BinOp (Integer -> Integer -> Integer)
           | UnOp (Integer -> Integer)
 
number, operator :: Parser Token
number = liftM (Number . read) (many1 digit) <?> "number"
 
table :: M.Map String Token
table = M.fromList [ ("+", BinOp (+))
                   , ("*", BinOp (*))
                   , ("-", BinOp (-))
                   , ("/", BinOp div)
                   , ("^", BinOp (^))
                   , ("!", UnOp fact)
                   , ("~", UnOp negate)
                   ]
 
fact :: Integer -> Integer
fact n = product [1..n]
 
operator = liftM (fromJust . (flip M.lookup) table) (choice (map string $ M.keys table))
       <?> "operator"
 
expr :: Parser [Token]
expr = do r <- skipMany space >> (number <|> operator) `sepEndBy1` (skipMany1 space)
          eof <|> ((char '\n' <?> "newline") >> return ())
          return r
    where space = oneOf " \t"
          
run :: String -> IO ()
run input = case either (Left . show) (eval []) (parse expr "expr" input) of
              Left err     -> hPutStrLn stderr err
              Right result -> print result
 
eval :: [Integer] -> [Token] -> Either String Integer
eval [x] []               = Right x
eval ys (Number x:xs)     = eval (x:ys) xs
eval (y:z:w) (BinOp x:xs) = eval (x z y : w) xs 
eval (y:ys) (UnOp x:xs)   = eval (x y : ys) xs
eval _ _                  = Left "illegal expression"
 
main :: IO ()
main = do hSetBuffering stdout NoBuffering
          forever $ putStr "> " >> hFlush stderr >> getLine >>= run