Code.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Code where

import Control.Monad
import Control.Monad.State
import Control.Monad.Reader
import Control.Applicative

import qualified Data.Map as M
import qualified Data.Set as S

import Syntax
import PISA

-- | A concatMap for monads
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM f = liftM concat . mapM f


-- | The RegAllocEnv type keeps track of register allocation
data RegAllocEnv = RegAllocEnv { regAllocStack :: [Reg]
                               , regAllocNext  :: Reg 
                               }
                 deriving (Show, Eq)

-- | The VarRegs type keeps track of variable->register binding
type VarRegs = M.Map String Reg


-- | The CodeGen monad
newtype CodeGen a =
  CodeGen { runCodeGen :: StateT RegAllocEnv (Reader VarRegs) a }
  deriving (MonadState RegAllocEnv, MonadReader VarRegs,
            Applicative, Functor, Monad)


-- | Allocate register
allocReg :: CodeGen Reg
allocReg = do
  env <- get
  case regAllocStack env of
    [] -> do
      put $ env { regAllocNext = regAllocNext env + 1 }
      return $ regAllocNext env
    reg:stack -> do
      put $ env { regAllocStack = stack }
      return reg


-- | Return register to allocation
freeReg :: Reg -> CodeGen ()
freeReg reg = modify $ \env -> env { regAllocStack = reg:regAllocStack env }


-- | Translate a given program, remove monad after use
translate :: Prog -> [PISA]
translate prog =
  runReader (evalStateT (translateProg prog) regAlloc) varRegs
  where
    varRegs  = M.empty
    regAlloc = RegAllocEnv [] regAllocStart

-- | Translate a given program within a CodeGen monad
translateProg :: Prog -> CodeGen [PISA]
translateProg = concatMapM translateDefn . progDefns

translateDefn :: Defn -> CodeGen [PISA]
translateDefn defn =
  case defnTerms defn of
    [] -> do reg <- allocReg
             translateExp (defnBody defn) reg
    ts -> return []

translateExp = undefined

[4 of 4] Compiling Code             ( Code.hs, Code.o )

Code.hs:59:26:
    Couldn't match expected type `StateT
                                    RegAllocEnv
                                    (ReaderT (M.Map k0 a0) Data.Functor.Identity.Identity)
                                    [PISA]'
                with actual type `CodeGen [PISA]'
    In the return type of a call of `translateProg'
    In the first argument of `evalStateT', namely
      `(translateProg prog)'
    In the first argument of `runReader', namely
      `(evalStateT (translateProg prog) regAlloc)'