llvm-hs printf example

module Main where

import           LLVM.AST
import qualified LLVM.AST as AST
import           LLVM.AST.AddrSpace
import qualified LLVM.AST.CallingConvention as CC
import qualified LLVM.AST.Constant as C
import           LLVM.AST.Global
import           LLVM.AST.Linkage
import           LLVM.Context
import           LLVM.Module

import           Control.Monad.Except

module_ :: AST.Module
module_ =
  defaultModule
  { moduleName = "<string>"
  , moduleSourceFileName = "foo.c"
  , moduleDefinitions =
      [ GlobalDefinition
          (globalVariableDefaults
           { name = Name ".str"
           , linkage = Private
           , unnamedAddr = Just GlobalAddr
           , isConstant = True
           , LLVM.AST.Global.type' =
               ArrayType
               {nArrayElements = 4, elementType = IntegerType {typeBits = 8}}
           , initializer =
               Just
                 (C.Array
                  { C.memberType = IntegerType {typeBits = 8}
                  , C.memberValues =
                      [ C.Int {C.integerBits = 8, C.integerValue = 37}
                      , C.Int {C.integerBits = 8, C.integerValue = 100}
                      , C.Int {C.integerBits = 8, C.integerValue = 10}
                      , C.Int {C.integerBits = 8, C.integerValue = 0}
                      ]
                  })
           , LLVM.AST.Global.alignment = 1
           })
      , GlobalDefinition
          (functionDefaults
           { returnType = VoidType
           , name = Name "f"
           , parameters = ([], False)
           , basicBlocks =
               [ BasicBlock
                   (UnName 0)
                   [ UnName 1 :=
                     Call
                     { tailCallKind = Nothing
                     , AST.callingConvention = CC.C
                     , AST.returnAttributes = []
                     , function =
                         Right
                           (ConstantOperand
                              (C.GlobalReference
                                 (PointerType
                                  { pointerReferent =
                                      FunctionType
                                      { resultType = IntegerType {typeBits = 32}
                                      , argumentTypes =
                                          [ PointerType
                                            { pointerReferent =
                                                IntegerType {typeBits = 8}
                                            , pointerAddrSpace = AddrSpace 0
                                            }
                                          ]
                                      , isVarArg = True
                                      }
                                  , pointerAddrSpace = AddrSpace 0
                                  })
                                 (Name "printf")))
                     , arguments =
                         [ ( ConstantOperand
                               (C.GetElementPtr
                                { C.inBounds = True
                                , C.address =
                                    C.GlobalReference
                                      (PointerType
                                       { pointerReferent =
                                           ArrayType
                                           { nArrayElements = 4
                                           , elementType =
                                               IntegerType {typeBits = 8}
                                           }
                                       , pointerAddrSpace = AddrSpace 0
                                       })
                                      (Name ".str")
                                , C.indices =
                                    [ C.Int
                                      {C.integerBits = 32, C.integerValue = 0}
                                    , C.Int
                                      {C.integerBits = 32, C.integerValue = 0}
                                    ]
                                })
                           , [])
                         , ( ConstantOperand
                               (C.Int {C.integerBits = 32, C.integerValue = 42})
                           , [])
                         ]
                     , AST.functionAttributes = []
                     , metadata = []
                     }
                   ]
                   (Do (Ret {returnOperand = Nothing, metadata' = []}))
               ]
           })
      , GlobalDefinition
          (functionDefaults
           { returnType = IntegerType {typeBits = 32}
           , name = Name "printf"
           , parameters =
               ( [ Parameter
                     (PointerType
                      { pointerReferent = IntegerType {typeBits = 8}
                      , pointerAddrSpace = AddrSpace 0
                      })
                     (UnName 0)
                     []
                 ]
               , True)
           })
      ]
  }


toLLVM :: AST.Module -> IO ()
toLLVM mod = withContext $ \ctx -> do
    errOrLLVM <- runExceptT $ withModuleFromAST ctx mod moduleLLVMAssembly
    case errOrLLVM of
      Left err -> putStrLn $ "error: " ++ err
      Right llvm -> putStrLn llvm


main :: IO ()
main = toLLVM module_