hsilop/hsilop.hs

{-# LANGUAGE ViewPatterns #-}

import Data.List
import Text.Read
import Text.Printf
import Control.Monad

main :: IO ()
main = io (result . rpn)


-- Interact line-by-line
io :: (String -> String) -> IO ()
io f = interact (unlines . map f . filter (not . null) . lines)


-- Pretty print RPN result/errors
result :: Either String Double -> String
result (Left err) = "Ꞥ∘ " ++ err
result (Right x)  = printf ("ꟼ∘ " ++ format) x where
  format = if ceiling x == floor x then "%.0f" else "%.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 x = case readMaybe x of
    Just x  -> Right (x : xs)
    Nothing -> 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) ]