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