X-Git-Url: https://git.lukelau.me/?p=kaleidoscope-hs.git;a=blobdiff_plain;f=Main.hs;h=4dafa02b5f1acc3e2828c35a570993fba1abcfd0;hp=2a5a7e0fbc6c490b0d90af2da2e54a843138341f;hb=431c4b6e37e414b6959cdf14a50622c514ea0a85;hpb=795fc872e603cc359ec6e307969ac925c3b5dc4d diff --git a/Main.hs b/Main.hs index 2a5a7e0..4dafa02 100644 --- a/Main.hs +++ b/Main.hs @@ -2,6 +2,8 @@ import AST as K -- K for Kaleidoscope import Utils +import Control.Monad +import Control.Monad.Trans.Class import Control.Monad.Trans.Reader import Control.Monad.IO.Class import Data.String @@ -13,16 +15,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 @@ -32,13 +41,30 @@ repl = do case readMaybe l of Nothing -> liftIO $ hPutStrLn stderr "Couldn't parse" Just ast -> do - hoist $ buildAST ast - mostRecentDef >>= liftIO . Text.hPutStrLn stderr . ppll + anon <- isAnonExpr <$> hoist (buildAST ast) + def <- mostRecentDef + + ast <- moduleSoFar "main" + ctx <- lift ask + liftIO $ withModuleFromAST ctx ast $ \mdl -> do + Text.hPutStrLn stderr $ ppll def + 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 + when anon (jit mdl >>= hPrint stderr) + + when anon (removeDef def) repl where eofHandler e | isEOFError e = return Nothing | otherwise = ioError e + isAnonExpr (ConstantOperand (GlobalReference _ "__anon_expr")) = True + isAnonExpr _ = False + +jit :: Module -> IO Double +jit _mdl = putStrLn "Working on it!" >> return 0 type Binds = Map.Map String Operand