add llvm jit to benchmarks

This commit is contained in:
Csaba Hruska 2017-09-18 18:31:16 +01:00
parent f453fd6144
commit dfd3e199f2
8 changed files with 32 additions and 29 deletions

View File

@ -1 +1 @@
stack bench --benchmark-arguments '--output=$benchmark.html'
stack bench grin --benchmark-arguments '--output=$benchmark.html'

View File

@ -68,10 +68,10 @@ main = do
putStrLn "* HPT *"
print . pretty $ computer
putStrLn "* x86 64bit codegen *"
print . CGX64.codeGen $ Program grin
--putStrLn "* x86 64bit codegen *"
--print . CGX64.codeGen $ Program grin
putStrLn "* LLVM codegen *"
--putStrLn "* LLVM codegen *"
let mod = CGLLVM.codeGen $ Program grin
llName = printf "%s.ll" fname
sName = printf "%s.s" fname
@ -82,4 +82,4 @@ main = do
readFile sName >>= putStrLn
putStrLn "* LLVM JIT run *"
JITLLVM.eagerJit mod
JITLLVM.eagerJit mod "grinMain"

View File

@ -1,5 +1,5 @@
grinMain =
n13 <- sum 0 1 10000
n13 <- sum 0 1 100000
intPrint n13
sum n29 n30 n31 =

View File

@ -1,9 +1,9 @@
grinMain = t1 <- store (CInt 1)
t2 <- store (CInt 10000)
t3 <- store (Fupto t1 t2)
t4 <- store (Fsum t3)
(CInt r') <- eval t4
intPrint r'
t2 <- store (CInt 10000)
t3 <- store (Fupto t1 t2)
t4 <- store (Fsum t3)
(CInt r') <- eval t4
intPrint r'
upto m n = (CInt m') <- eval m
(CInt n') <- eval n

View File

@ -28,17 +28,11 @@ import LLVM.Module
import Control.Monad.Except
import qualified Data.ByteString.Char8 as BS
toLLVM :: String -> AST.Module -> IO ()
toLLVM :: String -> AST.Module -> IO BS.ByteString
toLLVM fname mod = withContext $ \ctx -> do
llvm <- withModuleFromAST ctx mod moduleLLVMAssembly
BS.putStrLn llvm
BS.writeFile fname llvm
printLLVM :: String -> Exp -> IO ()
printLLVM fname exp = do
let mod = codeGen exp
--pPrint mod
toLLVM fname mod
pure llvm
tagMap :: Map Tag (Type, Constant)
tagMap = Map.fromList

View File

@ -6,11 +6,13 @@ import Grin
import ParseGrin
import qualified STReduceGrin
import qualified ReduceGrin
import qualified JITLLVM
import qualified CodeGenLLVM
data Reducer
= PureReducer
| STReducer
| LLVMReducer
deriving (Eq, Show)
eval' :: Reducer -> String -> IO Val
@ -18,10 +20,11 @@ eval' reducer fname = do
result <- parseGrin fname
case result of
Left err -> error $ show err
Right e -> return $
Right e ->
case reducer of
PureReducer -> ReduceGrin.reduceFun e "grinMain"
STReducer -> STReduceGrin.reduceFun e "grinMain"
PureReducer -> pure $ ReduceGrin.reduceFun e "grinMain"
STReducer -> pure $ STReduceGrin.reduceFun e "grinMain"
LLVMReducer -> JITLLVM.eagerJit (CodeGenLLVM.codeGen (Program e)) "grinMain"
evalProgram :: Reducer -> Program -> Val
evalProgram reducer (Program defs) =

View File

@ -3,6 +3,9 @@
module JITLLVM where
import Grin
import Data.String
import LLVM.Target
import LLVM.Context
import LLVM.Module
@ -42,8 +45,8 @@ nullResolver s = return (JITSymbol 0 (JITSymbolFlags False False))
failInIO :: ExceptT String IO a -> IO a
failInIO = either fail return <=< runExceptT
eagerJit :: AST.Module -> IO Int64
eagerJit amod =
eagerJit :: AST.Module -> String -> IO Grin.Val
eagerJit amod mainName =
withTestModule amod $ \mod ->
withHostTargetMachine $ \tm ->
withObjectLinkingLayer $ \objectLayer ->
@ -54,7 +57,7 @@ eagerJit amod =
mod
(SymbolResolver (resolver intPrint compileLayer) nullResolver) $
\moduleSet -> do
mainSymbol <- mangleSymbol compileLayer "grinMain"
mainSymbol <- mangleSymbol compileLayer (fromString mainName)
JITSymbol mainFn _ <- findSymbol compileLayer mainSymbol True
result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn))
return result
return $ Unit

View File

@ -21,7 +21,7 @@ hs_sum_opt = do
sum n28 n18 n31
hs_sum_pure :: IO Float
hs_sum_pure = pure $ sum 0 1 10000
hs_sum_pure = pure $ sum 0 1 100000
where
sum :: Float -> Float -> Float -> Float
sum n29 n30 n31
@ -29,7 +29,7 @@ hs_sum_pure = pure $ sum 0 1 10000
| otherwise = sum (n29 + n30) (n30 + 1) n31
hs_sum_naive :: IO Float
hs_sum_naive = pure $ sum [1..10000]
hs_sum_naive = pure $ sum [1..100000]
main :: IO ()
main = do
@ -43,6 +43,9 @@ main = do
[ bench "sum_simple" $ nfIO $ eval' STReducer "grin/sum_simple.grin"
, bench "sum_opt" $ nfIO $ eval' STReducer "grin/sum_opt.grin"
]
, bgroup "LLVM"
[ bench "sum_opt" $ nfIO $ eval' LLVMReducer "grin/sum_opt.grin"
]
, bgroup "GHC"
[ bench "hs_sum_opt" $ nfIO $ hs_sum_opt
, bench "hs_sum_pure" $ nfIO $ hs_sum_pure