hsilop/hsilop.hs
2015-02-28 00:50:25 +01:00

64 lines
1.6 KiB
Haskell

{-# LANGUAGE ViewPatterns #-}
import Data.List
import Data.Maybe
import Text.Read
import Text.Printf
import Control.Monad
import System.Console.Readline
main :: IO ()
main = do
line <- readline ""
case fromMaybe "" line of
"" -> main
"q" -> return ()
exp -> do
putStrLn $ result (rpn exp) ++ "\n"
addHistory exp
main
-- Pretty print RPN result/errors
result :: Either String Double -> String
result (Left err) = "Ꞥ∘ " ++ err
result (Right x) = printf format x where
format | ceiling x == floor x = "∘ %.0f"
| otherwise = "∘ %.10f"
-- Solve a RPN expression
rpn :: String -> Either String Double
rpn = foldM parse [] . words >=> return . head where
parse (y:x:xs) (flip lookup dyad -> Just f) = Right (f x y : xs)
parse (x:xs) (flip lookup monad -> Just f) = Right (f x : xs)
parse xs (flip lookup nilad -> Just k) = Right (k : xs)
parse xs (readMaybe -> Just x) = Right (x : xs)
parse _ _ = Left "syntax error"
-- dyadic functions
dyad = [ ("+", (+))
, ("-", (-))
, ("*", (*))
, ("/", (/))
, ("^", (**)) ]
-- monadic functions
monad = [ ("sin" , sin )
, ("asin" , asin)
, ("cos" , cos )
, ("acos" , acos)
, ("tan" , tan )
, ("atan" , atan)
, ("ln" , log )
, ("sqrt" , sqrt)
, ("sgn" , signum)
, ("abs" , abs)
, ("floor", fromIntegral . floor)
, ("ceil" , fromIntegral . ceiling) ]
-- niladic functions
nilad = [ ("pi" , pi)
, ("e" , exp 1)
, ("phi", (1 + sqrt 5)/2) ]