LLVMTerminator.hs

{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad.Fix
import LLVM
import LLVM.Context
import LLVM.AST hiding (function)
import LLVM.AST.Type as AST
import LLVM.IRBuilder.Constant
import LLVM.IRBuilder.Instruction
import LLVM.IRBuilder.Module
import LLVM.IRBuilder.Monad

data Expr = EBool Bool | EInt Integer

data Stmt = SRet Expr | SIf Expr Stmt

genExpr :: Applicative m => Expr -> m Operand
genExpr (EBool b) = bit (if b then 1 else 0)
genExpr (EInt i) = int64 i

genStmt :: (MonadIRBuilder m, MonadFix m) => Stmt -> Name -> m ()
genStmt (SRet e) _ = ret =<< genExpr e
genStmt (SIf cond body) continue = mdo
  res <- genExpr cond
  condBr res ifTrue continue
  ifTrue <- block `named` "ifTrue"
  genStmt body continue


main :: IO ()
main =
  withContext $ \ctx ->
  withModuleFromAST ctx mod $ \mod' -> BS.putStrLn =<< moduleLLVMAssembly mod'
  where mod = buildModule "main" $
          function "main" [] i64 $ \_ -> mdo
            genStmt stmt exit
            exit <- block `named` "exit"
            ret =<< int64 0
            pure ()
        stmt = SIf (EBool True) (SRet (EInt 1))