diff options
-rwxr-xr-x | rpn.hs | 28 |
1 files changed, 15 insertions, 13 deletions
@@ -1,4 +1,6 @@ | |||
1 | import Control.Monad (join, sequence) | 1 | #!/usr/bin/env runghc |
2 | |||
3 | import Control.Monad (join, sequence, forever) | ||
2 | import System.Environment (getArgs) | 4 | import System.Environment (getArgs) |
3 | import Data.Maybe (listToMaybe, isJust) | 5 | import Data.Maybe (listToMaybe, isJust) |
4 | import Data.Char (isSpace) | 6 | import Data.Char (isSpace) |
@@ -39,25 +41,25 @@ fromSymbol _ = (0, 0) | |||
39 | 41 | ||
40 | 42 | ||
41 | pPrint :: Show a => Symbol a -> String | 43 | pPrint :: Show a => Symbol a -> String |
42 | pPrint (Number x d) = (show x) ++ " ± " ++ (show d) | 44 | pPrint (Number x d) = (show x) ++ " ± " ++ (show d) ++ " (relative error: " ++ (show $ d / x) ++ ")" |
43 | pPrint s = show s | 45 | pPrint s = show s |
44 | 46 | ||
45 | main :: IO () | 47 | main :: IO () |
46 | main = do | 48 | main = do |
47 | hSetBuffering stdin LineBuffering | 49 | hSetBuffering stdin LineBuffering |
48 | hSetBuffering stdout NoBuffering | 50 | hSetBuffering stdout NoBuffering |
49 | (mode:args) <- getArgs | 51 | forever $ do |
50 | let symbols = join . join $ map (map words) . map lines $ args | 52 | putStr "Formula: " |
53 | line <- getLine | ||
54 | let --symbols = join . join $ map (map words) . map lines $ args | ||
55 | symbols = words line | ||
51 | unknownSymbols = nub $ filter (not . isKnownSymbol) symbols | 56 | unknownSymbols = nub $ filter (not . isKnownSymbol) symbols |
52 | symbolMap <- sequence $ map (sequencePair . (\x -> (x, clarifySymbol x))) unknownSymbols | 57 | symbolMap <- sequence $ map (sequencePair . (\x -> (x, clarifySymbol x))) unknownSymbols |
53 | let symbolMap' = M.fromList symbolMap | 58 | let symbolMap' = M.fromList symbolMap |
54 | symbols' = map (\x -> if x `elem` (M.keys symbolMap') then symbolMap' M.! x else [x]) symbols | 59 | symbols' = map (\x -> if x `elem` (M.keys symbolMap') then symbolMap' M.! x else [x]) symbols |
55 | symbols'' = map interpreteSymbol $ join symbols' | 60 | symbols'' = map interpreteSymbol $ join symbols' |
56 | let result = evalExpVec symbols'' | 61 | let result = evalExpVec symbols'' |
57 | case mode of | 62 | putStrLn . pPrint $ evalExpVec symbols'' |
58 | "n" -> putStrLn . show . fst $ fromSymbol result | ||
59 | "e" -> putStrLn . show . snd $ fromSymbol result | ||
60 | _ -> putStrLn $ pPrint result | ||
61 | 63 | ||
62 | clarifySymbol :: String -> IO [String] | 64 | clarifySymbol :: String -> IO [String] |
63 | clarifySymbol s = do | 65 | clarifySymbol s = do |