{-# Language ConstraintKinds #-}
{-# Language GADTs #-}
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)

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

---

{-
class Num a where
  (+) :: a -> a -> a
  (-) :: a -> a -> a
  (*) :: a -> a -> a
  negate :: a -> a
  abs :: a -> a
  signum :: a -> a
  fromInteger :: Integer -> a
-}

data DNum where
  NumAdd :: DNum -> DNum -> DNum
  NumSub :: DNum -> DNum -> DNum
  NumMul :: DNum -> DNum -> DNum
  NumNeg :: DNum -> DNum
  NumAbs :: DNum -> DNum
  NumSig :: DNum -> DNum
  NumInt :: Integer -> DNum
  deriving Show

instance Num DNum where
  (+) = NumAdd
  (-) = NumSub
  (*) = NumMul
  negate = NumNeg
  abs = NumAbs
  signum = NumSig
  fromInteger = NumInt

asNum :: Num a => DNum -> a
asNum = go
  where
    go (NumAdd a b) = go a + go b
    go (NumSub a b) = go a - go b
    go (NumMul a b) = go a * go b
    go (NumNeg a) = negate (go a)
    go (NumAbs a) = abs (go a)
    go (NumSig a) = signum (go a)
    go (NumInt i) = fromInteger i

class ToDNum a where
  toDNum :: a -> DNum

instance ToDNum DNum where
  toDNum = id

instance ToDNum Program where
  toDNum (P xs) = go [] xs
    where
      go [x] [] = x
      go xs (Const i:ys) = go (NumInt i:xs) ys
      go (a:b:xs) (BinOp op:ys) = go (bin op a b:xs) ys
      go (a:xs) (UnaOp op:ys) = go (una op a:xs) ys

      bin Add = NumAdd
      bin Sub = NumSub
      bin Mul = NumMul

      una Neg = NumNeg
      una Abs = NumAbs
      una Sig = NumSig

eval :: Program -> Integer
eval = asNum . toDNum