open string generic monad io

type OpType = Push | Operate
  deriving Show

type Op = Op (OpType typ) input stack
  deriving Show

parse str = split " " str

eval stack []      = []
eval stack (x::xs) = op :: eval nst xs
  where (op, nst)  = conv x stack
        conv "+"@x = operate x (+)
        conv "-"@x = operate x (-)
        conv "*"@x = operate x (*)
        conv "/"@x = operate x (/)
        conv "^"@x = operate x (**)
        conv x     = \stack ->
          let n = gread x::stack in
          (Op Push x n, n)
        operate input fn (x::y::ys) =
          let n = (y `fn` x) :: ys in
          (Op Operate input n, n)

print_line (Op typ input stack) = do
  putStr input
  putStr "\t"
  put typ
  putStr "\t\t"
  putLn stack

print ((Op typ input stack)@x::xs) lv = print_line x `seq` print xs (head stack)
print [] lv = lv

print_result xs = do
  putStrLn "Input\tOperation\tStack after"
  res <- return $ print xs 0
  putStrLn ("Result: " ++ show res)

res = parse "3 4 2 * 1 5 - 2 3 ^ ^ / +" |> eval []
print_result res ::: IO