module LLVM.Util.Optimize(optimizeModule) where

import LLVM.Core.Util (Module, withModule)

import qualified LLVM.FFI.Transforms.PassBuilder as PB
import qualified LLVM.FFI.TargetMachine as TM
import qualified LLVM.FFI.Error as Error
import qualified LLVM.FFI.Core as FFI

import qualified Foreign.Marshal.Alloc as Alloc
import qualified Foreign.C.String as CStr
import Foreign.C.String (withCString)
import Foreign.Storable (peek)
import Foreign.Ptr (Ptr, nullPtr)

import Control.Exception (bracket)
import Control.Monad (when)

import Text.Printf (printf)


failFromError :: Ptr CStr.CString -> IO a
failFromError errorRef =
    bracket (peek errorRef) Alloc.free $ \errorMsg ->
        CStr.peekCString errorMsg >>= fail

getTargetFromTriple :: TM.Triple -> IO TM.TargetRef
getTargetFromTriple triple =
    Alloc.alloca $ \targetRef ->
    Alloc.alloca $ \errorRef -> do
        failure <- TM.getTargetFromTriple triple targetRef errorRef
        if FFI.deconsBool failure
            then failFromError errorRef
            else peek targetRef

{- |
It is very important that you set target triple and target data layout
before optimizing.
Otherwise the optimizer will make wrong assumptions
and e.g. corrupt your record offsets.
See e.g. example/Array for how this can be achieved.

In the future I might enforce via types
that you set target parameters before optimization.
-}
optimizeModule :: Int -> Module -> IO ()
optimizeModule optLevel mdl =
    withModule mdl $ \ modul ->

    (FFI.getTarget modul >>=) $ \triple ->
    (getTargetFromTriple triple >>=) $ \target ->
    (TM.getHostCPUName >>=) $ \cpu ->

    bracket
        (TM.createTargetMachine target triple cpu nullPtr
            TM.codeGenLevelDefault TM.relocDefault TM.codeModelDefault)
        TM.disposeTargetMachine $
            \tm ->

    bracket PB.createPassBuilderOptions PB.disposePassBuilderOptions $
        \pbOpt ->

    withCString (printf "default<O%d>" optLevel) $ \passName -> do
        PB.passBuilderOptionsSetVerifyEach pbOpt FFI.true
        errorRef <- PB.runPasses modul passName tm pbOpt
        when (errorRef /= nullPtr) $
            bracket
                (Error.getErrorMessage errorRef)
                Error.disposeErrorMessage
                    $ \errorMsg ->
                CStr.peekCString errorMsg >>= fail

{-
ToDo:
Function that adds passes according to a list of opt-options.
This would simplify to get consistent behaviour between opt and optimizeModule.

-adce                      addAggressiveDCEPass
-deadargelim               addDeadArgEliminationPass
-deadtypeelim              addDeadTypeEliminationPass
-dse                       addDeadStoreEliminationPass
-functionattrs             addFunctionAttrsPass
-globalopt                 addGlobalOptimizerPass
-indvars                   addIndVarSimplifyPass
-instcombine               addInstructionCombiningPass
-ipsccp                    addIPSCCPPass
-jump-threading            addJumpThreadingPass
-licm                      addLICMPass
-loop-deletion             addLoopDeletionPass
-loop-rotate               addLoopRotatePass
-memcpyopt                 addMemCpyOptPass
-prune-eh                  addPruneEHPass
-reassociate               addReassociatePass
-scalarrepl                addScalarReplAggregatesPass
-sccp                      addSCCPPass
-simplifycfg               addCFGSimplificationPass
-simplify-libcalls         addSimplifyLibCallsPass
-strip-dead-prototypes     addStripDeadPrototypesPass
-tailcallelim              addTailCallEliminationPass
-verify                    addVerifierPass
-}