forked from llvm-hs/llvm-hs-examples
/
Main.hs
84 lines (68 loc) · 2.15 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
import LLVM.AST
import LLVM.Module
import LLVM.Target
import LLVM.Context
import LLVM.AST.Global
import LLVM.AST.Constant
import qualified LLVM.AST as AST
import LLVM.OrcJIT
import Control.Monad.Except
import qualified Data.ByteString.Char8 as BS
import Data.Int
import Data.Word
import Foreign.Ptr
foreign import ccall "dynamic"
mkMain :: FunPtr (IO Int32) -> IO Int32
int :: Type
int = IntegerType 32
defAdd :: Definition
defAdd = GlobalDefinition functionDefaults
{ name = Name "add"
, parameters = ( [] , False )
, returnType = int
, basicBlocks = [body]
}
where
body = BasicBlock
(Name "entry")
[]
(Do $ Ret (Just (ConstantOperand (Int 32 42))) [])
module_ :: AST.Module
module_ = defaultModule
{ moduleName = "basic"
, moduleDefinitions = [defAdd]
}
withTestModule :: AST.Module -> (LLVM.Module.Module -> IO a) -> IO a
withTestModule mod f = withContext $ \context -> withModuleFromAST context mod f
resolver :: IRCompileLayer l -> MangledSymbol -> IO JITSymbol
resolver compileLayer symbol
= findSymbol compileLayer symbol True
nullResolver :: MangledSymbol -> IO JITSymbol
nullResolver s = return (JITSymbol 0 (JITSymbolFlags False False))
failInIO :: ExceptT String IO a -> IO a
failInIO = either fail return <=< runExceptT
eagerJit :: AST.Module -> IO Int32
eagerJit amod =
withTestModule amod $ \mod ->
withHostTargetMachine $ \tm ->
withObjectLinkingLayer $ \objectLayer ->
withIRCompileLayer objectLayer tm $ \compileLayer -> do
asm <- moduleLLVMAssembly mod
BS.putStrLn asm
withModule
compileLayer
mod
(SymbolResolver (resolver compileLayer) nullResolver) $
\moduleSet -> do
mainSymbol <- mangleSymbol compileLayer "add"
JITSymbol mainFn _ <- findSymbol compileLayer mainSymbol True
result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn))
return result
main :: IO ()
main = do
res <- eagerJit module_
putStrLn "Eager JIT Result:"
print res