64 lines
1.7 KiB
Haskell
64 lines
1.7 KiB
Haskell
{-# LANGUAGE ViewPatterns #-}
|
|
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Text.Read
|
|
import Text.Printf
|
|
import Control.Monad
|
|
import System.Console.Haskeline
|
|
|
|
main :: IO ()
|
|
main = runInputT defaultSettings repl
|
|
|
|
repl :: InputT IO ()
|
|
repl = do
|
|
line <- getInputLine "ꟼ "
|
|
case fromMaybe "" line of
|
|
"q" -> return ()
|
|
"" -> outputStrLn "" >> repl
|
|
exp -> outputStrLn (result (rpn exp) ++ "\n") >> repl
|
|
|
|
|
|
-- 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) ] |