Now that we have some LLVM IR generated, we can run PassManager on our
module to get a bunch of neat optimisations on it. Try it out with 3 + 2
to see some constant folding.
Note that the original tutorial uses FunctionPassManager which optimises
on a function per function basis: llvm-hs doesn't expose this yet (and
this is all using the legacy pass manager anyway), so for now we just
optimise the entire module at the end.
import AST as K -- K for Kaleidoscope
import Utils
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
import Control.Monad.Trans.Reader
import Control.Monad.IO.Class
import Data.String
import LLVM.AST.FloatingPointPredicate hiding (False, True)
import LLVM.AST.Operand
import LLVM.AST.Type as Type
import LLVM.AST.FloatingPointPredicate hiding (False, True)
import LLVM.AST.Operand
import LLVM.AST.Type as Type
+import LLVM.Module
+import LLVM.PassManager
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
+ withContext $ \ctx -> withHostTargetMachineDefault $ \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
repl = do
liftIO $ hPutStr stderr "ready> "
mline <- liftIO $ catchIOError (Just <$> getLine) eofHandler
Just ast -> do
hoist $ buildAST ast
mostRecentDef >>= liftIO . Text.hPutStrLn stderr . ppll
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
module Utils where
import Control.Monad.Trans.State
module Utils where
import Control.Monad.Trans.State
+import Data.ByteString.Short (ShortByteString)
import Data.Functor.Identity
import LLVM.AST
import LLVM.IRBuilder.Module
import LLVM.IRBuilder.Internal.SnocList
import Data.Functor.Identity
import LLVM.AST
import LLVM.IRBuilder.Module
import LLVM.IRBuilder.Internal.SnocList
+moduleSoFar :: MonadModuleBuilder m => ShortByteString -> m Module
+moduleSoFar nm = do
+ s <- liftModuleState get
+ let ds = getSnocList (builderDefs s)
+ return $ defaultModule { moduleName = nm, moduleDefinitions = ds }
+
mostRecentDef :: Monad m => ModuleBuilderT m Definition
mostRecentDef = last . getSnocList . builderDefs <$> liftModuleState get
mostRecentDef :: Monad m => ModuleBuilderT m Definition
mostRecentDef = last . getSnocList . builderDefs <$> liftModuleState get