fork download
  1. {-# LANGUAGE NoMonomorphismRestriction #-}
  2. import Control.Monad
  3. import Control.Applicative
  4. import Data.Complex
  5. import Foreign.C.Types
  6.  
  7. calcRPN fs s = do
  8. [result] <- foldM f [] $ words s
  9. return result
  10. where
  11. f = foldr (\f g xs s -> f xs s <|> g xs s) push fs
  12. push xs s = (:xs) <$> case reads s of {[(x, "")] -> Just x; _ -> Nothing}
  13.  
  14.  
  15. infixMaybe op a (y:x:xs) b | a == b = Just $ x `op` y : xs
  16. | otherwise = Nothing
  17. infixMaybe _ _ _ _ = Nothing
  18.  
  19. add = infixMaybe (+) "+"
  20. sub = infixMaybe (-) "-"
  21. mul = infixMaybe (*) "*"
  22. fdiv = infixMaybe (/) "/"
  23.  
  24. extension zs@(x:xs) "sum" = Just [sum zs]
  25. extension (x:xs) "exp" = Just $ exp x : xs
  26. extension _ _ = Nothing
  27.  
  28. --ndiv = infixMaybe div "/" -- might raise the divide-by-zero exception
  29. ndiv (y:x:xs) "/" | y /= 0 = Just $ x `div` y : xs
  30. | otherwise = Nothing
  31. ndiv _ _ = Nothing
  32.  
  33.  
  34. main = do
  35. print $ calcRPN [add, sub, mul, fdiv] "3 19 + -2 /"
  36. print $ calcRPN [add, sub, mul, fdiv] "1 2 3"
  37. print $ calcRPN [add, sub, mul, fdiv, extension] "5 4 - exp 3 -2 1 sum"
  38. print $ calcRPN [add, sub, mul, fdiv] "5 2.5 +"
  39. print $ calcRPN [add, sub, mul, ndiv] "5 2.5 +"
  40. print $ calcRPN [add, sub, mul, ndiv] "5 2 /"
  41. print $ calcRPN [add, sub, mul, ndiv] "0 0 /"
  42. print $ (calcRPN [add, sub, mul, ndiv] "1 2 -" :: Maybe CUInt)
  43. print $ (calcRPN [add, sub, mul, fdiv, extension] :: String -> Maybe (Complex
  44. Double)) "1:+1 3:+(-2) + exp"
  45.  
Success #stdin #stdout 0.02s 3756KB
stdin
Standard input is empty
stdout
Just (-11.0)
Nothing
Just 4.718281828459045
Just 7.5
Nothing
Just 2
Nothing
Just 4294967295
Just (29.49950635904248 :+ (-45.94275907707917))