Set up the LLVM context and optimise the module
[kaleidoscope-hs.git] / Main.hs
diff --git a/Main.hs b/Main.hs
index f32003bdd2dbb48eba325526bf1849444fd1d09d..bff1c08c965c037080cc6aba052a60c40f1dc999 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -7,19 +7,31 @@ import Control.Monad.IO.Class
 import Data.String
 import qualified Data.Map as Map
 import qualified Data.Text.Lazy.IO as Text
 import Data.String
 import qualified Data.Map as Map
 import qualified Data.Text.Lazy.IO as Text
+import LLVM.AST.AddrSpace
 import LLVM.AST.Constant
 import LLVM.AST.Float
 import LLVM.AST.FloatingPointPredicate hiding (False, True)
 import LLVM.AST.Operand
 import LLVM.AST.Type as Type
 import LLVM.AST.Constant
 import LLVM.AST.Float
 import LLVM.AST.FloatingPointPredicate hiding (False, True)
 import LLVM.AST.Operand
 import LLVM.AST.Type as Type
+import LLVM.Context
 import LLVM.IRBuilder
 import LLVM.IRBuilder
+import LLVM.Module
+import LLVM.PassManager
 import LLVM.Pretty
 import LLVM.Pretty
+import LLVM.Target
 import System.IO
 import System.IO.Error
 import Text.Read (readMaybe)
 
 main :: IO ()
 import System.IO
 import System.IO.Error
 import Text.Read (readMaybe)
 
 main :: IO ()
-main = buildModuleT "main" repl >>= Text.hPutStrLn stderr . ("\n" <>) . ppll
+main = do
+  mdl' <- buildModuleT "main" repl
+  withContext $ \ctx -> withHostTargetMachine $ \tm ->
+    withModuleFromAST ctx mdl' $ \mdl -> do
+      let spec = defaultCuratedPassSetSpec { optLevel = Just 3 }
+      -- this returns true if the module was modified
+      withPassManager spec $ flip runPassManager mdl
+      Text.hPutStrLn stderr . ("\n" <>) . ppllvm =<< moduleAST mdl
 
 repl :: ModuleBuilderT IO ()
 repl = do
 
 repl :: ModuleBuilderT IO ()
 repl = do
@@ -80,3 +92,12 @@ buildExpr (BinOp op a b) = do
                   K.Cmp LT -> fcmp OLT
                   K.Cmp GT -> fcmp OGT
                   K.Cmp EQ -> fcmp OEQ
                   K.Cmp LT -> fcmp OLT
                   K.Cmp GT -> fcmp OGT
                   K.Cmp EQ -> fcmp OEQ
+
+buildExpr (Call callee params) = do
+  paramOps <- mapM buildExpr params
+  let nam = fromString callee
+      -- get a pointer to the function
+      typ = FunctionType Type.double (replicate (length params) Type.double) False
+      ptrTyp = Type.PointerType typ (AddrSpace 0)
+      ref = GlobalReference ptrTyp nam
+  call (ConstantOperand ref) (zip paramOps (repeat []))