File.hs

module LLVM.Util.File (writeCodeGenModule, optimizeFunction, optimizeFunctionCG) where

import qualified LLVM.ExecutionEngine as EE
import LLVM.ExecutionEngine (Translatable)
import LLVM.Core
          (CodeGenModule, IsFunction, Module, Function,
           newModule, defineModule,
           getValueName, getModuleValues, castModuleValue,
           writeBitcodeToFile, readBitcodeFromFile)

import System.Process (system)



writeCodeGenModule :: FilePath -> CodeGenModule a -> IO ()
writeCodeGenModule name f = do
    m <- newModule
    _ <- defineModule m f
    writeBitcodeToFile name m

optimize :: FilePath -> IO ()
optimize name = do
    _rc <- system $ "opt -std-compile-opts " ++ name ++ " -f -o " ++ name
    return ()

optimizeFunction ::
    (IsFunction t, Translatable t) =>
    CodeGenModule (Function t) -> IO (Function t)
optimizeFunction = fmap snd . optimizeFunction'

optimizeFunction' ::
    (IsFunction t, Translatable t) =>
    CodeGenModule (Function t) -> IO (Module, Function t)
optimizeFunction' mdl = do
    m <- newModule
    mf <- defineModule m mdl
    fName <- getValueName mf

    let name = "__tmp__" ++ fName ++ ".bc"
    writeBitcodeToFile name m

    optimize name

    m' <- readBitcodeFromFile name
    funcs <- getModuleValues m'

--    removeFile name

    let Just mf' = castModuleValue =<< lookup fName funcs

    return (m', mf')

optimizeFunctionCG ::
    (IsFunction t, Translatable t) =>
    CodeGenModule (Function t) -> IO t
optimizeFunctionCG mdl = do
    (m', mf') <- optimizeFunction' mdl
    EE.runEngineAccess $ do
        EE.addModule m'
        EE.generateFunction mf'