Compiler for a stack machine

Compiler1.hs

{-# LANGUAGE NoMonomorphismRestriction #-}

import Control.Applicative
import Text.ParserCombinators.UU (pChainl)
import Text.ParserCombinators.UU.BasicInstances(pSym)
import Text.ParserCombinators.UU.Utils


-- | Huttons razor
data Exp = Add Exp Exp
         | Lit Int
         deriving (Show)

-- | denotational semantics
eval :: Exp -> Int
eval (Add x y) = eval x + eval y
eval (Lit i)   = i

-- | Parser
pExp = foldr pChainl pAtom [Add <$ pSym '+']
  where
    pAtom =  Lit <$> pNatural
         <|> pParens pExp

parse :: String -> Exp
parse = runParser "Failed" pExp

-- | virtual stack machine
type Stack = [Int]
data Op = IAdd
        | IPush Int
        deriving (Show)

-- | stack vm compiler
comp :: Exp -> [Op]
comp (Add x y) = IAdd : comp x ++ comp y
comp (Lit i)   = [IPush i]

-- | the vm implementation
exec :: Op -> [Int] -> [Int]
exec IAdd      (x:y:os) = (x+y) : os
exec (IPush i) os       = i : os

run :: Exp -> [Int]
run = foldr exec [] . comp