summaryrefslogtreecommitdiff
path: root/rpn.hs
diff options
context:
space:
mode:
Diffstat (limited to 'rpn.hs')
-rw-r--r--rpn.hs53
1 files changed, 49 insertions, 4 deletions
diff --git a/rpn.hs b/rpn.hs
index a0d33ef..5c75fcf 100644
--- a/rpn.hs
+++ b/rpn.hs
@@ -1,8 +1,13 @@
1import Control.Monad (join, sequence) 1import Control.Monad (join, sequence)
2import System.Environment (getArgs) 2import System.Environment (getArgs)
3import Data.Maybe (listToMaybe, isJust)
4import Data.Char (isSpace)
5import Data.List (nub)
3import qualified Control.Monad.State as S 6import qualified Control.Monad.State as S
7import qualified Data.Map as M
8import System.IO
4 9
5data Symbol a = Number a a | Err | Add | Sub | Mult | Div | Unc deriving (Eq, Ord, Show) 10data Symbol a = Number a a | Err | Add | Sub | Mult | Div | Unc | Exp deriving (Eq, Ord, Show)
6instance Floating a => Num (Symbol a) where 11instance Floating a => Num (Symbol a) where
7 (Number x del) + (Number y del') = Number (x + y) (abs $ gMean [del, del']) 12 (Number x del) + (Number y del') = Number (x + y) (abs $ gMean [del, del'])
8 _ + _ = Err 13 _ + _ = Err
@@ -32,14 +37,47 @@ fromSymbol :: Floating a => Symbol a -> (a, a)
32fromSymbol (Number x d) = (x, d) 37fromSymbol (Number x d) = (x, d)
33fromSymbol _ = (0, 0) 38fromSymbol _ = (0, 0)
34 39
40
41pPrint :: Show a => Symbol a -> String
42pPrint (Number x d) = (show x) ++ " ± " ++ (show d)
43pPrint s = show s
44
35main :: IO () 45main :: IO ()
36main = do 46main = do
37 (mode:stdin:_) <- getArgs 47 hSetBuffering stdin LineBuffering
38 let symbols = map interpreteSymbol $ join $ map words . lines $ stdin 48 hSetBuffering stdout NoBuffering
39 result = evalExpVec symbols 49 (mode:args) <- getArgs
50 let symbols = join . join $ map (map words) . map lines $ args
51 unknownSymbols = nub $ filter (not . isKnownSymbol) symbols
52 symbolMap <- sequence $ map (sequencePair . (\x -> (x, clarifySymbol x))) unknownSymbols
53 let symbolMap' = M.fromList symbolMap
54 symbols' = map (\x -> if x `elem` (M.keys symbolMap') then symbolMap' M.! x else [x]) symbols
55 symbols'' = map interpreteSymbol $ join symbols'
56 let result = evalExpVec symbols''
40 case mode of 57 case mode of
41 "n" -> putStrLn . show . fst $ fromSymbol result 58 "n" -> putStrLn . show . fst $ fromSymbol result
42 "e" -> putStrLn . show . snd $ fromSymbol result 59 "e" -> putStrLn . show . snd $ fromSymbol result
60 _ -> putStrLn $ pPrint result
61
62clarifySymbol :: String -> IO [String]
63clarifySymbol s = do
64 putStr $ "Define " ++ s ++ ": "
65 line <- getLine
66 return $ words line
67
68isKnownSymbol :: String -> Bool
69isKnownSymbol s = or [
70 s `elem` ["+", "-", "*", "/", "±", "e"],
71 isJust $ (maybeRead s :: Maybe Double)
72 ]
73
74sequencePair :: (a, IO b) -> IO (a, b)
75sequencePair (a, b) = do
76 b' <- b
77 return (a, b')
78
79maybeRead :: (Read a) => String -> Maybe a
80maybeRead = fmap fst . listToMaybe . filter (null . dropWhile isSpace . snd) . reads
43 81
44interpreteSymbol :: String -> Symbol Double 82interpreteSymbol :: String -> Symbol Double
45interpreteSymbol "+" = Add 83interpreteSymbol "+" = Add
@@ -47,6 +85,7 @@ interpreteSymbol "-" = Sub
47interpreteSymbol "*" = Mult 85interpreteSymbol "*" = Mult
48interpreteSymbol "/" = Div 86interpreteSymbol "/" = Div
49interpreteSymbol "±" = Unc 87interpreteSymbol "±" = Unc
88interpreteSymbol "e" = Exp
50interpreteSymbol x = Number (read x) 0 89interpreteSymbol x = Number (read x) 0
51 90
52evalExpVec :: Floating a => [Symbol a] -> Symbol a 91evalExpVec :: Floating a => [Symbol a] -> Symbol a
@@ -76,3 +115,9 @@ evalExp Mult = do
76evalExp Div = do 115evalExp Div = do
77 state <- S.get 116 state <- S.get
78 S.put $ ((foldl1 (/) . reverse $ take 2 state):drop 2 state) 117 S.put $ ((foldl1 (/) . reverse $ take 2 state):drop 2 state)
118evalExp Exp = do
119 state <- S.get
120 let
121 b = state !! 1
122 e = state !! 0
123 S.put $ ((b * (Number (10 ** (fst $ fromSymbol e)) 0)):drop 2 state)