X-Git-Url: https://git.lukelau.me/?p=kaleidoscope-hs.git;a=blobdiff_plain;f=Main.hs;h=ee8ee608da79855741c0fab9cc68a63b9b5c88f6;hp=2a5a7e0fbc6c490b0d90af2da2e54a843138341f;hb=e23b23071fc89fc8b73eee61cc06728c93375161;hpb=795fc872e603cc359ec6e307969ac925c3b5dc4d diff --git a/Main.hs b/Main.hs index 2a5a7e0..ee8ee60 100644 --- a/Main.hs +++ b/Main.hs @@ -2,6 +2,7 @@ import AST as K -- K for Kaleidoscope import Utils +import Control.Monad.Trans.Class import Control.Monad.Trans.Reader import Control.Monad.IO.Class import Data.String @@ -13,16 +14,23 @@ 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.Module +import LLVM.PassManager import LLVM.Pretty +import LLVM.Target import System.IO import System.IO.Error import Text.Read (readMaybe) main :: IO () -main = buildModuleT "main" repl >>= Text.hPutStrLn stderr . ("\n" <>) . ppll +main = do + withContext $ \ctx -> withHostTargetMachine $ \tm -> do + ast <- runReaderT (buildModuleT "main" repl) ctx + return () -repl :: ModuleBuilderT IO () +repl :: ModuleBuilderT (ReaderT Context IO) () repl = do liftIO $ hPutStr stderr "ready> " mline <- liftIO $ catchIOError (Just <$> getLine) eofHandler @@ -34,6 +42,14 @@ repl = do Just ast -> do hoist $ buildAST ast mostRecentDef >>= liftIO . Text.hPutStrLn stderr . ppll + + ast <- moduleSoFar "main" + ctx <- lift ask + liftIO $ withModuleFromAST ctx ast $ \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 where eofHandler e