1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 module Main where 20 import RealReals 21 import Char 22 23 24 25 main = getContents >>= (foldr output (return ()) . map doLine . lines) 26 27 28 29 output :: String -> IO () -> IO () 30 output string dialogue = putStr (string++"\n") >> dialogue 31 32 33 34 35 doLine :: String -> String 36 doLine = eval [] . tokenize 37 38 tokenize "" = [] 39 tokenize (c:cs) | isSpace c = tokenize (dropWhile isSpace cs) 40 tokenize (c:cs) | isSymb c = [c]: tokenize cs 41 tokenize (c:cs) | isAlpha c = case (span isAlphaNum cs) of 42 (nam,t) -> (c:nam): tokenize t 43 tokenize (c:cs) | isDigit c = case (span isDigit cs) of 44 (num,t) -> (c:num): tokenize t 45 tokenize _ = ["Error"] 46 47 isSymb c = c `elem` "*+-/" 48 49 eval :: [RealReal] -> [String] -> String 50 eval [n] [] = show n 51 eval ns (t:ts) | isSymb (head t) 52 = case head t of 53 '+' -> check2 (+) ns ts 54 '-' -> check2 (-) ns ts 55 '*' -> check2 (*) ns ts 56 '/' -> check2 (/) ns ts 57 _ -> "Error" 58 eval ns (t:ts) | isDigit (head t) 59 = eval (fromInteger (parseInteger t): ns) ts 60 eval ns (t:ts) | isAlpha (head t) 61 = case t of 62 "abs" -> check1 abs ns ts 63 "signum" -> check1 signum ns ts 64 "pi" -> eval (pi:ns) ts 65 "exp" -> check1 exp ns ts 66 "log" -> check1 log ns ts 67 "sqrt" -> check1 sqrt ns ts 68 "sin" -> check1 sin ns ts 69 "cos" -> check1 cos ns ts 70 "tan" -> check1 tan ns ts 71 "asin" -> check1 asin ns ts 72 "acos" -> check1 acos ns ts 73 "atan" -> check1 atan ns ts 74 "sinh" -> check1 sinh ns ts 75 "cosh" -> check1 cosh ns ts 76 "tanh" -> check1 tanh ns ts 77 "asinh" -> check1 asinh ns ts 78 "acosh" -> check1 acosh ns ts 79 "atanh" -> check1 atanh ns ts 80 _ -> "Error" 81 eval _ _ = "Error" 82 83 check1 :: (RealReal -> RealReal) -> [RealReal] -> [String] -> String 84 check1 f (n:ns) ts = eval (f n: ns) ts 85 check1 f _ ts = "Error" 86 87 check2 :: (RealReal -> RealReal -> RealReal) -> 88 [RealReal] -> [String] -> String 89 check2 f (n0:n1:ns) ts = eval (f n1 n0 : ns) ts 90 check2 f _ ts = "Error" 91 92 parseInteger :: String -> Integer 93 parseInteger = makeNumber 10 . map number 94 where number :: Char -> Integer 95 number c = toInteger (fromEnum c - fromEnum '0') 96 97 makeNumber :: Integer -> [Integer] -> Integer 98 makeNumber m = foldl f 0 99 where f a x = a * m + x 100