{-# LANGUAGE CPP             #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-unused-imports   #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.Native.Plugin
-- Copyright   : [2017..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.LLVM.Native.Plugin (

  plugin,

) where

import Data.Array.Accelerate.Error
import Data.Array.Accelerate.LLVM.Native.Plugin.Annotation
import Data.Array.Accelerate.LLVM.Native.Plugin.BuildInfo

import Control.Monad
import Data.IORef
import Data.List
import qualified Data.Map                                           as Map

import GhcPlugins
import Linker
import SysTools


-- | This GHC plugin is required to support ahead-of-time compilation for the
-- accelerate-llvm-native backend. In particular, it tells GHC about the
-- additional object files generated by
-- 'Data.Array.Accelerate.LLVM.Native.runQ'* which must be linked into the final
-- executable.
--
-- To use it, add the following to the .cabal file of your project:
--
-- > ghc-options: -fplugin=Data.Array.Accelerate.LLVM.Native.Plugin
--
plugin :: Plugin
plugin :: Plugin
plugin = Plugin
defaultPlugin
  { installCoreToDos :: CorePlugin
installCoreToDos = HasCallStack => CorePlugin
CorePlugin
install
#if __GLASGOW_HASKELL__ >= 806
  , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
pluginRecompile  = [CommandLineOption] -> IO PluginRecompile
purePlugin
#endif
  }

install :: HasCallStack => [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install :: CorePlugin
install [CommandLineOption]
_ [CoreToDo]
rest = do
  let this :: CoreToDo -> Bool
this (CoreDoPluginPass CommandLineOption
"accelerate-llvm-native" CorePluginPass
_) = Bool
True
      this CoreToDo
_                                             = Bool
False
  --
  [CoreToDo] -> CoreM [CoreToDo]
forall (m :: * -> *) a. Monad m => a -> m a
return ([CoreToDo] -> CoreM [CoreToDo]) -> [CoreToDo] -> CoreM [CoreToDo]
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> CorePluginPass -> CoreToDo
CoreDoPluginPass CommandLineOption
"accelerate-llvm-native" HasCallStack => CorePluginPass
CorePluginPass
pass CoreToDo -> [CoreToDo] -> [CoreToDo]
forall a. a -> [a] -> [a]
: (CoreToDo -> Bool) -> [CoreToDo] -> [CoreToDo]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (CoreToDo -> Bool) -> CoreToDo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreToDo -> Bool
this) [CoreToDo]
rest

pass :: HasCallStack => ModGuts -> CoreM ModGuts
pass :: CorePluginPass
pass ModGuts
guts = do
  -- Determine the current build environment
  --
  HscEnv
hscEnv   <- CoreM HscEnv
getHscEnv
  DynFlags
dynFlags <- CoreM DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
  Module
this     <- CoreM Module
forall (m :: * -> *). HasModule m => m Module
getModule

  -- Gather annotations for the extra object files which must be supplied to the
  -- linker in order to complete the current module.
  --
  [CommandLineOption]
paths   <- [CommandLineOption] -> [CommandLineOption]
forall a. Eq a => [a] -> [a]
nub ([CommandLineOption] -> [CommandLineOption])
-> ([[CommandLineOption]] -> [CommandLineOption])
-> [[CommandLineOption]]
-> [CommandLineOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[CommandLineOption]] -> [CommandLineOption]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CommandLineOption]] -> [CommandLineOption])
-> CoreM [[CommandLineOption]] -> CoreM [CommandLineOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CoreBind -> CoreM [CommandLineOption])
-> [CoreBind] -> CoreM [[CommandLineOption]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ModGuts -> CoreBind -> CoreM [CommandLineOption]
objectPaths ModGuts
guts) (ModGuts -> [CoreBind]
mg_binds ModGuts
guts)

  Bool -> CoreM () -> CoreM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([CommandLineOption] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CommandLineOption]
paths))
    (CoreM () -> CoreM ()) -> CoreM () -> CoreM ()
forall a b. (a -> b) -> a -> b
$ SDoc -> CoreM ()
debugTraceMsg
    (SDoc -> CoreM ()) -> SDoc -> CoreM ()
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (CommandLineOption -> SDoc
text CommandLineOption
"Data.Array.Accelerate.LLVM.Native.Plugin: linking module" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Module -> SDoc
pprModule Module
this) SDoc -> SDoc -> SDoc
<+> CommandLineOption -> SDoc
text CommandLineOption
"with:") Int
2 ([SDoc] -> SDoc
vcat ((CommandLineOption -> SDoc) -> [CommandLineOption] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CommandLineOption -> SDoc
text [CommandLineOption]
paths))

  -- The linking method depends on the current build target
  --
  case DynFlags -> HscTarget
hscTarget DynFlags
dynFlags of
    HscTarget
HscNothing     -> () -> CoreM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    HscTarget
HscInterpreted ->
      -- We are in interactive mode (ghci)
      --
      Bool -> CoreM () -> CoreM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([CommandLineOption] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CommandLineOption]
paths)) (CoreM () -> CoreM ()) -> (IO () -> CoreM ()) -> IO () -> CoreM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> CoreM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CoreM ()) -> IO () -> CoreM ()
forall a b. (a -> b) -> a -> b
$ do
        let opts :: [Option]
opts  = DynFlags -> [Option]
ldInputs DynFlags
dynFlags
            objs :: [Option]
objs  = (CommandLineOption -> Option) -> [CommandLineOption] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map CommandLineOption -> Option
optionOfPath [CommandLineOption]
paths
        --
        HscEnv -> IO ()
linkCmdLineLibs
               (HscEnv -> IO ()) -> HscEnv -> IO ()
forall a b. (a -> b) -> a -> b
$ HscEnv
hscEnv { hsc_dflags :: DynFlags
hsc_dflags = DynFlags
dynFlags { ldInputs :: [Option]
ldInputs = [Option]
opts [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
objs }}

    -- This case is not necessary for GHC-8.6 and above.
    --
    -- We are building to object code.
    --
    -- Because of separate compilation, we will only encounter the annotation
    -- pragmas on files which have changed between invocations. This applies to
    -- both @ghc --make@ as well as the separate compile/link phases of building
    -- with @cabal@ (and @stack@). Note that whenever _any_ file is updated we
    -- must make sure that the linker options contains the complete list of
    -- objects required to build the entire project.
    --
    HscTarget
_ -> IO () -> CoreM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CoreM ()) -> IO () -> CoreM ()
forall a b. (a -> b) -> a -> b
$ do
#if __GLASGOW_HASKELL__ < 806
      -- Read the object file index and update (we may have added or removed
      -- objects for the given module)
      --
      let buildInfo = mkBuildInfoFileName (objectMapPath dynFlags)
      abi <- readBuildInfo buildInfo
      --
      let abi'      = if null paths
                        then Map.delete this       abi
                        else Map.insert this paths abi
          allPaths  = nub (concat (Map.elems abi'))
          allObjs   = map optionOfPath allPaths
      --
      writeBuildInfo buildInfo abi'

      -- Make sure the linker flags are up-to-date.
      --
      when (not (isNoLink (ghcLink dynFlags))) $ do
        linker_info <- getLinkerInfo dynFlags
        writeIORef (rtldInfo dynFlags)
          $ Just
          $ case linker_info of
              GnuLD     opts -> GnuLD     (nub (opts ++ allObjs))
              GnuGold   opts -> GnuGold   (nub (opts ++ allObjs))
              DarwinLD  opts -> DarwinLD  (nub (opts ++ allObjs))
              SolarisLD opts -> SolarisLD (nub (opts ++ allObjs))
              AixLD     opts -> AixLD     (nub (opts ++ allObjs))
              LlvmLLD   opts -> LlvmLLD   (nub (opts ++ allObjs))
              UnknownLD      -> UnknownLD  -- no linking performed?
#endif
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  CorePluginPass
forall (m :: * -> *) a. Monad m => a -> m a
return ModGuts
guts

objectPaths :: ModGuts -> CoreBind -> CoreM [FilePath]
objectPaths :: ModGuts -> CoreBind -> CoreM [CommandLineOption]
objectPaths ModGuts
guts (NonRec CoreBndr
b Expr CoreBndr
_) = ModGuts -> CoreBndr -> CoreM [CommandLineOption]
objectAnns ModGuts
guts CoreBndr
b
objectPaths ModGuts
guts (Rec [(CoreBndr, Expr CoreBndr)]
bs)     = [[CommandLineOption]] -> [CommandLineOption]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CommandLineOption]] -> [CommandLineOption])
-> CoreM [[CommandLineOption]] -> CoreM [CommandLineOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CoreBndr -> CoreM [CommandLineOption])
-> [CoreBndr] -> CoreM [[CommandLineOption]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ModGuts -> CoreBndr -> CoreM [CommandLineOption]
objectAnns ModGuts
guts) (((CoreBndr, Expr CoreBndr) -> CoreBndr)
-> [(CoreBndr, Expr CoreBndr)] -> [CoreBndr]
forall a b. (a -> b) -> [a] -> [b]
map (CoreBndr, Expr CoreBndr) -> CoreBndr
forall a b. (a, b) -> a
fst [(CoreBndr, Expr CoreBndr)]
bs)

objectAnns :: ModGuts -> CoreBndr -> CoreM [FilePath]
objectAnns :: ModGuts -> CoreBndr -> CoreM [CommandLineOption]
objectAnns ModGuts
guts CoreBndr
bndr = do
  UniqFM [Object]
anns  <- ([Word8] -> Object) -> ModGuts -> CoreM (UniqFM [Object])
forall a.
Typeable a =>
([Word8] -> a) -> ModGuts -> CoreM (UniqFM [a])
getAnnotations [Word8] -> Object
forall a. Data a => [Word8] -> a
deserializeWithData ModGuts
guts
  [CommandLineOption] -> CoreM [CommandLineOption]
forall (m :: * -> *) a. Monad m => a -> m a
return [ CommandLineOption
path | Object CommandLineOption
path <- UniqFM [Object] -> [Object] -> Unique -> [Object]
forall key elt. Uniquable key => UniqFM elt -> elt -> key -> elt
lookupWithDefaultUFM UniqFM [Object]
anns [] (CoreBndr -> Unique
varUnique CoreBndr
bndr) ]

objectMapPath :: DynFlags -> FilePath
objectMapPath :: DynFlags -> CommandLineOption
objectMapPath DynFlags{Bool
Float
Int
CommandLineOption
[Int]
[CommandLineOption]
[(CommandLineOption, CommandLineOption)]
[(ModuleName, CommandLineOption)]
[IgnorePackageFlag]
[TrustFlag]
[PackageFlag]
[PackageDBFlag]
[Way]
[ModuleName]
[LoadedPlugin]
[StaticPlugin]
[Option]
[OnOff Extension]
Maybe Int
Maybe CommandLineOption
Maybe [(CommandLineOption, [PackageConfig])]
Maybe [(ModuleName, Module)]
Maybe (CommandLineOption, Int)
Maybe Language
Maybe ComponentId
Maybe BmiVersion
Maybe SseVersion
Word
IORef Bool
IORef Int
IORef (Maybe LinkerInfo)
IORef (Maybe CompilerInfo)
IORef (Map CommandLineOption CommandLineOption)
IORef (Set CommandLineOption)
IORef FilesToClean
IORef (ModuleEnv Int)
IncludeSpecs
SafeHaskellMode
CfgWeights
ProfAuto
LlvmConfig
HscTarget
GhcMode
GhcLink
DynLibLoader
RtsOptsEnabled
FlushOut
FlushErr
IntWithInf
SrcSpan
PackageState
Module
InstalledUnitId
Scheme
OverridingBool
ToolSettings
PlatformConstants
Hooks
EnumSet Extension
EnumSet WarningFlag
EnumSet DumpFlag
EnumSet GeneralFlag
FileSettings
GhcNameVersion
IntegerLibrary
PlatformMisc
Platform
LogAction
useUnicode :: DynFlags -> Bool
pprCols :: DynFlags -> Int
pprUserLength :: DynFlags -> Int
targetPlatform :: DynFlags -> Platform
ghcMode :: DynFlags -> GhcMode
ghcLink :: DynFlags -> GhcLink
ghcNameVersion :: DynFlags -> GhcNameVersion
fileSettings :: DynFlags -> FileSettings
toolSettings :: DynFlags -> ToolSettings
platformMisc :: DynFlags -> PlatformMisc
platformConstants :: DynFlags -> PlatformConstants
rawSettings :: DynFlags -> [(CommandLineOption, CommandLineOption)]
integerLibrary :: DynFlags -> IntegerLibrary
llvmConfig :: DynFlags -> LlvmConfig
verbosity :: DynFlags -> Int
optLevel :: DynFlags -> Int
debugLevel :: DynFlags -> Int
simplPhases :: DynFlags -> Int
maxSimplIterations :: DynFlags -> Int
ruleCheck :: DynFlags -> Maybe CommandLineOption
inlineCheck :: DynFlags -> Maybe CommandLineOption
strictnessBefore :: DynFlags -> [Int]
parMakeCount :: DynFlags -> Maybe Int
enableTimeStats :: DynFlags -> Bool
ghcHeapSize :: DynFlags -> Maybe Int
maxRelevantBinds :: DynFlags -> Maybe Int
maxValidHoleFits :: DynFlags -> Maybe Int
maxRefHoleFits :: DynFlags -> Maybe Int
refLevelHoleFits :: DynFlags -> Maybe Int
maxUncoveredPatterns :: DynFlags -> Int
maxPmCheckModels :: DynFlags -> Int
simplTickFactor :: DynFlags -> Int
specConstrThreshold :: DynFlags -> Maybe Int
specConstrCount :: DynFlags -> Maybe Int
specConstrRecursive :: DynFlags -> Int
binBlobThreshold :: DynFlags -> Word
liberateCaseThreshold :: DynFlags -> Maybe Int
floatLamArgs :: DynFlags -> Maybe Int
liftLamsRecArgs :: DynFlags -> Maybe Int
liftLamsNonRecArgs :: DynFlags -> Maybe Int
liftLamsKnown :: DynFlags -> Bool
cmmProcAlignment :: DynFlags -> Maybe Int
historySize :: DynFlags -> Int
importPaths :: DynFlags -> [CommandLineOption]
mainModIs :: DynFlags -> Module
mainFunIs :: DynFlags -> Maybe CommandLineOption
reductionDepth :: DynFlags -> IntWithInf
solverIterations :: DynFlags -> IntWithInf
thisInstalledUnitId :: DynFlags -> InstalledUnitId
thisComponentId_ :: DynFlags -> Maybe ComponentId
thisUnitIdInsts_ :: DynFlags -> Maybe [(ModuleName, Module)]
ways :: DynFlags -> [Way]
buildTag :: DynFlags -> CommandLineOption
splitInfo :: DynFlags -> Maybe (CommandLineOption, Int)
objectDir :: DynFlags -> Maybe CommandLineOption
dylibInstallName :: DynFlags -> Maybe CommandLineOption
hiDir :: DynFlags -> Maybe CommandLineOption
hieDir :: DynFlags -> Maybe CommandLineOption
stubDir :: DynFlags -> Maybe CommandLineOption
dumpDir :: DynFlags -> Maybe CommandLineOption
objectSuf :: DynFlags -> CommandLineOption
hcSuf :: DynFlags -> CommandLineOption
hiSuf :: DynFlags -> CommandLineOption
hieSuf :: DynFlags -> CommandLineOption
canGenerateDynamicToo :: DynFlags -> IORef Bool
dynObjectSuf :: DynFlags -> CommandLineOption
dynHiSuf :: DynFlags -> CommandLineOption
outputFile :: DynFlags -> Maybe CommandLineOption
dynOutputFile :: DynFlags -> Maybe CommandLineOption
outputHi :: DynFlags -> Maybe CommandLineOption
dynLibLoader :: DynFlags -> DynLibLoader
dumpPrefix :: DynFlags -> Maybe CommandLineOption
dumpPrefixForce :: DynFlags -> Maybe CommandLineOption
includePaths :: DynFlags -> IncludeSpecs
libraryPaths :: DynFlags -> [CommandLineOption]
frameworkPaths :: DynFlags -> [CommandLineOption]
cmdlineFrameworks :: DynFlags -> [CommandLineOption]
rtsOpts :: DynFlags -> Maybe CommandLineOption
rtsOptsEnabled :: DynFlags -> RtsOptsEnabled
rtsOptsSuggestions :: DynFlags -> Bool
hpcDir :: DynFlags -> CommandLineOption
pluginModNames :: DynFlags -> [ModuleName]
pluginModNameOpts :: DynFlags -> [(ModuleName, CommandLineOption)]
frontendPluginOpts :: DynFlags -> [CommandLineOption]
cachedPlugins :: DynFlags -> [LoadedPlugin]
staticPlugins :: DynFlags -> [StaticPlugin]
hooks :: DynFlags -> Hooks
depMakefile :: DynFlags -> CommandLineOption
depIncludePkgDeps :: DynFlags -> Bool
depIncludeCppDeps :: DynFlags -> Bool
depExcludeMods :: DynFlags -> [ModuleName]
depSuffixes :: DynFlags -> [CommandLineOption]
packageDBFlags :: DynFlags -> [PackageDBFlag]
ignorePackageFlags :: DynFlags -> [IgnorePackageFlag]
packageFlags :: DynFlags -> [PackageFlag]
pluginPackageFlags :: DynFlags -> [PackageFlag]
trustFlags :: DynFlags -> [TrustFlag]
packageEnv :: DynFlags -> Maybe CommandLineOption
pkgDatabase :: DynFlags -> Maybe [(CommandLineOption, [PackageConfig])]
pkgState :: DynFlags -> PackageState
filesToClean :: DynFlags -> IORef FilesToClean
dirsToClean :: DynFlags -> IORef (Map CommandLineOption CommandLineOption)
nextTempSuffix :: DynFlags -> IORef Int
generatedDumps :: DynFlags -> IORef (Set CommandLineOption)
dumpFlags :: DynFlags -> EnumSet DumpFlag
generalFlags :: DynFlags -> EnumSet GeneralFlag
warningFlags :: DynFlags -> EnumSet WarningFlag
fatalWarningFlags :: DynFlags -> EnumSet WarningFlag
language :: DynFlags -> Maybe Language
safeHaskell :: DynFlags -> SafeHaskellMode
safeInfer :: DynFlags -> Bool
safeInferred :: DynFlags -> Bool
thOnLoc :: DynFlags -> SrcSpan
newDerivOnLoc :: DynFlags -> SrcSpan
overlapInstLoc :: DynFlags -> SrcSpan
incoherentOnLoc :: DynFlags -> SrcSpan
pkgTrustOnLoc :: DynFlags -> SrcSpan
warnSafeOnLoc :: DynFlags -> SrcSpan
warnUnsafeOnLoc :: DynFlags -> SrcSpan
trustworthyOnLoc :: DynFlags -> SrcSpan
extensions :: DynFlags -> [OnOff Extension]
extensionFlags :: DynFlags -> EnumSet Extension
ufCreationThreshold :: DynFlags -> Int
ufUseThreshold :: DynFlags -> Int
ufFunAppDiscount :: DynFlags -> Int
ufDictDiscount :: DynFlags -> Int
ufKeenessFactor :: DynFlags -> Float
ufDearOp :: DynFlags -> Int
ufVeryAggressive :: DynFlags -> Bool
maxWorkerArgs :: DynFlags -> Int
ghciHistSize :: DynFlags -> Int
log_action :: DynFlags -> LogAction
flushOut :: DynFlags -> FlushOut
flushErr :: DynFlags -> FlushErr
ghcVersionFile :: DynFlags -> Maybe CommandLineOption
haddockOptions :: DynFlags -> Maybe CommandLineOption
ghciScripts :: DynFlags -> [CommandLineOption]
useColor :: DynFlags -> OverridingBool
canUseColor :: DynFlags -> Bool
colScheme :: DynFlags -> Scheme
profAuto :: DynFlags -> ProfAuto
interactivePrint :: DynFlags -> Maybe CommandLineOption
nextWrapperNum :: DynFlags -> IORef (ModuleEnv Int)
sseVersion :: DynFlags -> Maybe SseVersion
bmiVersion :: DynFlags -> Maybe BmiVersion
avx :: DynFlags -> Bool
avx2 :: DynFlags -> Bool
avx512cd :: DynFlags -> Bool
avx512er :: DynFlags -> Bool
avx512f :: DynFlags -> Bool
avx512pf :: DynFlags -> Bool
rtldInfo :: DynFlags -> IORef (Maybe LinkerInfo)
rtccInfo :: DynFlags -> IORef (Maybe CompilerInfo)
maxInlineAllocSize :: DynFlags -> Int
maxInlineMemcpyInsns :: DynFlags -> Int
maxInlineMemsetInsns :: DynFlags -> Int
reverseErrors :: DynFlags -> Bool
maxErrors :: DynFlags -> Maybe Int
initialUnique :: DynFlags -> Int
uniqueIncrement :: DynFlags -> Int
cfgWeightInfo :: DynFlags -> CfgWeights
cfgWeightInfo :: CfgWeights
uniqueIncrement :: Int
initialUnique :: Int
maxErrors :: Maybe Int
reverseErrors :: Bool
maxInlineMemsetInsns :: Int
maxInlineMemcpyInsns :: Int
maxInlineAllocSize :: Int
rtccInfo :: IORef (Maybe CompilerInfo)
rtldInfo :: IORef (Maybe LinkerInfo)
avx512pf :: Bool
avx512f :: Bool
avx512er :: Bool
avx512cd :: Bool
avx2 :: Bool
avx :: Bool
bmiVersion :: Maybe BmiVersion
sseVersion :: Maybe SseVersion
nextWrapperNum :: IORef (ModuleEnv Int)
interactivePrint :: Maybe CommandLineOption
profAuto :: ProfAuto
colScheme :: Scheme
canUseColor :: Bool
useColor :: OverridingBool
useUnicode :: Bool
pprCols :: Int
pprUserLength :: Int
ghciScripts :: [CommandLineOption]
haddockOptions :: Maybe CommandLineOption
ghcVersionFile :: Maybe CommandLineOption
flushErr :: FlushErr
flushOut :: FlushOut
log_action :: LogAction
ghciHistSize :: Int
maxWorkerArgs :: Int
ufVeryAggressive :: Bool
ufDearOp :: Int
ufKeenessFactor :: Float
ufDictDiscount :: Int
ufFunAppDiscount :: Int
ufUseThreshold :: Int
ufCreationThreshold :: Int
extensionFlags :: EnumSet Extension
extensions :: [OnOff Extension]
trustworthyOnLoc :: SrcSpan
warnUnsafeOnLoc :: SrcSpan
warnSafeOnLoc :: SrcSpan
pkgTrustOnLoc :: SrcSpan
incoherentOnLoc :: SrcSpan
overlapInstLoc :: SrcSpan
newDerivOnLoc :: SrcSpan
thOnLoc :: SrcSpan
safeInferred :: Bool
safeInfer :: Bool
safeHaskell :: SafeHaskellMode
language :: Maybe Language
fatalWarningFlags :: EnumSet WarningFlag
warningFlags :: EnumSet WarningFlag
generalFlags :: EnumSet GeneralFlag
dumpFlags :: EnumSet DumpFlag
generatedDumps :: IORef (Set CommandLineOption)
nextTempSuffix :: IORef Int
dirsToClean :: IORef (Map CommandLineOption CommandLineOption)
filesToClean :: IORef FilesToClean
pkgState :: PackageState
pkgDatabase :: Maybe [(CommandLineOption, [PackageConfig])]
packageEnv :: Maybe CommandLineOption
trustFlags :: [TrustFlag]
pluginPackageFlags :: [PackageFlag]
packageFlags :: [PackageFlag]
ignorePackageFlags :: [IgnorePackageFlag]
packageDBFlags :: [PackageDBFlag]
depSuffixes :: [CommandLineOption]
depExcludeMods :: [ModuleName]
depIncludeCppDeps :: Bool
depIncludePkgDeps :: Bool
depMakefile :: CommandLineOption
hooks :: Hooks
staticPlugins :: [StaticPlugin]
cachedPlugins :: [LoadedPlugin]
frontendPluginOpts :: [CommandLineOption]
pluginModNameOpts :: [(ModuleName, CommandLineOption)]
pluginModNames :: [ModuleName]
hpcDir :: CommandLineOption
rtsOptsSuggestions :: Bool
rtsOptsEnabled :: RtsOptsEnabled
rtsOpts :: Maybe CommandLineOption
cmdlineFrameworks :: [CommandLineOption]
frameworkPaths :: [CommandLineOption]
libraryPaths :: [CommandLineOption]
includePaths :: IncludeSpecs
ldInputs :: [Option]
dumpPrefixForce :: Maybe CommandLineOption
dumpPrefix :: Maybe CommandLineOption
dynLibLoader :: DynLibLoader
outputHi :: Maybe CommandLineOption
dynOutputFile :: Maybe CommandLineOption
outputFile :: Maybe CommandLineOption
dynHiSuf :: CommandLineOption
dynObjectSuf :: CommandLineOption
canGenerateDynamicToo :: IORef Bool
hieSuf :: CommandLineOption
hiSuf :: CommandLineOption
hcSuf :: CommandLineOption
objectSuf :: CommandLineOption
dumpDir :: Maybe CommandLineOption
stubDir :: Maybe CommandLineOption
hieDir :: Maybe CommandLineOption
hiDir :: Maybe CommandLineOption
dylibInstallName :: Maybe CommandLineOption
objectDir :: Maybe CommandLineOption
splitInfo :: Maybe (CommandLineOption, Int)
buildTag :: CommandLineOption
ways :: [Way]
thisUnitIdInsts_ :: Maybe [(ModuleName, Module)]
thisComponentId_ :: Maybe ComponentId
thisInstalledUnitId :: InstalledUnitId
solverIterations :: IntWithInf
reductionDepth :: IntWithInf
mainFunIs :: Maybe CommandLineOption
mainModIs :: Module
importPaths :: [CommandLineOption]
historySize :: Int
cmmProcAlignment :: Maybe Int
liftLamsKnown :: Bool
liftLamsNonRecArgs :: Maybe Int
liftLamsRecArgs :: Maybe Int
floatLamArgs :: Maybe Int
liberateCaseThreshold :: Maybe Int
binBlobThreshold :: Word
specConstrRecursive :: Int
specConstrCount :: Maybe Int
specConstrThreshold :: Maybe Int
simplTickFactor :: Int
maxPmCheckModels :: Int
maxUncoveredPatterns :: Int
refLevelHoleFits :: Maybe Int
maxRefHoleFits :: Maybe Int
maxValidHoleFits :: Maybe Int
maxRelevantBinds :: Maybe Int
ghcHeapSize :: Maybe Int
enableTimeStats :: Bool
parMakeCount :: Maybe Int
strictnessBefore :: [Int]
inlineCheck :: Maybe CommandLineOption
ruleCheck :: Maybe CommandLineOption
maxSimplIterations :: Int
simplPhases :: Int
debugLevel :: Int
optLevel :: Int
verbosity :: Int
llvmConfig :: LlvmConfig
integerLibrary :: IntegerLibrary
rawSettings :: [(CommandLineOption, CommandLineOption)]
platformConstants :: PlatformConstants
platformMisc :: PlatformMisc
toolSettings :: ToolSettings
targetPlatform :: Platform
fileSettings :: FileSettings
ghcNameVersion :: GhcNameVersion
hscTarget :: HscTarget
ghcLink :: GhcLink
ghcMode :: GhcMode
ldInputs :: DynFlags -> [Option]
hscTarget :: DynFlags -> HscTarget
..}
  | Just CommandLineOption
p <- Maybe CommandLineOption
objectDir = CommandLineOption
p
  | Just CommandLineOption
p <- Maybe CommandLineOption
dumpDir   = CommandLineOption
p
  | Bool
otherwise           = CommandLineOption
"."

optionOfPath :: FilePath -> Option
optionOfPath :: CommandLineOption -> Option
optionOfPath = CommandLineOption -> CommandLineOption -> Option
FileOption []