add llvm jit to benchmarks

Author: csabahruska

bench.sh

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

grin/app/Main.hs

@@ -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"

grin/grin/sum_opt.grin

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

grin/grin/sum_simple.grin

@@ -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

grin/src/CodeGenLLVM.hs

@@ -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

grin/src/Eval.hs

@@ -6,22 +6,25 @@ 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
 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) =

grin/src/JITLLVM.hs

@@ -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

grin/test/Benchmark.hs

@@ -21,15 +21,15 @@ 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
     | n30 > n31 = n29
     | 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