module StackExpr where

data BinOp
  = Add
  | Mul
  | Sub
  deriving (Show)

data UnaOp
  = Neg
  | Abs
  | Sig
  deriving (Show)

data Instr
  = Const Integer
  | BinOp BinOp
  | UnaOp UnaOp
  deriving (Show)

binop :: BinOp -> Integer -> Integer -> Integer
binop Add = (+)
binop Mul = (*)
binop Sub = (-)

unaop :: UnaOp -> Integer -> Integer
unaop Neg = negate
unaop Abs = abs
unaop Sig = signum

newtype Program = P [Instr] deriving (Show)

formatBin :: BinOp -> Program -> Program -> Program
formatBin op (P a) (P b) = P (b ++ a ++ [BinOp op])

formatUna :: UnaOp -> Program -> Program
formatUna op (P a) = P (a ++ [UnaOp op])

instance Num Program where
  fromInteger i = P [Const i]
  (+) = formatBin Add
  (-) = formatBin Sub
  (*) = formatBin Mul
  negate = formatUna Neg
  abs = formatUna Abs
  signum = formatUna Sig

eval :: Program -> Integer
eval (P xs) = go [] xs
  where
    go (x:_) [] = x
    go xs (Const i:ys) = go (i:xs) ys
    go (a:b:xs) (BinOp x:ys) = go ((binop x a b):xs) ys
    go (a:xs) (UnaOp x:ys) = go ((unaop x a):xs) ys