Optimize.hs

module LLVM.Util.Optimize(optimizeModule) where
import Control.Monad
import Foreign.Ptr(nullPtr)

import LLVM.Core.Util(Module, withModule)
import qualified LLVM.FFI.Core as FFI
import LLVM.FFI.Target(addTargetData, createTargetData)
import LLVM.FFI.Transforms.IPO
import LLVM.FFI.Transforms.Scalar

optimizeModule :: Int -> Module -> IO Int
optimizeModule optLevel mdl = withModule mdl $ \ m -> do
    passes <- FFI.createPassManager

    -- Pass the module target data to the pass manager.
    target <- FFI.getDataLayout m >>= createTargetData
    addTargetData target passes

--FCN    fPasses <- FFI.createFunctionPassManager mp
    let fPasses = nullPtr
    -- XXX add module target data

--    addVerifierPass passes -- XXX does not exist
    addLowerSetJmpPass passes
    addOptimizationPasses passes fPasses optLevel

    --FCN XXX loop through all functions and optimize them.
--    initializeFunctionPassManager fPasses
--    runFunctionPassManager fPasses fcn

--    addVerifierPass passes -- XXX does not exist

    rc <- FFI.runPassManager passes m
    FFI.disposePassManager passes
    -- XXX discard pass manager?

    return (fromIntegral rc)

addOptimizationPasses :: FFI.PassManagerRef -> FFI.PassManagerRef -> Int -> IO ()
addOptimizationPasses passes fPasses optLevel = do
    createStandardFunctionPasses fPasses optLevel

    let inline = addFunctionInliningPass --  if optLevel > 1 then addFunctionInliningPass else const (return ())
    createStandardModulePasses passes optLevel True (optLevel > 1) True True inline

createStandardFunctionPasses :: FFI.PassManagerRef -> Int -> IO ()
createStandardFunctionPasses fPasses optLevel = do
  when False $ do -- FCN
    addCFGSimplificationPass fPasses
    if optLevel == 1 then
        addPromoteMemoryToRegisterPass fPasses
     else
        addScalarReplAggregatesPass fPasses
    addInstructionCombiningPass fPasses

createStandardModulePasses :: FFI.PassManagerRef -> Int -> Bool -> Bool -> Bool -> Bool -> (FFI.PassManagerRef -> IO()) -> IO ()
createStandardModulePasses passes optLevel unitAtATime unrollLoops simplifyLibCalls haveExceptions inliningPass = do
    when unitAtATime $ do
        addRaiseAllocationsPass passes
    addCFGSimplificationPass passes
    addPromoteMemoryToRegisterPass passes
    when unitAtATime $ do
        addGlobalOptimizerPass passes
        addGlobalDCEPass passes
        addIPConstantPropagationPass passes
        addDeadArgEliminationPass passes
    addInstructionCombiningPass passes
    addCFGSimplificationPass passes
    when unitAtATime $ do
        when haveExceptions $ addPruneEHPass passes
        addFunctionAttrsPass passes
    inliningPass passes
    when (optLevel > 2) $ do
        addArgumentPromotionPass passes
    when simplifyLibCalls $ do
        addSimplifyLibCallsPass passes
    addInstructionCombiningPass passes
    addJumpThreadingPass passes
    addCFGSimplificationPass passes
    addScalarReplAggregatesPass passes
    addInstructionCombiningPass passes
    addCondPropagationPass passes
    addTailCallEliminationPass passes
    addCFGSimplificationPass passes
    addReassociatePass passes
    addLoopRotatePass passes
    addLICMPass passes
    addLoopUnswitchPass passes
    addInstructionCombiningPass passes
    addIndVarSimplifyPass passes
    addLoopDeletionPass passes
    when unrollLoops $
      addLoopUnrollPass passes
    addInstructionCombiningPass passes
    addGVNPass passes
    addMemCpyOptPass passes
    addSCCPPass passes

    addInstructionCombiningPass passes
    addCondPropagationPass passes
    addDeadStoreEliminationPass passes
    addAggressiveDCEPass passes
    addCFGSimplificationPass passes

    when unitAtATime $ do
      addStripDeadPrototypesPass passes
      addDeadTypeEliminationPass passes

    when (optLevel > 1 && unitAtATime) $
      addConstantMergePass passes