{-# LANGUAGE
  TemplateHaskell,
  ForeignFunctionInterface,
  CPP
  #-}

module LLVM.Internal.FFI.PassManager where

import LLVM.Prelude

import qualified Language.Haskell.TH as TH

import Foreign.Ptr
import Foreign.C

import LLVM.Internal.FFI.LLVMCTypes
import LLVM.Internal.FFI.PtrHierarchy
import LLVM.Internal.FFI.Cleanup
import LLVM.Internal.FFI.Module
import LLVM.Internal.FFI.Target
import LLVM.Internal.FFI.Transforms

import qualified LLVM.Transforms as G

data PassManager

foreign import ccall unsafe "LLVMCreatePassManager" createPassManager ::
  IO (Ptr PassManager)

foreign import ccall unsafe "LLVMDisposePassManager" disposePassManager ::
  Ptr PassManager -> IO ()

foreign import ccall unsafe "LLVMRunPassManager" runPassManager ::
  Ptr PassManager -> Ptr Module -> IO CUInt

foreign import ccall unsafe "LLVMCreateFunctionPassManagerForModule" createFunctionPassManagerForModule ::
  Ptr Module -> IO (Ptr PassManager)

foreign import ccall unsafe "LLVMInitializeFunctionPassManager" initializeFunctionPassManager ::
  Ptr PassManager -> IO CUInt

foreign import ccall unsafe "LLVMRunFunctionPassManager" runFunctionPassManager ::
  Ptr PassManager -> Ptr Value -> IO CUInt

foreign import ccall unsafe "LLVMFinalizeFunctionPassManager" finalizeFunctionPassManager ::
  Ptr PassManager -> IO CUInt

foreign import ccall unsafe "LLVMAddAnalysisPasses" addAnalysisPasses ::
  Ptr TargetMachine -> Ptr PassManager -> IO ()

foreign import ccall unsafe "LLVMAddTargetLibraryInfo" addTargetLibraryInfoPass' ::
  Ptr TargetLibraryInfo -> Ptr PassManager -> IO ()

addTargetLibraryInfoPass :: Ptr PassManager -> Ptr TargetLibraryInfo -> IO ()
addTargetLibraryInfoPass = flip addTargetLibraryInfoPass'

$(do
  let declareForeign :: TH.Name -> [TH.Type] -> TH.DecsQ
      declareForeign hName extraParams = do
        let n = TH.nameBase hName
            passTypeMapping :: TH.Type -> TH.TypeQ
            passTypeMapping t = case t of
              TH.ConT h | h == ''Word -> [t| CUInt |]
                        | h == ''G.GCOVVersion -> [t| CString |]
              -- some of the LLVM methods for making passes use "-1" as a special value
              -- handle those here
              TH.AppT (TH.ConT mby) t' | mby == ''Maybe ->
                case t' of
                  TH.ConT h | h == ''Bool -> [t| NothingAsMinusOne Bool |]
                            | h == ''Word -> [t| NothingAsMinusOne Word |]
                            | h == ''FilePath -> [t| NothingAsEmptyString CString |]
                  _ -> typeMapping t
              _ -> typeMapping t
        foreignDecl
          (cName n)
          ("add" ++ n ++ "Pass")
          ([[t| Ptr PassManager |]]
           ++ [[t| Ptr TargetMachine |] | needsTargetMachine n]
           ++ map passTypeMapping extraParams)
          (TH.tupleT 0)
#if __GLASGOW_HASKELL__ < 800
  TH.TyConI (TH.DataD _ _ _ cons _) <- TH.reify ''G.Pass
#else
  TH.TyConI (TH.DataD _ _ _ _ cons _) <- TH.reify ''G.Pass
#endif
  liftM concat $ forM cons $ \con -> case con of
    TH.RecC n l -> declareForeign n [ t | (_,_,t) <- l ]
    TH.NormalC n [] -> declareForeign n []
    _ -> error "pass descriptor constructors with fields need to be records"
 )

data PassManagerBuilder

foreign import ccall unsafe "LLVMPassManagerBuilderCreate" passManagerBuilderCreate ::
    IO (Ptr PassManagerBuilder)

foreign import ccall unsafe "LLVMPassManagerBuilderDispose" passManagerBuilderDispose ::
    Ptr PassManagerBuilder -> IO ()

foreign import ccall unsafe "LLVMPassManagerBuilderSetOptLevel" passManagerBuilderSetOptLevel ::
    Ptr PassManagerBuilder -> CUInt -> IO ()

foreign import ccall unsafe "LLVMPassManagerBuilderSetSizeLevel" passManagerBuilderSetSizeLevel ::
    Ptr PassManagerBuilder -> CUInt -> IO ()

foreign import ccall unsafe "LLVMPassManagerBuilderSetDisableUnitAtATime" passManagerBuilderSetDisableUnitAtATime ::
    Ptr PassManagerBuilder -> LLVMBool -> IO ()

foreign import ccall unsafe "LLVMPassManagerBuilderSetDisableUnrollLoops" passManagerBuilderSetDisableUnrollLoops ::
    Ptr PassManagerBuilder -> CUInt -> IO ()

foreign import ccall unsafe "LLVMPassManagerBuilderSetDisableSimplifyLibCalls" passManagerBuilderSetDisableSimplifyLibCalls ::
    Ptr PassManagerBuilder -> LLVMBool -> IO ()

foreign import ccall unsafe "LLVMPassManagerBuilderUseInlinerWithThreshold" passManagerBuilderUseInlinerWithThreshold ::
    Ptr PassManagerBuilder -> CUInt -> IO ()

foreign import ccall unsafe "LLVMPassManagerBuilderPopulateFunctionPassManager" passManagerBuilderPopulateFunctionPassManager ::
    Ptr PassManagerBuilder -> Ptr PassManager -> IO ()

foreign import ccall unsafe "LLVMPassManagerBuilderPopulateModulePassManager" passManagerBuilderPopulateModulePassManager ::
    Ptr PassManagerBuilder -> Ptr PassManager -> IO ()

foreign import ccall unsafe "LLVMPassManagerBuilderPopulateLTOPassManager" passManagerBuilderPopulateLTOPassManager ::
    Ptr PassManagerBuilder -> Ptr PassManager -> CUChar -> CUChar -> IO ()

foreign import ccall unsafe "LLVM_Hs_PassManagerBuilderSetLibraryInfo" passManagerBuilderSetLibraryInfo ::
    Ptr PassManagerBuilder -> Ptr TargetLibraryInfo -> IO ()

foreign import ccall unsafe "LLVM_Hs_PassManagerBuilderSetLoopVectorize" passManagerBuilderSetLoopVectorize ::
    Ptr PassManagerBuilder -> LLVMBool -> IO ()

foreign import ccall unsafe "LLVM_Hs_PassManagerBuilderSetSuperwordLevelParallelismVectorize" passManagerBuilderSetSuperwordLevelParallelismVectorize ::
    Ptr PassManagerBuilder -> LLVMBool -> IO ()