gistfile1.hs

module Rpn
  where

import qualified Data.Map as Map

data Operator a = Unary (a -> a)
                | Binary (a -> a -> a)
                | Ternary (a -> a -> a -> a)
                | Quaternary (a -> a -> a -> a -> a)
                | Reductive ([a] -> a)
                | Projective ([a] -> [a])

project f (x:xs) = map (f x) xs

calculate :: (Num a) => Operator a -> [a] -> [a]
calculate (Unary op) (a:ns) = (op a):ns
calculate (Binary op) (a:b:ns) = (a `op` b):ns
calculate (Ternary op) (a:b:c:ns) = (op a b c):ns
calculate (Quaternary op) (a:b:c:d:ns) = (op a b c d):ns
calculate (Reductive op) ns = [op ns]
calculate (Projective op) ns = op ns

pow a b = a ^^ (floor b)
applyOperator (x:xs) = calculate op xs
  where op = (snd $ operatorList !! floor x)

operatorList :: [(String, Operator Double)]
operatorList = [
    ("neg", Unary negate),
    ("abs", Unary abs),
    ("sig", Unary signum),
    ("recip", Unary recip),
    ("exp", Unary exp),
    ("sqrt", Unary sqrt),
    ("log", Unary log),
    ("log10", Unary (logBase 10)),
    ("+", Binary (+)),
    ("-", Binary (-)),
    ("*", Binary (*)),
    ("/", Binary (/)),
    ("max", Binary max),
    ("min", Binary min),
    ("^", Binary pow),
    ("sum", Reductive sum),
    ("product", Reductive product),
    ("+´", Projective (project (+))),
    ("-´", Projective (project (-))),
    ("*´", Projective (project (*))),
    ("/´", Projective (project (/))),
    ("max´", Projective (project max)),
    ("min´", Projective (project min)),
    ("^´", Projective (project pow)),
    (">", Projective tail),
    ("><", Projective (\(x:y:ns) -> y:x:ns)),
    ("<", Projective (\(x:xs) -> x:x:xs)),
    ("<=>", Projective reverse),
    ("$", Projective applyOperator),
    (".", Projective (\(x:y:ns) -> [y .. x] ++ ns)),
    ("..", Projective (\(x:y:z:ns) -> [y, z .. x] ++ ns))
  ]
operators = Map.fromList operatorList

perform stack input = apply operator
  where apply Nothing = (read input):stack
        apply (Just op) = calculate op stack
        operator = Map.lookup input operators

performRpn input =
  show $ head $ foldl (perform) [] $ words input

main = interact (unlines . (map performRpn) . lines)