module Rules.Gmp (gmpRules, gmpBuildPath, gmpObjects, gmpLibraryH) where

import Base
import Context
import Oracles.Setting
import Packages
import Target
import Utilities

-- | Build GMP library objects and return their paths.
gmpObjects :: Action [FilePath]
gmpObjects = do
    gmpPath <- gmpBuildPath
    need [gmpPath -/- gmpLibraryH]
    -- The line below causes a Shake Lint failure on Windows, which forced us to
    -- disable Lint by default. See more details here:
    -- https://ghc.haskell.org/trac/ghc/ticket/15971.
    map (unifyPath . (gmpPath -/-)) <$>
        liftIO (getDirectoryFilesIO gmpPath [gmpObjectsDir -/- "*.o"])

gmpBase :: FilePath
gmpBase = pkgPath integerGmp -/- "gmp"

gmpLibraryInTreeH :: FilePath
gmpLibraryInTreeH = "include/gmp.h"

gmpLibrary :: FilePath
gmpLibrary = ".libs/libgmp.a"

-- | GMP is considered a Stage1 package. This determines GMP build directory.
gmpContext :: Context
gmpContext = vanillaContext Stage1 integerGmp

-- TODO: Location of 'gmpBuildPath' is important: it should be outside any
-- package build directory, as otherwise GMP's object files will match build
-- patterns of 'compilePackage' rules. We could make 'compilePackage' rules
-- more precise to avoid such spurious matching.
-- | Build directory for in-tree GMP library.
gmpBuildPath :: Action FilePath
gmpBuildPath = buildRoot <&> (-/- stageString (stage gmpContext) -/- "gmp")

-- | Like 'gmpBuildPath' but in the 'Rules' monad.
gmpBuildPathRules :: Rules FilePath
gmpBuildPathRules = buildRootRules <&> (-/- stageString (stage gmpContext) -/- "gmp")

-- | GMP library header, relative to 'gmpBuildPath'.
gmpLibraryH :: FilePath
gmpLibraryH = "include/ghc-gmp.h"

-- | Directory for GMP library object files, relative to 'gmpBuildPath'.
gmpObjectsDir :: FilePath
gmpObjectsDir = "objs"

configureEnvironment :: Action [CmdOption]
configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
                                , builderEnvironment "AR" (Ar Unpack Stage1)
                                , builderEnvironment "NM" Nm ]

gmpRules :: Rules ()
gmpRules = do
    -- Copy appropriate GMP header and object files
    gmpPath <- gmpBuildPathRules
    gmpPath -/- gmpLibraryH %> \header -> do
        windows  <- windowsHost
        configMk <- readFile' =<< (buildPath gmpContext <&> (-/- "config.mk"))
        if not windows && -- TODO: We don't use system GMP on Windows. Fix?
           any (`isInfixOf` configMk) [ "HaveFrameworkGMP = YES", "HaveLibGmp = YES" ]
        then do
            putBuild "| GMP library/framework detected and will be used"
            copyFile (gmpBase -/- "ghc-gmp.h") header
        else do
            putBuild "| No GMP library/framework detected; in tree GMP will be built"
            need [gmpPath -/- gmpLibrary]
            createDirectory (gmpPath -/- gmpObjectsDir)
            top <- topDirectory
            build $ target gmpContext (Ar Unpack Stage1)
                [top -/- gmpPath -/- gmpLibrary] [gmpPath -/- gmpObjectsDir]
            objs <- liftIO $ getDirectoryFilesIO "." [gmpPath -/- gmpObjectsDir -/- "*"]
            produces objs
            copyFileUntracked (gmpPath -/- "gmp.h") header

    -- Build in-tree GMP library, prioritised so that it matches "before"
    -- the generic @.a@ library rule in 'Rules.Library'.
    priority 2.0 $ gmpPath -/- gmpLibrary %> \lib -> do
        build $ target gmpContext (Make gmpPath) [gmpPath -/- "Makefile"] [lib]
        putSuccess "| Successfully built custom library 'gmp'"

    gmpPath -/- gmpLibraryInTreeH %> copyFile (gmpPath -/- gmpLibraryH)

    root <- buildRootRules
    root -/- buildDir gmpContext -/- gmpLibraryH %>
        copyFile (gmpPath -/- gmpLibraryH)

    -- This file is created when 'integerGmp' is configured.
    gmpPath -/- "config.mk" %> \_ -> ensureConfigured gmpContext

    -- Run GMP's configure script
    gmpPath -/- "Makefile" %> \mk -> do
        env <- configureEnvironment
        need [mk <.> "in"]
        buildWithCmdOptions env $
            target gmpContext (Configure gmpPath) [mk <.> "in"] [mk]

    -- Extract in-tree GMP sources and apply patches
    fmap (gmpPath -/-) ["Makefile.in", "configure"] &%> \_ -> do
        top <- topDirectory
        removeDirectory gmpPath
        -- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is
        -- gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents.
        -- That's because the doc/ directory contents are under the GFDL,
        -- which causes problems for Debian.
        tarball <- unifyPath . fromSingleton "Exactly one GMP tarball is expected"
               <$> getDirectoryFiles top [gmpBase -/- "gmp-tarballs/gmp*.tar.bz2"]

        withTempDir $ \dir -> do
            let tmp = unifyPath dir
            need [top -/- tarball]
            build $ target gmpContext (Tar Extract) [top -/- tarball] [tmp]

            let patch     = gmpBase -/- "gmpsrc.patch"
                patchName = takeFileName patch
            copyFile patch $ tmp -/- patchName
            applyPatch tmp patchName

            let name    = dropExtension . dropExtension $ takeFileName tarball
                unpack  = fromMaybe . error $ "gmpRules: expected suffix "
                    ++ "-nodoc (found: " ++ name ++ ")."
                libName = unpack $ stripSuffix "-nodoc" name

            moveDirectory (tmp -/- libName) gmpPath


module Rules.Libffi (libffiRules, libffiDependencies, libffiName) where

import Hadrian.Utilities

import Packages
import Settings.Builders.Common
import Target
import Utilities

{-
Note [Hadrian: install libffi hack]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

There are 2 important steps in handling libffi's .a and .so files:

  1. libffi's .a and .so|.dynlib|.dll files are copied from the libffi build dir
  to the rts build dir. This is because libffi is ultimately bundled with the
  rts package. Relevant code is in the libffiRules function.
  2. The rts is "installed" via the hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
  copyPackage action. This uses the "cabal copy" command which (among other
  things) attempts to copy the bundled .a and .so|.dynlib|.dll files from the
  rts build dir to the install dir.

There is an issue in step 1. that the name of the shared library files is not
know untill after libffi is built. As a workaround, the rts package needs just
the libffiDependencies, and the corresponding rule (defined below in
libffiRules) does the extra work of installing the shared library files into the
rts build directory after building libffi.
-}

-- | Context for @libffi@.
libffiContext :: Stage -> Action Context
libffiContext stage = do
    ways <- interpretInContext
            (Context stage libffi (error "libffiContext: way not set"))
            getLibraryWays
    return . Context stage libffi $ if any (wayUnit Dynamic) ways
        then dynamic
        else vanilla

-- | The name of the (locally built) library
libffiName :: Expr String
libffiName = do
    windows <- expr windowsHost
    way <- getWay
    return $ libffiName' windows (Dynamic `wayUnit` way)

-- | The name of the (locally built) library
libffiName' :: Bool -> Bool -> String
libffiName' windows dynamic
    = (if dynamic then "" else "C")
    ++ (if windows then "ffi-6" else "ffi")

libffiDependencies :: [FilePath]
libffiDependencies = ["ffi.h", "ffitarget.h"]

libffiLibrary :: FilePath
libffiLibrary = "inst/lib/libffi.a"

rtsLibffiLibrary :: Stage -> Way -> Action FilePath
rtsLibffiLibrary stage way = do
    name    <- libffiLibraryName
    suf     <- libsuf way
    rtsPath <- rtsBuildPath stage
    return $ rtsPath -/- "lib" ++ name ++ suf

fixLibffiMakefile :: FilePath -> String -> String
fixLibffiMakefile top =
      replace "-MD" "-MMD"
    . replace "@toolexeclibdir@" "$(libdir)"
    . replace "@INSTALL@" ("$(subst ../install-sh," ++ top ++ "/install-sh,@INSTALL@)")

-- TODO: check code duplication w.r.t. ConfCcArgs
configureEnvironment :: Stage -> Action [CmdOption]
configureEnvironment stage = do
    context <- libffiContext stage
    cFlags  <- interpretInContext context $ mconcat
               [ cArgs
               , getStagedSettingList ConfCcArgs ]
    ldFlags <- interpretInContext context ldArgs
    sequence [ builderEnvironment "CC" $ Cc CompileC stage
             , builderEnvironment "CXX" $ Cc CompileC stage
             , builderEnvironment "LD" (Ld stage)
             , builderEnvironment "AR" (Ar Unpack stage)
             , builderEnvironment "NM" Nm
             , builderEnvironment "RANLIB" Ranlib
             , return . AddEnv  "CFLAGS" $ unwords  cFlags ++ " -w"
             , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ]

libffiRules :: Rules ()
libffiRules = forM_ [Stage1 ..] $ \stage -> do
    root <- buildRootRules
    let path       = root -/- stageString stage
        libffiPath = path -/- pkgName libffi -/- "build"
        libffiOuts = [libffiPath -/- libffiLibrary] ++
                     fmap ((path -/- "rts/build") -/-) libffiDependencies

    -- We set a higher priority because this rule overlaps with the build rule
    -- for static libraries 'Rules.Library.libraryRules'.
    -- See [Hadrian: install libffi hack], this rule installs libffi into the
    -- rts build path.
    priority 2.0 $ libffiOuts &%> \_ -> do
        context <- libffiContext stage
        useSystemFfi <- flag UseSystemFfi
        rtsPath      <- rtsBuildPath stage
        if useSystemFfi
        then do
            ffiIncludeDir <- setting FfiIncludeDir
            putBuild "| System supplied FFI library will be used"
            forM_ ["ffi.h", "ffitarget.h"] $ \file ->
                copyFile (ffiIncludeDir -/- file) (rtsPath -/- file)
            putSuccess "| Successfully copied system FFI library header files"
        else do
            build $ target context (Make libffiPath) [] []

            -- Here we produce 'libffiDependencies'
            headers <- liftIO $ getDirectoryFilesIO libffiPath ["inst/include/*"]
            forM_ headers $ \header -> do
                let target = rtsPath -/- takeFileName header
                copyFileUntracked (libffiPath -/- header) target
                produces [target]

            -- Find ways.
            ways <- interpretInContext context
                                       (getLibraryWays <> getRtsWays)
            let (dynamicWays, staticWays) = partition (wayUnit Dynamic) ways

            -- Install static libraries.
            forM_ staticWays $ \way -> do
                rtsLib <- rtsLibffiLibrary stage way
                copyFileUntracked (libffiPath -/- "inst/lib/libffi.a") rtsLib
                produces [rtsLib]

            -- Install dynamic libraries.
            when (not $ null dynamicWays) $ do
                -- Find dynamic libraries.
                windows <- windowsHost
                osx     <- osxHost
                let libffiName'' = libffiName' windows True
                (dynLibsSrcDir, dynLibFiles) <- if windows
                    then do
                        let libffiDll = "lib" ++ libffiName'' ++ ".dll"
                        return (libffiPath -/- "inst/bin", [libffiDll])
                    else do
                        let libffiLibPath = libffiPath -/- "inst/lib"
                        dynLibsRelative <- liftIO $ getDirectoryFilesIO
                            libffiLibPath
                            (if osx
                                then ["lib" ++ libffiName'' ++ ".dylib*"]
                                else ["lib" ++ libffiName'' ++ ".so*"])
                        return (libffiLibPath, dynLibsRelative)

                -- Install dynamic libraries.
                rtsPath <- rtsBuildPath stage
                forM_ dynLibFiles $ \dynLibFile -> do
                    let target = rtsPath -/- dynLibFile
                    copyFileUntracked (dynLibsSrcDir -/- dynLibFile) target

                    -- On OSX the dylib's id must be updated to a relative path.
                    when osx $ cmd
                        [ "install_name_tool"
                        , "-id", "@rpath/" ++ dynLibFile
                        , target
                        ]

                    produces [target]

            putSuccess "| Successfully bundled custom library 'libffi' with rts"

    fmap (libffiPath -/-) ["Makefile.in", "configure" ] &%> \[mkIn, _] -> do
        -- Extract libffi tar file
        context <- libffiContext stage
        removeDirectory libffiPath
        top <- topDirectory
        tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected"
               <$> getDirectoryFiles top ["libffi-tarballs/libffi*.tar.gz"]

        need [top -/- tarball]
        -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999'
        let libname = takeWhile (/= '+') $ takeFileName tarball

        -- Move extracted directory to libffiPath.
        root <- buildRoot
        removeDirectory (root -/- libname)
        actionFinally (do
            build $ target context (Tar Extract) [tarball] [path]
            moveDirectory (path -/- libname) libffiPath) $
            -- And finally:
            removeFiles (path) [libname <//> "*"]

        fixFile mkIn (fixLibffiMakefile top)

        files <- liftIO $ getDirectoryFilesIO "." [libffiPath <//> "*"]
        produces files

    fmap (libffiPath -/-) ["Makefile", "config.guess", "config.sub"] &%> \[mk, _, _] -> do
        context <- libffiContext stage

        -- This need rule extracts the libffi tar file to libffiPath.
        need [mk <.> "in"]

        -- Configure.
        forM_ ["config.guess", "config.sub"] $ \file -> do
            copyFile file (libffiPath -/- file)
        env <- configureEnvironment stage
        buildWithCmdOptions env $
            target context (Configure libffiPath) [mk <.> "in"] [mk]

        dir   <- setting BuildPlatform
        files <- liftIO $ getDirectoryFilesIO "." [libffiPath -/- dir <//> "*"]
        produces files


module Rules.Library (libraryRules) where

import Hadrian.BuildPath
import Hadrian.Haskell.Cabal
import Hadrian.Haskell.Cabal.Type
import qualified System.Directory as IO
import qualified Text.Parsec      as Parsec

import Base
import Context
import Expression hiding (way, package)
import Flavour
import Oracles.ModuleFiles
import Packages
import Rules.Gmp
import Rules.Libffi (libffiDependencies)
import Settings
import Target
import Utilities

-- * Library 'Rules'

libraryRules :: Rules ()
libraryRules = do
    root <- buildRootRules
    root -/- "//libHS*-*.dylib"       %> buildDynamicLibUnix root "dylib"
    root -/- "//libHS*-*.so"          %> buildDynamicLibUnix root "so"
    root -/- "//*.a"                  %> buildStaticLib      root
    priority 2 $ do
        root -/- "//HS*-*.o" %> buildGhciLibO root
        root -/- "//HS*-*.p_o" %> buildGhciLibO root

-- * 'Action's for building libraries

-- | Build a static library ('LibA') under the given build root, whose path is
-- the second argument.
buildStaticLib :: FilePath -> FilePath -> Action ()
buildStaticLib root archivePath = do
    l@(BuildPath _ stage _ (LibA pkgname _ way))
        <- parsePath (parseBuildLibA root)
                     "<.a library (build) path parser>"
                     archivePath
    let context = libAContext l
    objs <- libraryObjects context
    removeFile archivePath
    build $ target context (Ar Pack stage) objs [archivePath]
    synopsis <- pkgSynopsis (package context)
    putSuccess $ renderLibrary
        (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").")
        archivePath synopsis

-- | Build a dynamic library ('LibDyn') under the given build root, with the
-- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete
-- path of the archive to build is given as the third argument.
buildDynamicLibUnix :: FilePath -> String -> FilePath -> Action ()
buildDynamicLibUnix root suffix dynlibpath = do
    dynlib <- parsePath (parseBuildLibDyn root suffix) "<dyn lib parser>" dynlibpath
    let context = libDynContext dynlib
    deps <- contextDependencies context
    need =<< mapM pkgLibraryFile deps

    -- TODO should this be somewhere else?
    -- Custom build step to generate libffi.so* in the rts build directory.
    when (package context == rts) . interpretInContext context $ do
        stage   <- getStage
        rtsPath <- expr (rtsBuildPath stage)
        expr $ need ((rtsPath -/-) <$> libffiDependencies)

    objs <- libraryObjects context
    build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath]

-- | Build a "GHCi library" ('LibGhci') under the given build root, with the
-- complete path of the file to build is given as the second argument.
buildGhciLibO :: FilePath -> FilePath -> Action ()
buildGhciLibO root ghcilibPath = do
    l@(BuildPath _ stage _ (LibGhci _ _ _))
        <- parsePath (parseBuildLibGhci root)
                     "<.o ghci lib (build) path parser>"
                     ghcilibPath
    let context = libGhciContext l
    objs <- allObjects context
    need objs
    build $ target context (Ld stage) objs [ghcilibPath]

-- * Helpers

-- | Return all Haskell and non-Haskell object files for the given 'Context'.
allObjects :: Context -> Action [FilePath]
allObjects context = (++) <$> nonHsObjects context <*> hsObjects context

-- | Return all the non-Haskell object files for the given library context
-- (object files built from C, C-- and sometimes other things).
nonHsObjects :: Context -> Action [FilePath]
nonHsObjects context = do
    cObjs   <- cObjects context
    cmmSrcs <- interpretInContext context (getContextData cmmSrcs)
    cmmObjs <- mapM (objectPath context) cmmSrcs
    eObjs   <- extraObjects context
    return $ cObjs ++ cmmObjs ++ eObjs

-- | Return all the C object files needed to build the given library context.
cObjects :: Context -> Action [FilePath]
cObjects context = do
    srcs <- interpretInContext context (getContextData cSrcs)
    objs <- mapM (objectPath context) srcs
    return $ if Threaded `wayUnit` way context
        then objs
        else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs

-- | Return extra object files needed to build the given library context. The
-- resulting list is currently non-empty only when the package from the
-- 'Context' is @integer-gmp@.
extraObjects :: Context -> Action [FilePath]
extraObjects context
    | package context == integerGmp = gmpObjects
    | otherwise                     = return []

-- | Return all the object files to be put into the library we're building for
-- the given 'Context'.
libraryObjects :: Context -> Action [FilePath]
libraryObjects context@Context{..} = do
    hsObjs   <- hsObjects    context
    noHsObjs <- nonHsObjects context
    need $ noHsObjs ++ hsObjs
    return (noHsObjs ++ hsObjs)

-- * Library paths types and parsers

-- | > libHS<pkg name>-<pkg version>[_<way suffix>].a
data LibA = LibA String [Integer] Way deriving (Eq, Show)

-- | > <so or dylib>
data DynLibExt = So | Dylib deriving (Eq, Show)

-- | > libHS<pkg name>-<pkg version>[_<way suffix>]-ghc<ghc version>.<so|dylib>
data LibDyn = LibDyn String [Integer] Way DynLibExt deriving (Eq, Show)

-- | > HS<pkg name>-<pkg version>[_<way suffix>].o
data LibGhci = LibGhci String [Integer] Way deriving (Eq, Show)

-- | Get the 'Context' corresponding to the build path for a given static library.
libAContext :: BuildPath LibA -> Context
libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) =
    Context stage pkg way
  where
    pkg = library pkgname pkgpath

-- | Get the 'Context' corresponding to the build path for a given GHCi library.
libGhciContext :: BuildPath LibGhci -> Context
libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) =
    Context stage pkg way
  where
    pkg = library pkgname pkgpath

-- | Get the 'Context' corresponding to the build path for a given dynamic library.
libDynContext :: BuildPath LibDyn -> Context
libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) =
    Context stage pkg way
  where
    pkg = library pkgname pkgpath

-- | Parse a path to a static library to be built, making sure the path starts
-- with the given build root.
parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA)
parseBuildLibA root = parseBuildPath root parseLibAFilename
    Parsec.<?> "build path for a static library"

-- | Parse a path to a ghci library to be built, making sure the path starts
-- with the given build root.
parseBuildLibGhci :: FilePath -> Parsec.Parsec String () (BuildPath LibGhci)
parseBuildLibGhci root = parseBuildPath root parseLibGhciFilename
    Parsec.<?> "build path for a ghci library"

-- | Parse a path to a dynamic library to be built, making sure the path starts
-- with the given build root.
parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath LibDyn)
parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext)
    Parsec.<?> ("build path for a dynamic library with extension " ++ ext)

-- | Parse the filename of a static library to be built into a 'LibA' value.
parseLibAFilename :: Parsec.Parsec String () LibA
parseLibAFilename = do
    _ <- Parsec.string "libHS"
    (pkgname, pkgver) <- parsePkgId
    way <- parseWaySuffix vanilla
    _ <- Parsec.string ".a"
    return (LibA pkgname pkgver way)

-- | Parse the filename of a ghci library to be built into a 'LibGhci' value.
parseLibGhciFilename :: Parsec.Parsec String () LibGhci
parseLibGhciFilename = do
    _ <- Parsec.string "HS"
    (pkgname, pkgver) <- parsePkgId
    _ <- Parsec.string "."
    way <- parseWayPrefix vanilla
    _ <- Parsec.string "o"
    return (LibGhci pkgname pkgver way)

-- | Parse the filename of a dynamic library to be built into a 'LibDyn' value.
parseLibDynFilename :: String -> Parsec.Parsec String () LibDyn
parseLibDynFilename ext = do
    _ <- Parsec.string "libHS"
    (pkgname, pkgver) <- parsePkgId
    way <- addWayUnit Dynamic <$> parseWaySuffix dynamic
    _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion
    _ <- Parsec.string ("." ++ ext)
    return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib)


module Rules.Nofib where

import Base
import Expression
import Oracles.Setting
import Packages

import System.Environment
import System.Exit

nofibLogFile :: FilePath
nofibLogFile = "nofib-log"

-- | Rules for running the @nofib@ benchmark suite.
nofibRules :: Rules ()
nofibRules = do
    root <- buildRootRules

    -- a phony "nofib" rule that just triggers
    -- the rule below.
    "nofib" ~> need [root -/- nofibLogFile]

    -- a rule to produce <build root>/nofig-log
    -- by running the nofib suite and capturing
    -- the relevant output.
    root -/- nofibLogFile %> \fp -> do
        needNofibDeps

        makePath <- builderPath (Make "nofib")
        top      <- topDirectory
        ghcPath  <- builderPath (Ghc CompileHs Stage2)
        perlPath <- builderPath Perl

        -- some makefiles in nofib rely on a $MAKE
        -- env var being defined
        liftIO (setEnv "MAKE" makePath)

        -- this runs make commands in the nofib
        -- subdirectory, passing the path to
        -- the GHC to benchmark and perl to
        -- nofib's makefiles.
        let nofibArgs = ["WithNofibHc=" ++ (top -/- ghcPath), "PERL=" ++ perlPath]
        unit $ cmd (Cwd "nofib") [makePath] ["clean"]
        unit $ cmd (Cwd "nofib") [makePath] (nofibArgs ++ ["boot"])
        (Exit e, Stdouterr log) <- cmd (Cwd "nofib") [makePath] nofibArgs
        writeFile' fp log
        if e == ExitSuccess
            then putLoud $ "nofib log available at " ++ fp
            else error $ "nofib failed, full log available at " ++ fp

-- | Build the dependencies required by @nofib@.
needNofibDeps :: Action ()
needNofibDeps = do
    unlitPath <- programPath (vanillaContext Stage1 unlit)
    mtlPath   <- pkgConfFile (vanillaContext Stage1 mtl  )
    need [ unlitPath, mtlPath ]
    needBuilder (Ghc CompileHs Stage2)


module Rules.Program (buildProgramRules) where

import Hadrian.Haskell.Cabal
import Hadrian.Haskell.Cabal.Type

import Base
import Context
import Expression hiding (stage, way)
import Oracles.Flag
import Oracles.ModuleFiles
import Oracles.Setting (topDirectory)
import Packages
import Settings
import Settings.Default
import Target
import Utilities

-- | TODO: Drop code duplication
buildProgramRules :: [(Resource, Int)] -> Rules ()
buildProgramRules rs = do
    root <- buildRootRules

    -- Proxy rule for the whole mingw toolchain on Windows.
    -- We 'need' configure  because that's when the inplace/mingw
    -- folder gets filled with the toolchain. This "proxy" rule
    -- is listed as a runtime dependency for stage >= 1 GHCs.
    root -/- mingwStamp %> \stampPath -> do
        top <- topDirectory
        need [ top -/- "configure" ]
        copyDirectory (top -/- "inplace" -/- "mingw") root
        writeFile' stampPath "OK"

    -- Rules for programs that are actually built by hadrian.
    forM_ [Stage0 ..] $ \stage ->
        [ root -/- stageString stage -/- "bin"     -/- "*"
        , root -/- stageString stage -/- "lib/bin" -/- "*" ] |%> \bin -> do
            programContexts <- getProgramContexts stage
            case lookupProgramContext bin programContexts of
                Nothing  -> error $ "Unknown program " ++ show bin
                Just ctx -> buildProgram bin ctx rs

getProgramContexts :: Stage -> Action [(FilePath, Context)]
getProgramContexts stage = do
  -- This is quite inefficient, but we can't access 'programName' from
  -- 'Rules', because it is an 'Action' depending on an oracle.
  sPackages <- filter isProgram <$> stagePackages stage
  tPackages <- testsuitePackages
  -- TODO: Shall we use Stage2 for testsuite packages instead?
  let allPackages = sPackages
                ++ if stage == Stage1 then tPackages else []
  fmap concat . forM allPackages $ \pkg -> do
    -- the iserv pkg results in three different programs at
    -- the moment, ghc-iserv (built the vanilla way),
    -- ghc-iserv-prof (built the profiling way), and
    -- ghc-iserv-dyn (built the dynamic way).
    -- The testsuite requires all to be present, so we
    -- make sure that we cover these
    -- "prof-build-under-other-name" cases.
    -- iserv gets its names from Packages.hs:programName
    ctx <- programContext stage pkg -- TODO: see todo on programContext.
    let allCtxs = if pkg == iserv
        then [ vanillaContext stage pkg
             , Context stage pkg profiling
             , Context stage pkg dynamic
             ]
        else [ ctx ]
    forM allCtxs $ \ctx -> do
      name <- programName ctx
      return (name <.> exe, ctx)

lookupProgramContext :: FilePath -> [(FilePath, Context)] -> Maybe Context
lookupProgramContext wholePath progs = lookup (takeFileName wholePath) progs

buildProgram :: FilePath -> Context -> [(Resource, Int)] -> Action ()
buildProgram bin ctx@(Context{..}) rs = do
  -- Custom dependencies: this should be modeled better in the
  -- Cabal file somehow.
  -- TODO: Is this still needed? See 'runtimeDependencies'.
  when (package == hsc2hs) $ do
    -- 'Hsc2hs' needs the @template-hsc.h@ file.
    template <- templateHscPath stage
    need [template]
  when (package == ghc) $ do
    -- GHC depends on @settings@, @platformConstants@,
    -- @llvm-targets@, @ghc-usage.txt@, @ghci-usage.txt@,
    -- @llvm-passes@.
    need =<< ghcDeps stage
  when (package == haddock) $ do
    -- Haddock has a resource folder
    need =<< haddockDeps stage

  cross <- flag CrossCompiling
  -- For cross compiler, copy @stage0/bin/<pgm>@ to @stage1/bin/@.
  case (cross, stage) of
    (True, s) | s > Stage0 -> do
        srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- "bin"))
        copyFile (srcDir -/- takeFileName bin) bin
    (False, s) | s > Stage0 && (package `elem` [touchy, unlit]) -> do
        srcDir <- stageLibPath Stage0 <&> (-/- "bin")
        copyFile (srcDir -/- takeFileName bin) bin
    _ -> buildBinary rs bin ctx

buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action ()
buildBinary rs bin context@Context {..} = do
    needLibrary =<< contextDependencies context
    when (stage > Stage0) $ do
        ways <- interpretInContext context (getLibraryWays <> getRtsWays)
        needLibrary [ (rtsContext stage) { way = w } | w <- ways ]
    cSrcs  <- interpretInContext context (getContextData cSrcs)
    cObjs  <- mapM (objectPath context) cSrcs
    hsObjs <- hsObjects context
    let binDeps = cObjs ++ hsObjs
    need binDeps
    buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
    synopsis <- pkgSynopsis package
    putSuccess $ renderProgram
        (quote (pkgName package) ++ " (" ++ show stage ++ ").") bin synopsis


module Rules.Register (configurePackageRules, registerPackageRules) where

import Base
import Context
import Hadrian.BuildPath
import Hadrian.Expression
import Hadrian.Haskell.Cabal
import Oracles.Setting
import Packages
import Rules.Gmp
import Settings
import Target
import Utilities

import Distribution.Version (Version)
import qualified Distribution.Parsec as Cabal
import qualified Distribution.Types.PackageName as Cabal
import qualified Distribution.Types.PackageId as Cabal

import qualified Hadrian.Haskell.Cabal.Parse as Cabal
import qualified System.Directory            as IO
import qualified Text.Parsec                 as Parsec

-- * Configuring

-- | Configure a package and build its @setup-config@ file, as well as files in
-- the @build/pkgName/build/autogen@ directory.
configurePackageRules :: Rules ()
configurePackageRules = do
    root <- buildRootRules
    root -/- "**/setup-config" %> \out -> do
        (stage, path) <- parsePath (parseSetupConfig root) "<setup config path parser>" out
        let pkg = unsafeFindPackageByPath path
        Cabal.configurePackage (Context stage pkg vanilla)

    root -/- "**/autogen/cabal_macros.h" %> \out -> do
        (stage, path) <- parsePath (parseToBuildSubdirectory root) "<cabal macros path parser>" out
        let pkg = unsafeFindPackageByPath path
        Cabal.buildAutogenFiles (Context stage pkg vanilla)

    root -/- "**/autogen/Paths_*.hs" %> \out ->
        need [takeDirectory out -/- "cabal_macros.h"]

parseSetupConfig :: FilePath -> Parsec.Parsec String () (Stage, FilePath)
parseSetupConfig root = do
    _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
    stage <- parseStage
    _ <- Parsec.char '/'
    pkgPath <- Parsec.manyTill Parsec.anyChar
        (Parsec.try $ Parsec.string "/setup-config")
    return (stage, pkgPath)

parseToBuildSubdirectory :: FilePath -> Parsec.Parsec String () (Stage, FilePath)
parseToBuildSubdirectory root = do
    _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
    stage <- parseStage
    _ <- Parsec.char '/'
    pkgPath <- Parsec.manyTill Parsec.anyChar
        (Parsec.try $ Parsec.string "/build/")
    return (stage, pkgPath)

-- * Registering

-- | Register a package and initialise the corresponding package database if
-- need be. Note that we only register packages in 'Stage0' and 'Stage1'.
registerPackageRules :: [(Resource, Int)] -> Stage -> Rules ()
registerPackageRules rs stage = do
    root <- buildRootRules

    -- Initialise the package database.
    root -/- relativePackageDbPath stage -/- packageDbStamp %> \stamp ->
        writeFileLines stamp []

    -- Register a package.
    root -/- relativePackageDbPath stage -/- "*.conf" %> \conf -> do
        historyDisable
        let libpath = takeDirectory (takeDirectory conf)
            settings = libpath -/- "settings"
            platformConstants = libpath -/- "platformConstants"

        need [settings, platformConstants]

        pkgName <- getPackageNameFromConfFile conf
        let pkg = unsafeFindPackageByName pkgName
        isBoot <- (pkg `notElem`) <$> stagePackages Stage0

        let ctx = Context stage pkg vanilla
        case stage of
            Stage0 | isBoot -> copyConf  rs ctx conf
            _               -> buildConf rs ctx conf

buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildConf _ context@Context {..} conf = do
    depPkgIds <- cabalDependencies context
    ensureConfigured context
    need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds

    ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty)
    need =<< concatMapM (libraryTargets True) [ context { way = w } | w <- ways ]

    -- We might need some package-db resource to limit read/write, see packageRules.
    path <- buildPath context

    -- Special package cases (these should ideally be rolled into Cabal).
    when (package == rts) $
        -- If Cabal knew about "generated-headers", we could read them from the
        -- 'configuredCabal' information, and just "need" them here.
        need [ path -/- "DerivedConstants.h"
             , path -/- "ghcautoconf.h"
             , path -/- "ghcplatform.h"
             , path -/- "ghcversion.h"
             , path -/- "ffi.h" ]

    when (package == integerGmp) $ need [path -/- gmpLibraryH]

    -- Copy and register the package.
    Cabal.copyPackage context
    Cabal.registerPackage context

    -- The above two steps produce an entry in the package database, with copies
    -- of many of the files we have build, e.g. Haskell interface files. We need
    -- to record this side effect so that Shake can cache these files too.
    -- See why we need 'fixWindows': https://ghc.haskell.org/trac/ghc/ticket/16073
    let fixWindows path = do
            win <- windowsHost
            version  <- setting GhcVersion
            hostOs   <- cabalOsString <$> setting BuildOs
            hostArch <- cabalArchString <$> setting BuildArch
            let dir = hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version
            return $ if win then path -/- "../.." -/- dir else path
    pkgDbPath <- fixWindows =<< packageDbPath stage
    let dir = pkgDbPath -/- takeBaseName conf
    files <- liftIO $ getDirectoryFilesIO "." [dir -/- "**"]
    produces files

copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
copyConf rs context@Context {..} conf = do
    depPkgIds <- fmap stdOutToPkgIds . askWithResources rs $
        target context (GhcPkg Dependencies stage) [pkgName package] []
    need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds
    -- We should unregister if the file exists since @ghc-pkg@ will complain
    -- about existing package: https://github.com/snowleopard/hadrian/issues/543.
    -- Also, we don't always do the unregistration + registration to avoid
    -- repeated work after a full build.
    -- We do not track 'doesFileExist' since we are going to create the file if
    -- it is currently missing. TODO: Is this the right thing to do?
    -- See https://github.com/snowleopard/hadrian/issues/569.
    unlessM (liftIO $ IO.doesFileExist conf) $ do
        buildWithResources rs $
            target context (GhcPkg Unregister stage) [pkgName package] []
        buildWithResources rs $
            target context (GhcPkg Copy stage) [pkgName package] [conf]
  where
    stdOutToPkgIds :: String -> [String]
    stdOutToPkgIds = drop 1 . concatMap words . lines

getPackageNameFromConfFile :: FilePath -> Action String
getPackageNameFromConfFile conf
    | takeBaseName conf == "rts" = return "rts"
    | otherwise = case parseCabalName (takeBaseName conf) of
        Left err -> error $ "getPackageNameFromConfFile: Couldn't parse " ++
                            takeBaseName conf ++ ": " ++ err
        Right (name, _) -> return name

parseCabalName :: String -> Either String (String, Version)
parseCabalName = fmap f . Cabal.eitherParsec
  where
    f :: Cabal.PackageId -> (String, Version)
    f pkg_id = (Cabal.unPackageName $ Cabal.pkgName pkg_id, Cabal.pkgVersion pkg_id)


{-# OPTIONS_GHC -fno-warn-orphans #-}
module Rules.Selftest (selftestRules) where

import Hadrian.Haskell.Cabal
import Test.QuickCheck

import Base
import Context
import Oracles.ModuleFiles
import Oracles.Setting
import Packages
import Settings
import Target
import Utilities

import qualified System.FilePath.Posix as Posix ((</>))

instance Arbitrary Way where
    arbitrary = wayFromUnits <$> arbitrary

instance Arbitrary WayUnit where
    arbitrary = arbitraryBoundedEnum

test :: Testable a => a -> Action ()
test = liftIO . quickCheck

selftestRules :: Rules ()
selftestRules =
    "selftest" ~> do
        testBuilder
        testChunksOfSize
        testDependencies
        testLookupAll
        testModuleName
        testPackages
        testPaths
        testWay

testBuilder :: Action ()
testBuilder = do
    putBuild "==== trackArgument"
    let make = target undefined (Make undefined) undefined undefined
    test $ forAll (elements ["-j", "MAKEFLAGS=-j", "THREADS="])
         $ \prefix (NonNegative n) ->
            not (trackArgument make prefix) &&
            not (trackArgument make ("-j" ++ show (n :: Int)))

testChunksOfSize :: Action ()
testChunksOfSize = do
    putBuild "==== chunksOfSize"
    test $ chunksOfSize 3 [  "a", "b", "c" ,  "defg" ,  "hi" ,  "jk"  ]
                       == [ ["a", "b", "c"], ["defg"], ["hi"], ["jk"] ]
    test $ \n xs ->
        let res = chunksOfSize n xs
        in concat res == xs && all (\r -> length r == 1 || length (concat r) <= n) res

testDependencies :: Action ()
testDependencies = do
    putBuild "==== pkgDependencies"
    let pkgs = ghcPackages \\ [libffi] -- @libffi@ does not have a Cabal file.
    depLists <- mapM pkgDependencies pkgs
    test $ and [ deps == sort deps | deps <- depLists ]
    putBuild "==== Dependencies of the 'ghc-bin' binary"
    ghcDeps <- pkgDependencies ghc
    test $ pkgName compiler `elem` ghcDeps
    stage0Deps <- contextDependencies (vanillaContext Stage0 ghc)
    stage1Deps <- contextDependencies (vanillaContext Stage1 ghc)
    stage2Deps <- contextDependencies (vanillaContext Stage2 ghc)
    test $ vanillaContext Stage0 compiler `notElem` stage1Deps
    test $ vanillaContext Stage1 compiler `elem`    stage1Deps
    test $ vanillaContext Stage2 compiler `notElem` stage1Deps
    test $ stage1Deps /= stage0Deps
    test $ stage1Deps == stage2Deps

testLookupAll :: Action ()
testLookupAll = do
    putBuild "==== lookupAll"
    test $ lookupAll ["b"    , "c"            ] [("a", 1), ("c", 3), ("d", 4)]
                  == [Nothing, Just (3 :: Int)]
    test $ forAll dicts $ \dict -> forAll extras $ \extra ->
        let items = sort $ map fst dict ++ extra
        in lookupAll items (sort dict) == map (`lookup` dict) items
  where
    dicts :: Gen [(Int, Int)]
    dicts = nubBy (\x y -> fst x == fst y) <$> vector 20
    extras :: Gen [Int]
    extras = vector 20

testModuleName :: Action ()
testModuleName = do
    putBuild "==== Encode/decode module name"
    test $ encodeModule "Data/Functor" "Identity.hs" == "Data.Functor.Identity"
    test $ encodeModule "" "Prelude"                 == "Prelude"

    test $ decodeModule "Data.Functor.Identity" == ("Data/Functor", "Identity")
    test $ decodeModule "Prelude"               == ("", "Prelude")

    test $ forAll names $ \n -> uncurry encodeModule (decodeModule n) == n
  where
    names = intercalate "." <$> listOf1 (listOf1 $ elements "abcABC123_'")

testPackages :: Action ()
testPackages = do
    putBuild "==== Check system configuration"
    win <- windowsHost -- This depends on the @boot@ and @configure@ scripts.
    putBuild "==== Packages, interpretInContext, configuration flags"
    forM_ [Stage0 ..] $ \stage -> do
        pkgs <- stagePackages stage
        when (win32 `elem` pkgs) . test $ win
        when (unix  `elem` pkgs) . test $ not win
        test $ pkgs == nubOrd pkgs

testWay :: Action ()
testWay = do
    putBuild "==== Read Way, Show Way"
    test $ \(x :: Way) -> read (show x) == x

testPaths :: Action ()
testPaths = do
    putBuild "==== Absolute, Relative Path Concatenation"
    test $ forAll paths $ \(path1, path2) ->
      path1 -/- path2 == path1 Posix.</> path2
  where
    paths = (,) <$> path <*> path
    path = frequency [(1, relativePath), (1, absolutePath)]
    relativePath = intercalate "/" <$> listOf1 (elements ["a"])
    absolutePath = ('/':) <$> relativePath


module Rules.SimpleTargets (simplePackageTargets) where

import Base
import Context
import Packages
import Settings

import Data.Foldable

-- | Simple aliases for library and executable targets.
--
--  - @stage<N>:lib:<name>@ will build library @name@ with
--    the stage N compiler, putting the result under
--    @<build root>/stage<N>/lib@.
--  - @stage<N>:exe:<name>@ will build executable @name@
--    with the stage N-1 compiler, putting the result under
--    @<build root>/stage<N-1>/bin.
simplePackageTargets :: Rules ()
simplePackageTargets = traverse_ simpleTarget targets

  where targets = [ (stage, target)
                  | stage <- [minBound..maxBound]
                  , target <- knownPackages
                  ]

simpleTarget :: (Stage, Package) -> Rules ()
simpleTarget (stage, target) = do
  let tgt = intercalate ":" [stagestr, typ, pkgname]
  tgt ~> do
    p <- getTargetPath stage target
    need [ p ]

  where typ = if isLibrary target then "lib" else "exe"
        stagestr = stageString stage
        pkgname = pkgName target

getTargetPath :: Stage -> Package -> Action FilePath
getTargetPath stage pkg
  | isLibrary pkg = getLibraryPath stage pkg
  | otherwise     = getProgramPath stage pkg

getLibraryPath :: Stage -> Package -> Action FilePath
getLibraryPath stage pkg = pkgConfFile (vanillaContext stage pkg)

getProgramPath :: Stage -> Package -> Action FilePath
getProgramPath Stage0 _ =
  error ("Cannot build a stage 0 executable target: " ++
         "it is the boot compiler's toolchain")
getProgramPath stage pkg = programPath (vanillaContext (pred stage) pkg)


module Rules.SourceDist (sourceDistRules) where

import Hadrian.Oracles.DirectoryContents

import Base
import Builder
import Oracles.Setting
import Rules.Clean

sourceDistRules :: Rules ()
sourceDistRules = do
    "source-dist" ~> do
        -- We clean the source tree first.
        -- See https://github.com/snowleopard/hadrian/issues/384.
        -- TODO: Do we still need to clean the tree?
        cleanSourceTree
        version <- setting ProjectVersion
        need ["sdistprep/ghc-" ++ version ++ "-src.tar.xz"]
        putSuccess "| Done"
    "sdistprep/ghc-*-src.tar.xz" %> \fname -> do
        let tarName   = takeFileName fname
            dropTarXz = dropExtension . dropExtension
            treePath  = "sdistprep/ghc" -/- dropTarXz tarName
        prepareTree treePath
        runBuilderWithCmdOptions [Cwd "sdistprep/ghc"] (Tar Create)
            ["cJf", ".." -/- tarName,  dropTarXz tarName]
            ["cJf", ".." -/- tarName] [dropTarXz tarName]
    "GIT_COMMIT_ID" %> \fname ->
        writeFileChanged fname =<< setting ProjectGitCommitId
    "VERSION" %> \fname ->
        writeFileChanged fname =<< setting ProjectVersion

prepareTree :: FilePath -> Action ()
prepareTree dest = do
    mapM_ cpDir  srcDirs
    mapM_ cpFile srcFiles
  where
    cpFile a = copyFile a (dest -/- a)
    cpDir  a = copyDirectoryContents (Not excluded) a (dest -/- a)
    excluded = Or
        [ Test "//.*"
        , Test "//#*"
        , Test "//*-SAVE"
        , Test "//*.orig"
        , Test "//*.rej"
        , Test "//*~"
        , Test "//autom4te*"
        , Test "//dist"
        , Test "//dist-install"
        , Test "//log"
        , Test "//stage0"
        , Test "//stage1"
        , Test "//stage2"
        , Test "//stage3"
        , Test "hadrian/.cabal-sandbox"
        , Test "hadrian/.stack-work"
        , Test "hadrian/UserSettings.hs"
        , Test "hadrian/cabal.sandbox.config"
        , Test "hadrian/cfg/system.config"
        , Test "hadrian/bin"
        , Test "hadrian/dist"
        , Test "hadrian/dist-newstyle"
        , Test "libraries//*.buildinfo"
        , Test "libraries//GNUmakefile"
        , Test "libraries//config.log"
        , Test "libraries//config.status"
        , Test "libraries//configure"
        , Test "libraries//ghc.mk"
        , Test "libraries//include/Hs*Config.h"
        , Test "libraries/dph"
        , Test "libraries/primitive"
        , Test "libraries/random"
        , Test "libraries/stm"
        , Test "libraries/vector"
        , Test "mk/build.mk" ]
    srcDirs =
        [ "bindisttest"
        , "compiler"
        , "distrib"
        , "docs"
        , "docs"
        , "driver"
        , "ghc"
        , "hadrian"
        , "includes"
        , "iserv"
        , "libffi"
        , "libffi-tarballs"
        , "libraries"
        , "mk"
        , "rts"
        , "rules"
        , "utils" ]
    srcFiles =
        [ "ANNOUNCE"
        , "GIT_COMMIT_ID"
        , "HACKING.md"
        , "INSTALL.md"
        , "LICENSE"
        , "MAKEHELP.md"
        , "Makefile"
        , "README.md"
        , "VERSION"
        , "aclocal.m4"
        , "boot"
        , "config.guess"
        , "config.sub"
        , "configure"
        , "configure.ac"
        , "ghc.mk"
        , "install-sh"
        , "packages"
        , "settings.in" ]


module Rules.Test (testRules) where

import System.Environment

import Base
import Expression
import Oracles.Setting
import Packages
import Settings
import Settings.Default
import Settings.Builders.RunTest
import Target
import Utilities

ghcConfigHsPath :: FilePath
ghcConfigHsPath = "testsuite/mk/ghc-config.hs"

ghcConfigProgPath :: FilePath
ghcConfigProgPath = "test/bin/ghc-config"

ghcConfigPath :: FilePath
ghcConfigPath = "test/ghcconfig"

-- TODO: clean up after testing
testRules :: Rules ()
testRules = do
    root <- buildRootRules

    -- Using program shipped with testsuite to generate ghcconfig file.
    root -/- ghcConfigProgPath ~> do
        ghc <- builderPath $ Ghc CompileHs Stage0
        createDirectory $ takeDirectory (root -/- ghcConfigProgPath)
        cmd ghc [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath]

    -- TODO : Use input test compiler and not just stage2 compiler.
    root -/- ghcConfigPath ~> do
        ghcPath <- needFile Stage1 ghc
        need [root -/- ghcConfigProgPath]
        cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath)
            [ghcPath]

    root -/- timeoutPath ~> timeoutProgBuilder

    "validate" ~> do
        needTestBuilders
        build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []

    "test" ~> do
        needTestBuilders

        -- TODO : Should we remove the previosly generated config file?
        -- Prepare Ghc configuration file for input compiler.
        need [root -/- ghcConfigPath, root -/- timeoutPath]

        -- TODO This approach doesn't work.
        -- Set environment variables for test's Makefile.
        env <- sequence
            [ builderEnvironment "MAKE" $ Make ""
            , builderEnvironment "TEST_HC" $ Ghc CompileHs Stage2
            , AddEnv "TEST_HC_OPTS" <$> runTestGhcFlags ]

        makePath        <- builderPath $ Make ""
        top             <- topDirectory
        ghcPath         <- (top -/-) <$> builderPath (Ghc CompileHs Stage2)
        ghcFlags        <- runTestGhcFlags
        checkPprPath    <- (top -/-) <$> needFile Stage1 checkPpr
        annotationsPath <- (top -/-) <$> needFile Stage1 checkApiAnnotations

        -- Set environment variables for test's Makefile.
        liftIO $ do
            setEnv "MAKE" makePath
            setEnv "TEST_HC" ghcPath
            setEnv "TEST_HC_OPTS" ghcFlags
            setEnv "CHECK_PPR" checkPprPath
            setEnv "CHECK_API_ANNOTATIONS" annotationsPath

        -- Execute the test target.
        -- We override the verbosity setting to make sure the user can see
        -- the test output: https://ghc.haskell.org/trac/ghc/ticket/15951.
        withVerbosity Loud $ buildWithCmdOptions env $
            target (vanillaContext Stage2 compiler) RunTest [] []

-- | Build extra programs and libraries required by testsuite
needTestsuitePackages :: Action ()
needTestsuitePackages = do
    targets   <- mapM (needFile Stage1) =<< testsuitePackages
    -- iserv is not supported under Windows
    windows <- windowsHost
    when (not windows) needIservBins
    need targets

-- | Build the timeout program.
-- See: https://github.com/ghc/ghc/blob/master/testsuite/timeout/Makefile#L23
timeoutProgBuilder :: Action ()
timeoutProgBuilder = do
    root    <- buildRoot
    windows <- windowsHost
    if windows
        then do
            prog <- programPath =<< programContext Stage1 timeout
            copyFile prog (root -/- timeoutPath)
        else do
            python <- builderPath Python
            copyFile "testsuite/timeout/timeout.py" (root -/- timeoutPath <.> "py")
            let script = unlines
                    [ "#!/usr/bin/env sh"
                    , "exec " ++ python ++ " $0.py \"$@\"" ]
            writeFile' (root -/- timeoutPath) script
            makeExecutable (root -/- timeoutPath)

needIservBins :: Action ()
needIservBins = do
    rtsways <- interpretInContext (vanillaContext Stage1 ghc) getRtsWays
    need =<< traverse programPath
               [ Context Stage1 iserv w
               | w <- [vanilla, profiling, dynamic]
               , w `elem` rtsways
               ]

needTestBuilders :: Action ()
needTestBuilders = do
    needBuilder $ Ghc CompileHs Stage2
    needBuilder $ GhcPkg Update Stage1
    needBuilder Hpc
    needBuilder $ Hsc2Hs Stage1
    needTestsuitePackages

needFile :: Stage -> Package -> Action FilePath
needFile stage pkg
-- TODO (Alp): we might sometimes need more than vanilla!
-- This should therefore depend on what test ways
-- we are going to use, I suppose?
    | isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic)
    | otherwise     = programPath =<< programContext stage pkg


module Settings.Default (
    -- * Packages that are build by default and for the testsuite
    defaultPackages, testsuitePackages,

    -- * Default build ways
    defaultLibraryWays, defaultRtsWays,

    -- * Default command line arguments for various builders
    SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs,
    defaultArgs,

    -- * Default build flavour
    defaultFlavour
    ) where

import qualified Hadrian.Builder.Ar
import qualified Hadrian.Builder.Sphinx
import qualified Hadrian.Builder.Tar
import Hadrian.Haskell.Cabal.Type

import CommandLine
import Expression
import Flavour
import Oracles.Flag
import Oracles.Setting
import Packages
import Settings
import Settings.Builders.Alex
import Settings.Builders.DeriveConstants
import Settings.Builders.Cabal
import Settings.Builders.Cc
import Settings.Builders.Configure
import Settings.Builders.GenPrimopCode
import Settings.Builders.Ghc
import Settings.Builders.GhcPkg
import Settings.Builders.Haddock
import Settings.Builders.Happy
import Settings.Builders.Hsc2Hs
import Settings.Builders.HsCpp
import Settings.Builders.Ld
import Settings.Builders.Make
import Settings.Builders.RunTest
import Settings.Builders.Xelatex
import Settings.Packages
import Settings.Warnings

-- | Packages that are built by default. You can change this in "UserSettings".
defaultPackages :: Stage -> Action [Package]
defaultPackages Stage0 = stage0Packages
defaultPackages Stage1 = stage1Packages
defaultPackages Stage2 = stage2Packages
defaultPackages Stage3 = return []

-- | Packages built in 'Stage0' by default. You can change this in "UserSettings".
stage0Packages :: Action [Package]
stage0Packages = do
    win <- windowsHost
    cross <- flag CrossCompiling
    return $ [ binary
             , cabal
             , compareSizes
             , compiler
             , deriveConstants
             , genapply
             , genprimopcode
             , ghc
             , ghcBoot
             , ghcBootTh
             , ghcHeap
             , ghci
             , ghcPkg
             , hsc2hs
             , hpc
             , mtl
             , parsec
             , templateHaskell
             , text
             , transformers
             , unlit                         ]
          ++ [ terminfo | not win, not cross ]
          ++ [ touchy   | win                ]

-- | Packages built in 'Stage1' by default. You can change this in "UserSettings".
stage1Packages :: Action [Package]
stage1Packages = do
    win        <- windowsHost
    intLib     <- integerLibrary =<< flavour
    libraries0 <- filter isLibrary <$> stage0Packages
    cross      <- flag CrossCompiling
    return $ libraries0 -- Build all Stage0 libraries in Stage1
          ++ [ array
             , base
             , bytestring
             , containers
             , deepseq
             , directory
             , filepath
             , ghc
             , ghcCompact
             , ghcPkg
             , ghcPrim
             , haskeline
             , hsc2hs
             , intLib
             , pretty
             , process
             , rts
             , stm
             , time
             , unlit
             , xhtml
             ]
          ++ [ haddock | not cross           ]
          ++ [ hpcBin   | not cross          ]
          ++ [ iserv    | not win, not cross ]
          ++ [ libiserv | not win, not cross ]
          ++ [ runGhc   | not cross          ]
          ++ [ touchy   | win                ]
          ++ [ unix     | not win            ]
          ++ [ win32    | win                ]

-- | Packages built in 'Stage2' by default. You can change this in "UserSettings".
stage2Packages :: Action [Package]
stage2Packages = stage1Packages

-- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package]
testsuitePackages = do
    win <- windowsHost
    return $ [ checkApiAnnotations
             , checkPpr
             , ghci
             , ghcCompact
             , ghcPkg
             , hp2ps
             , hsc2hs
             , iserv
             , runGhc
             , unlit         ] ++
             [ timeout | win ]

-- | Default build ways for library packages:
-- * We always build 'vanilla' way.
-- * We build 'profiling' way when stage > Stage0.
-- * We build 'dynamic' way when stage > Stage0 and the platform supports it.
defaultLibraryWays :: Ways
defaultLibraryWays = mconcat
    [ pure [vanilla]
    , notStage0 ? pure [profiling]
    , notStage0 ? platformSupportsSharedLibs ? pure [dynamic]
    ]

-- | Default build ways for the RTS.
defaultRtsWays :: Ways
defaultRtsWays = mconcat
  [ pure [vanilla, threaded]
  , notStage0 ? pure
      [ profiling, threadedProfiling, debugProfiling, threadedDebugProfiling
      , logging, threadedLogging
      , debug, threadedDebug
      ]
  , notStage0 ? platformSupportsSharedLibs ? pure
      [ dynamic, threadedDynamic, debugDynamic, loggingDynamic
      , threadedDebugDynamic, threadedLoggingDynamic
      ]
  ]

-- TODO: Move C source arguments here
-- | Default and package-specific source arguments.
data SourceArgs = SourceArgs
    { hsDefault  :: Args
    , hsLibrary  :: Args
    , hsCompiler :: Args
    , hsGhc      :: Args }

-- | Concatenate source arguments in appropriate order.
sourceArgs :: SourceArgs -> Args
sourceArgs SourceArgs {..} = builder Ghc ? mconcat
    [ hsDefault
    , getContextData hcOpts
    , libraryPackage   ? hsLibrary
    , package compiler ? hsCompiler
    , package ghc      ? hsGhc ]

-- | All default command line arguments.
defaultArgs :: Args
defaultArgs = mconcat
    [ defaultBuilderArgs
    , sourceArgs defaultSourceArgs
    , defaultPackageArgs ]

-- | Default source arguments, e.g. optimisation settings.
defaultSourceArgs :: SourceArgs
defaultSourceArgs = SourceArgs
    { hsDefault  = mconcat [ stage0    ? arg "-O"
                           , notStage0 ? arg "-O2"
                           , arg "-H32m" ]
    , hsLibrary  = mempty
    , hsCompiler = mempty
    , hsGhc      = mempty }

-- Please update doc/flavours.md when changing the default build flavour.
-- | Default build flavour. Other build flavours are defined in modules
-- @Settings.Flavours.*@. Users can add new build flavours in "UserSettings".
defaultFlavour :: Flavour
defaultFlavour = Flavour
    { name               = "default"
    , args               = defaultArgs
    , packages           = defaultPackages
    , integerLibrary     = (\x -> if x then integerSimple else integerGmp) <$> cmdIntegerSimple
    , libraryWays        = defaultLibraryWays
    , rtsWays            = defaultRtsWays
    , dynamicGhcPrograms = defaultDynamicGhcPrograms
    , ghciWithDebugger   = False
    , ghcProfiled        = False
    , ghcDebugged        = False
    , ghcDocs            = cmdDocsArgs }

-- | Default logic for determining whether to build
--   dynamic GHC programs.
--
--   It corresponds to the DYNAMIC_GHC_PROGRAMS logic implemented
--   in @mk/config.mk.in@.
defaultDynamicGhcPrograms :: Action Bool
defaultDynamicGhcPrograms = do
  win <- windowsHost
  supportsShared <- platformSupportsSharedLibs
  return (not win && supportsShared)

-- | All 'Builder'-dependent command line arguments.
defaultBuilderArgs :: Args
defaultBuilderArgs = mconcat
    -- GHC-specific builders:
    [ alexBuilderArgs
    , cabalBuilderArgs
    , ccBuilderArgs
    , configureBuilderArgs
    , deriveConstantsBuilderArgs
    , genPrimopCodeBuilderArgs
    , ghcBuilderArgs
    , ghcPkgBuilderArgs
    , haddockBuilderArgs
    , happyBuilderArgs
    , hsc2hsBuilderArgs
    , hsCppBuilderArgs
    , ldBuilderArgs
    , makeBuilderArgs
    , runTestBuilderArgs
    , validateBuilderArgs
    , xelatexBuilderArgs
    -- Generic builders from the Hadrian library:
    , builder (Ar Pack     ) ? Hadrian.Builder.Ar.args Pack
    , builder (Ar Unpack   ) ? Hadrian.Builder.Ar.args Unpack
    , builder (Sphinx Html ) ? Hadrian.Builder.Sphinx.args Html
    , builder (Sphinx Latex) ? Hadrian.Builder.Sphinx.args Latex
    , builder (Sphinx Man  ) ? Hadrian.Builder.Sphinx.args Man
    , builder (Tar Create  ) ? Hadrian.Builder.Tar.args Create
    , builder (Tar Extract ) ? Hadrian.Builder.Tar.args Extract ]

-- | All 'Package'-dependent command line arguments.
defaultPackageArgs :: Args
defaultPackageArgs = mconcat [ packageArgs
                             , builder Ghc ? ghcWarningsArgs ]


module Settings.Packages (packageArgs) where

import Expression
import Flavour
import Oracles.Setting
import Oracles.Flag
import Packages
import Rules.Gmp
import Settings

-- | Package-specific command-line arguments.
packageArgs :: Args
packageArgs = do
    stage        <- getStage
    rtsWays      <- getRtsWays
    path         <- getBuildPath
    intLib       <- getIntegerPackage
    compilerPath <- expr $ buildPath (vanillaContext stage compiler)
    gmpBuildPath <- expr gmpBuildPath
    let includeGmp = "-I" ++ gmpBuildPath -/- "include"

    mconcat
        --------------------------------- base ---------------------------------
        [ package base ? mconcat
          [ builder (Cabal Flags) ? notStage0 ? arg (pkgName intLib)

          -- This fixes the 'unknown symbol stat' issue.
          -- See: https://github.com/snowleopard/hadrian/issues/259.
          , builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ]

        ------------------------------ bytestring ------------------------------
        , package bytestring ?
          builder (Cabal Flags) ? intLib == integerSimple ? arg "integer-simple"

        --------------------------------- cabal --------------------------------
        -- Cabal is a large library and slow to compile. Moreover, we build it
        -- for Stage0 only so we can link ghc-pkg against it, so there is little
        -- reason to spend the effort to optimise it.
        , package cabal ?
          stage0 ? builder Ghc ? arg "-O0"

        ------------------------------- compiler -------------------------------
        , package compiler ? mconcat
          [ builder Alex ? arg "--latin1"

          , builder (Ghc CompileHs) ? mconcat
            [ inputs ["//GHC.hs", "//GhcMake.hs"] ? arg "-fprof-auto"
            , input "//Parser.hs" ?
              pure ["-fno-ignore-interface-pragmas", "-fcmm-sink" ] ]

          , builder (Cabal Setup) ? mconcat
            [ arg $ "--ghc-option=-DSTAGE=" ++ show (fromEnum stage + 1)
            , arg "--disable-library-for-ghci"
            , anyTargetOs ["openbsd"] ? arg "--ld-options=-E"
            , flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS"
            , notM ghcWithSMP ? arg "--ghc-option=-DNOSMP"
            , notM ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP"
            , (any (wayUnit Threaded) rtsWays) ?
              notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS"
            , ghcWithInterpreter ?
              ghcEnableTablesNextToCode ?
              notM (flag GhcUnregisterised) ?
              notStage0 ? arg "--ghc-option=-DGHCI_TABLES_NEXT_TO_CODE"
            , ghcWithInterpreter ?
              ghciWithDebugger <$> flavour ?
              notStage0 ? arg "--ghc-option=-DDEBUGGER"
            , ghcProfiled <$> flavour ?
              notStage0 ? arg "--ghc-pkg-option=--force" ]

         , builder (Cabal Flags) ? mconcat
            [ ghcWithNativeCodeGen ? arg "ncg"
            , ghcWithInterpreter ? notStage0 ? arg "ghci"
            , flag CrossCompiling ? arg "-terminfo"
            , notStage0 ? intLib == integerGmp ?
              arg "integer-gmp"
            , notStage0 ? intLib == integerSimple ?
              arg "integer-simple" ]

          , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ]

        ---------------------------------- ghc ---------------------------------
        , package ghc ? mconcat
          [ builder Ghc ? arg ("-I" ++ compilerPath)

          , builder (Cabal Flags) ? mconcat
            [ ghcWithInterpreter ? notStage0 ? arg "ghci"
            , flag CrossCompiling ? arg "-terminfo"
            -- the 'threaded' flag is True by default, but
            -- let's record explicitly that we link all ghc
            -- executables with the threaded runtime.
            , arg "threaded" ] ]

        -------------------------------- ghcPkg --------------------------------
        , package ghcPkg ?
          builder (Cabal Flags) ? flag CrossCompiling ? arg "-terminfo"

        -------------------------------- ghcPrim -------------------------------
        , package ghcPrim ? mconcat
          [ builder (Cabal Flags) ? arg "include-ghc-prim"

          , builder (Cc CompileC) ? (not <$> flag GccIsClang) ?
            input "//cbits/atomic.c"  ? arg "-Wno-sync-nand" ]

        --------------------------------- ghci ---------------------------------
        -- TODO: This should not be @not <$> flag CrossCompiling@. Instead we
        -- should ensure that the bootstrap compiler has the same version as the
        -- one we are building.

        -- TODO: In that case we also do not need to build most of the Stage1
        -- libraries, as we already know that the compiler comes with the most
        -- recent versions.

        -- TODO: The use case here is that we want to build @ghc-proxy@ for the
        -- cross compiler. That one needs to be compiled by the bootstrap
        -- compiler as it needs to run on the host. Hence @libiserv@ needs
        -- @GHCi.TH@, @GHCi.Message@ and @GHCi.Run@ from @ghci@. And those are
        -- behind the @-fghci@ flag.
        , package ghci ? mconcat
          [ notStage0 ? builder (Cabal Flags) ? arg "ghci"
          , flag CrossCompiling ? stage0 ? builder (Cabal Flags) ? arg "ghci" ]

        -------------------------------- haddock -------------------------------
        , package haddock ?
          builder (Cabal Flags) ? arg "in-ghc-tree"

        ------------------------------- haskeline ------------------------------
        , package haskeline ?
          builder (Cabal Flags) ? flag CrossCompiling ? arg "-terminfo"

        -------------------------------- hsc2hs --------------------------------
        , package hsc2hs ?
          builder (Cabal Flags) ? arg "in-ghc-tree"

        ------------------------------ integerGmp ------------------------------
        , package integerGmp ? mconcat
          [ builder Cc ? arg includeGmp

          , builder (Cabal Setup) ? mconcat
            [ flag GmpInTree ? arg "--configure-option=--with-intree-gmp"
            -- Windows is always built with inplace GMP until we have dynamic
            -- linking working.
            , windowsHost  ? arg "--configure-option=--with-intree-gmp"
            , flag GmpFrameworkPref ?
              arg "--configure-option=--with-gmp-framework-preferred"
            , arg ("--configure-option=CFLAGS=" ++ includeGmp)
            , arg ("--gcc-options="             ++ includeGmp) ] ]

        ---------------------------------- rts ---------------------------------
        , package rts ? rtsPackageArgs -- RTS deserves a separate function

        -------------------------------- runGhc --------------------------------
        , package runGhc ?
          builder Ghc ? input "//Main.hs" ?
          (\version -> ["-cpp", "-DVERSION=" ++ show version]) <$> getSetting ProjectVersion

        --------------------------------- text ---------------------------------
        -- The package @text@ is rather tricky. It's a boot library, and it
        -- tries to determine on its own if it should link against @integer-gmp@
        -- or @integer-simple@. For Stage0, we need to use the integer library
        -- that the bootstrap compiler has (since @interger@ is not a boot
        -- library) and therefore we copy it over into the Stage0 package-db.
        -- Maybe we should stop doing this? And subsequently @text@ for Stage1
        -- detects the same integer library again, even though we don't build it
        -- in Stage1, and at that point the configuration is just wrong.
        , package text ?
          builder (Cabal Flags) ? notStage0 ? intLib == integerSimple ?
          pure [ "+integer-simple", "-bytestring-builder"] ]

-- | RTS-specific command line arguments.
rtsPackageArgs :: Args
rtsPackageArgs = package rts ? do
    projectVersion <- getSetting ProjectVersion
    hostPlatform   <- getSetting HostPlatform
    hostArch       <- getSetting HostArch
    hostOs         <- getSetting HostOs
    hostVendor     <- getSetting HostVendor
    buildPlatform  <- getSetting BuildPlatform
    buildArch      <- getSetting BuildArch
    buildOs        <- getSetting BuildOs
    buildVendor    <- getSetting BuildVendor
    targetPlatform <- getSetting TargetPlatform
    targetArch     <- getSetting TargetArch
    targetOs       <- getSetting TargetOs
    targetVendor   <- getSetting TargetVendor
    ghcUnreg       <- expr $ yesNo <$> flag GhcUnregisterised
    ghcEnableTNC   <- expr $ yesNo <$> ghcEnableTablesNextToCode
    rtsWays        <- getRtsWays
    way            <- getWay
    path           <- getBuildPath
    top            <- expr topDirectory
    libffiName     <- expr libffiLibraryName
    ffiIncludeDir  <- getSetting FfiIncludeDir
    ffiLibraryDir  <- getSetting FfiLibDir
    let cArgs = mconcat
          [ arg "-Irts"
          , rtsWarnings
          , arg $ "-I" ++ path
          , flag UseSystemFfi ? arg ("-I" ++ ffiIncludeDir)
          , arg $ "-DRtsWay=\"rts_" ++ show way ++ "\""
          -- Set the namespace for the rts fs functions
          , arg $ "-DFS_NAMESPACE=rts"
          , arg $ "-DCOMPILING_RTS"
          -- RTS *must* be compiled with optimisations. The INLINE_HEADER macro
          -- requires that functions are inlined to work as expected. Inlining
          -- only happens for optimised builds. Otherwise we can assume that
          -- there is a non-inlined variant to use instead. But RTS does not
          -- provide non-inlined alternatives and hence needs the function to
          -- be inlined. See https://github.com/snowleopard/hadrian/issues/90.
          , arg "-O2"
          , arg "-fomit-frame-pointer"
          , arg "-g"

          , Debug     `wayUnit` way          ? pure [ "-DDEBUG"
                                                    , "-fno-omit-frame-pointer"
                                                    , "-g" ]
          , way `elem` [debug, debugDynamic] ? arg "-DTICKY_TICKY"
          , Profiling `wayUnit` way          ? arg "-DPROFILING"
          , Threaded  `wayUnit` way          ? arg "-DTHREADED_RTS"

          , inputs ["//RtsMessages.c", "//Trace.c"] ?
            arg ("-DProjectVersion=" ++ show projectVersion)

          , input "//RtsUtils.c" ? pure
            [ "-DProjectVersion="            ++ show projectVersion
            , "-DHostPlatform="              ++ show hostPlatform
            , "-DHostArch="                  ++ show hostArch
            , "-DHostOS="                    ++ show hostOs
            , "-DHostVendor="                ++ show hostVendor
            , "-DBuildPlatform="             ++ show buildPlatform
            , "-DBuildArch="                 ++ show buildArch
            , "-DBuildOS="                   ++ show buildOs
            , "-DBuildVendor="               ++ show buildVendor
            , "-DTargetPlatform="            ++ show targetPlatform
            , "-DTargetArch="                ++ show targetArch
            , "-DTargetOS="                  ++ show targetOs
            , "-DTargetVendor="              ++ show targetVendor
            , "-DGhcUnregisterised="         ++ show ghcUnreg
            , "-DGhcEnableTablesNextToCode=" ++ show ghcEnableTNC ]

          -- We're after pur performance here. So make sure fast math and
          -- vectorization is enabled.
          , input "//xxhash.c" ? pure
            [ "-O3"
            , "-ffast-math"
            , "-ftree-vectorize" ]

            , inputs ["//Evac.c", "//Evac_thr.c"] ? arg "-funroll-loops"

            , speedHack ?
              inputs [ "//Evac.c", "//Evac_thr.c"
                     , "//Scav.c", "//Scav_thr.c"
                     , "//Compact.c", "//GC.c" ] ? arg "-fno-PIC"
            -- @-static@ is necessary for these bits, as otherwise the NCG
            -- generates dynamic references.
            , speedHack ?
              inputs [ "//Updates.c", "//StgMiscClosures.c"
                     , "//PrimOps.c", "//Apply.c"
                     , "//AutoApply.c" ] ? pure ["-fno-PIC", "-static"]

            -- inlining warnings happen in Compact
            , inputs ["//Compact.c"] ? arg "-Wno-inline"

            -- emits warnings about call-clobbered registers on x86_64
            , inputs [ "//RetainerProfile.c", "//StgCRun.c"
                     , "//win32/ConsoleHandler.c", "//win32/ThrIOManager.c"] ? arg "-w"
            -- The above warning suppression flags are a temporary kludge.
            -- While working on this module you are encouraged to remove it and fix
            -- any warnings in the module. See:
            -- http://ghc.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings

            , (not <$> flag GccIsClang) ?
              inputs ["//Compact.c"] ? arg "-finline-limit=2500"

            , input "//RetainerProfile.c" ? flag GccIsClang ?
              arg "-Wno-incompatible-pointer-types"
            , windowsHost ? arg ("-DWINVER=" ++ windowsVersion)

            -- libffi's ffi.h triggers various warnings
            , inputs [ "//Interpreter.c", "//Storage.c", "//Adjustor.c" ] ?
              arg "-Wno-strict-prototypes"
            , inputs ["//Interpreter.c", "//Adjustor.c", "//sm/Storage.c"] ?
              anyTargetArch ["powerpc"] ? arg "-Wno-undef" ]

    mconcat
        [ builder (Cabal Flags) ? mconcat
          [ any (wayUnit Profiling) rtsWays ? arg "profiling"
          , any (wayUnit Debug) rtsWays ? arg "debug"
          , any (wayUnit Logging) rtsWays ? arg "logging"
          , any (wayUnit Dynamic) rtsWays ? arg "dynamic"
          , Debug `wayUnit` way           ? arg "find-ptr"
          ]
        , builder (Cc FindCDependencies) ? cArgs
        , builder (Ghc CompileCWithGhc) ? map ("-optc" ++) <$> cArgs
        , builder Ghc ? arg "-Irts"

          , builder HsCpp ? pure
          [ "-DTOP="             ++ show top
          , "-DFFI_INCLUDE_DIR=" ++ show ffiIncludeDir
          , "-DFFI_LIB_DIR="     ++ show ffiLibraryDir
          , "-DFFI_LIB="         ++ show libffiName ]

        , builder HsCpp ? flag HaveLibMingwEx ? arg "-DHAVE_LIBMINGWEX" ]

-- Compile various performance-critical pieces *without* -fPIC -dynamic
-- even when building a shared library.  If we don't do this, then the
-- GC runs about 50% slower on x86 due to the overheads of PIC.  The
-- cost of doing this is a little runtime linking and less sharing, but
-- not much.
--
-- On x86_64 this doesn't work, because all objects in a shared library
-- must be compiled with -fPIC (since the 32-bit relocations generated
-- by the default small memory can't be resolved at runtime).  So we
-- only do this on i386.
--
-- This apparently doesn't work on OS X (Darwin) nor on Solaris.
-- On Darwin we get errors of the form
--
--  ld: absolute addressing (perhaps -mdynamic-no-pic) used in _stg_ap_0_fast
--      from rts/dist/build/Apply.dyn_o not allowed in slidable image
--
-- and lots of these warnings:
--
--  ld: warning codegen in _stg_ap_pppv_fast (offset 0x0000005E) prevents image
--      from loading in dyld shared cache
--
-- On Solaris we get errors like:
--
-- Text relocation remains                         referenced
--     against symbol                  offset      in file
-- .rodata (section)                   0x11        rts/dist/build/Apply.dyn_o
--   ...
-- ld: fatal: relocations remain against allocatable but non-writable sections
-- collect2: ld returned 1 exit status
speedHack :: Action Bool
speedHack = do
    i386   <- anyTargetArch ["i386"]
    goodOS <- not <$> anyTargetOs ["darwin", "solaris2"]
    return $ i386 && goodOS

-- See @rts/ghc.mk@.
rtsWarnings :: Args
rtsWarnings = mconcat
    [ arg "-Wall"
    , arg "-Wextra"
    , arg "-Wstrict-prototypes"
    , arg "-Wmissing-prototypes"
    , arg "-Wmissing-declarations"
    , arg "-Winline"
    , arg "-Waggregate-return"
    , arg "-Wpointer-arith"
    , arg "-Wmissing-noreturn"
    , arg "-Wnested-externs"
    , arg "-Wredundant-decls"
    , arg "-Wundef"
    , arg "-fno-strict-aliasing" ]

-- These numbers can be found at:
-- https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx
-- If we're compiling on windows, enforce that we only support Vista SP1+
-- Adding this here means it doesn't have to be done in individual .c files
-- and also centralizes the versioning.
-- | Minimum supported Windows version.
windowsVersion :: String
windowsVersion = "0x06000100"


module Settings.Warnings (defaultGhcWarningsArgs, ghcWarningsArgs) where

import Expression
import Oracles.Flag
import Oracles.Setting
import Packages
import Settings

-- See @mk/warnings.mk@ for warning-related arguments in the Make build system.

-- | Default Haskell warning-related arguments.
defaultGhcWarningsArgs :: Args
defaultGhcWarningsArgs = mconcat
    [ notStage0 ? arg "-Wnoncanonical-monad-instances"
    , (not <$> flag GccIsClang) ? mconcat
      [ (not <$> windowsHost ) ? arg "-optc-Werror=unused-but-set-variable"
      , arg "-optc-Wno-error=inline" ]
    , flag GccIsClang ? arg "-optc-Wno-unknown-pragmas" ]

-- | Package-specific warnings-related arguments, mostly suppressing various warnings.
ghcWarningsArgs :: Args
ghcWarningsArgs = do
    isIntegerSimple <- (== integerSimple) <$> getIntegerPackage
    mconcat
        [ stage0 ? mconcat
        [ libraryPackage       ? pure [ "-fno-warn-deprecated-flags" ]
        , package terminfo     ? pure [ "-fno-warn-unused-imports" ]
        , package transformers ? pure [ "-fno-warn-unused-matches"
                                      , "-fno-warn-unused-imports" ] ]
        , notStage0 ? mconcat
        [ libraryPackage       ? pure [ "-Wno-deprecated-flags" ]
        , package base         ? pure [ "-Wno-trustworthy-safe" ]
        , package binary       ? pure [ "-Wno-deprecations" ]
        , package bytestring   ? pure [ "-Wno-inline-rule-shadowing" ]
        , package compiler     ? pure [ "-Wcpp-undef" ]
        , package directory    ? pure [ "-Wno-unused-imports" ]
        , package ghc          ? pure [ "-Wcpp-undef" ]
        , package ghcPrim      ? pure [ "-Wno-trustworthy-safe" ]
        , package haddock      ? pure [ "-Wno-unused-imports"
                                      , "-Wno-deprecations" ]
        , package haskeline    ? pure [ "-Wno-deprecations"
                                      , "-Wno-unused-imports"
                                      , "-Wno-redundant-constraints"
                                      , "-Wno-simplifiable-class-constraints" ]
        , package pretty       ? pure [ "-Wno-unused-imports" ]
        , package primitive    ? pure [ "-Wno-unused-imports"
                                      , "-Wno-deprecations" ]
        , package rts          ? pure [ "-Wcpp-undef" ]
        , package terminfo     ? pure [ "-Wno-unused-imports" ]
        , isIntegerSimple      ?
          package text         ? pure [ "-Wno-unused-imports" ]
        , package transformers ? pure [ "-Wno-unused-matches"
                                      , "-Wno-unused-imports"
                                      , "-Wno-redundant-constraints"
                                      , "-Wno-orphans" ]
        , package win32        ? pure [ "-Wno-trustworthy-safe" ]
        , package xhtml        ? pure [ "-Wno-unused-imports" ] ] ]


module Settings.Builders.Alex (alexBuilderArgs) where

import Settings.Builders.Common

alexBuilderArgs :: Args
alexBuilderArgs = builder Alex ? mconcat [ arg "-g"
                                         , arg =<< getInput
                                         , arg "-o", arg =<< getOutput ]


module Settings.Builders.Cabal (cabalBuilderArgs) where

import Hadrian.Builder (getBuilderPath, needBuilder)
import Hadrian.Haskell.Cabal

import Builder
import Context
import Flavour
import Packages
import Settings.Builders.Common

cabalBuilderArgs :: Args
cabalBuilderArgs = builder (Cabal Setup) ? do
    verbosity <- expr getVerbosity
    top       <- expr topDirectory
    pkg       <- getPackage
    path      <- getContextPath
    stage     <- getStage
    windows   <- expr windowsHost
    let prefix = "${pkgroot}" ++ (if windows then "" else "/..")
    mconcat [ arg "configure"
            -- Don't strip libraries when cross compiling.
            -- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@,
            -- and if it's @:@ disable stripping as well. As it is now, I believe
            -- we might have issues with stripping on Windows, as I can't see a
            -- consumer of 'stripCmdPath'.
            -- TODO: See https://github.com/snowleopard/hadrian/issues/549.
            , flag CrossCompiling ? pure [ "--disable-executable-stripping"
                                         , "--disable-library-stripping" ]
            , arg "--cabal-file"
            , arg $ pkgCabalFile pkg
            , arg "--distdir"
            , arg $ top -/- path
            , arg "--ipid"
            , arg "$pkg-$version"
            , arg "--prefix"
            , arg prefix

            -- NB: this is valid only because Hadrian puts the @docs@ and
            -- @libraries@ folders in the same relative position:
            --
            --   * libraries in @_build/stageN/libraries@
            --   * docs in @_build/docs/html/libraries@
            --
            -- This doesn't hold if we move the @docs@ folder anywhere else.
            , arg "--htmldir"
            , arg $ "${pkgroot}/../../docs/html/libraries/" ++ pkgName pkg

            , withStaged $ Ghc CompileHs
            , withStaged (GhcPkg Update)
            , withBuilderArgs (GhcPkg Update stage)
            , bootPackageDatabaseArgs
            , libraryArgs
            , configureArgs
            , bootPackageConstraints
            , withStaged $ Cc CompileC
            , notStage0 ? with (Ld stage)
            , withStaged (Ar Pack)
            , with Alex
            , with Happy
            , verbosity < Chatty ?
              pure [ "-v0", "--configure-option=--quiet"
                   , "--configure-option=--disable-option-checking" ] ]

-- TODO: Isn't vanilla always built? If yes, some conditions are redundant.
-- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci?
-- TODO: should `elem` be `wayUnit`?
-- This approach still doesn't work. Previously libraries were build only in the
-- Default flavours and not using context.
libraryArgs :: Args
libraryArgs = do
    flavourWays <- getLibraryWays
    contextWay  <- getWay
    package     <- getPackage
    withGhci    <- expr ghcWithInterpreter
    dynPrograms <- expr (flavour >>= dynamicGhcPrograms)
    let ways = flavourWays ++ [contextWay]
        hasVanilla = vanilla `elem` ways
        hasProfiling = any (wayUnit Profiling) ways
        hasDynamic = any (wayUnit Dynamic) ways
    pure [ if hasVanilla
           then  "--enable-library-vanilla"
           else "--disable-library-vanilla"
         , if hasProfiling
           then  "--enable-library-profiling"
           else "--disable-library-profiling"
         , if (hasVanilla || hasProfiling) &&
              package /= rts && withGhci && not dynPrograms
           then  "--enable-library-for-ghci"
           else "--disable-library-for-ghci"
         , if hasDynamic
           then  "--enable-shared"
           else "--disable-shared" ]

-- TODO: LD_OPTS?
configureArgs :: Args
configureArgs = do
    top  <- expr topDirectory
    root <- getBuildRoot
    pkg  <- getPackage
    let conf key expr = do
            values <- unwords <$> expr
            not (null values) ?
                arg ("--configure-option=" ++ key ++ "=" ++ values)
        cFlags   = mconcat [ remove ["-Werror"] cArgs
                           , getStagedSettingList ConfCcArgs
                           , arg $ "-I" ++ top -/- root -/- generatedDir
                           -- See https://github.com/snowleopard/hadrian/issues/523
                           , arg $ "-I" ++ top -/- pkgPath pkg
                           , arg $ "-I" ++ top -/- "includes" ]
        ldFlags  = ldArgs  <> (getStagedSettingList ConfGccLinkerArgs)
        cppFlags = cppArgs <> (getStagedSettingList ConfCppArgs)
    cldFlags <- unwords <$> (cFlags <> ldFlags)
    mconcat
        [ conf "CFLAGS"   cFlags
        , conf "LDFLAGS"  ldFlags
        , conf "CPPFLAGS" cppFlags
        , not (null cldFlags) ? arg ("--gcc-options=" ++ cldFlags)
        , conf "--with-iconv-includes"    $ arg =<< getSetting IconvIncludeDir
        , conf "--with-iconv-libraries"   $ arg =<< getSetting IconvLibDir
        , conf "--with-gmp-includes"      $ arg =<< getSetting GmpIncludeDir
        , conf "--with-gmp-libraries"     $ arg =<< getSetting GmpLibDir
        , conf "--with-curses-libraries"  $ arg =<< getSetting CursesLibDir
        , flag CrossCompiling ? (conf "--host" $ arg =<< getSetting TargetPlatformFull)
        , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage
        , notStage0 ? (arg =<< ("--ghc-option=-ghcversion-file=" ++) <$> expr ((-/-) <$> topDirectory <*> ghcVersionH))]

bootPackageConstraints :: Args
bootPackageConstraints = stage0 ? do
    bootPkgs <- expr $ stagePackages Stage0
    let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
    constraints <- expr $ forM (sort pkgs) $ \pkg -> do
        version <- pkgVersion pkg
        return $ ((pkgName pkg ++ " == ") ++) version
    pure $ concat [ ["--constraint", c] | c <- constraints ]

cppArgs :: Args
cppArgs = do
    root <- getBuildRoot
    arg $ "-I" ++ root -/- generatedDir

withBuilderKey :: Builder -> String
withBuilderKey b = case b of
    Ar _ _     -> "--with-ar="
    Ld _       -> "--with-ld="
    Cc  _ _    -> "--with-gcc="
    Ghc _ _    -> "--with-ghc="
    Alex       -> "--with-alex="
    Happy      -> "--with-happy="
    GhcPkg _ _ -> "--with-ghc-pkg="
    _          -> error $ "withBuilderKey: not supported builder " ++ show b

-- | Add arguments to builders if needed.
withBuilderArgs :: Builder -> Args
withBuilderArgs b = case b of
    GhcPkg _ stage -> do
      top   <- expr topDirectory
      pkgDb <- expr $ packageDbPath stage
      notStage0 ? arg ("--ghc-pkg-option=--global-package-db=" ++ top -/- pkgDb)
    _          -> return [] -- no arguments

-- | Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex.
with :: Builder -> Args
with b = do
    path <- getBuilderPath b
    if null path then mempty else do
        top <- expr topDirectory
        expr $ needBuilder b
        arg  $ withBuilderKey b ++ unifyPath (top </> path)

withStaged :: (Stage -> Builder) -> Args
withStaged sb = with . sb =<< getStage


module Settings.Builders.Cc (ccBuilderArgs) where

import Hadrian.Haskell.Cabal.Type
import Settings.Builders.Common

ccBuilderArgs :: Args
ccBuilderArgs = do
    way <- getWay
    builder Cc ? mconcat
        [ getContextData ccOpts
        , getStagedSettingList ConfCcArgs

        , builder (Cc CompileC) ? mconcat
            [ arg "-Wall"
            , cIncludeArgs
            , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ]
            , arg "-c", arg =<< getInput
            , arg "-o", arg =<< getOutput ]

        , builder (Cc FindCDependencies) ? do
            output <- getOutput
            mconcat [ arg "-E"
                    , arg "-MM", arg "-MG"
                    , arg "-MF", arg output
                    , arg "-MT", arg $ dropExtension output -<.> "o"
                    , cIncludeArgs
                    , arg "-x", arg "c"
                    , arg =<< getInput ] ]


module Settings.Builders.Common (
    module Base,
    module Expression,
    module Oracles.Flag,
    module Oracles.Setting,
    module Settings,
    module UserSettings,
    cIncludeArgs, ldArgs, cArgs, cWarnings,
    packageDatabaseArgs, bootPackageDatabaseArgs
    ) where

import Hadrian.Haskell.Cabal.Type

import Base
import Expression
import Oracles.Flag
import Oracles.Setting
import Packages
import Settings
import UserSettings

cIncludeArgs :: Args
cIncludeArgs = do
    pkg     <- getPackage
    root    <- getBuildRoot
    path    <- getBuildPath
    incDirs <- getContextData includeDirs
    depDirs <- getContextData depIncludeDirs
    iconvIncludeDir <- getSetting IconvIncludeDir
    gmpIncludeDir   <- getSetting GmpIncludeDir
    ffiIncludeDir   <- getSetting FfiIncludeDir
    mconcat [ notStage0 ||^ package compiler ? arg "-Iincludes"
            , arg $ "-I" ++ root -/- generatedDir
            , arg $ "-I" ++ path
            , pure . map ("-I"++) . filter (/= "") $ [iconvIncludeDir, gmpIncludeDir]
            , flag UseSystemFfi ? arg ("-I" ++ ffiIncludeDir)
            -- Add @incDirs@ in the build directory, since some files generated
            -- with @autoconf@ may end up in the build directory.
            , pure [ "-I" ++ path        -/- dir | dir <- incDirs ]
            -- Add @incDirs@ in the package directory for include files shipped
            -- with the package.
            , pure [ "-I" ++ pkgPath pkg -/- dir | dir <- incDirs ]
            , pure [ "-I" ++       unifyPath dir | dir <- depDirs ] ]

ldArgs :: Args
ldArgs = mempty

cArgs :: Args
cArgs = mempty

-- TODO: should be in a different file
cWarnings :: Args
cWarnings = mconcat
    [ arg "-Wall"
    , flag GccIsClang ? arg "-Wno-unknown-pragmas"
    , notM (flag GccIsClang) ? notM windowsHost ? arg "-Werror=unused-but-set-variable"
    , notM (flag GccIsClang) ? arg "-Wno-error=inline" ]

packageDatabaseArgs :: Args
packageDatabaseArgs = do
    stage <- getStage
    dbPath <- expr (packageDbPath stage)
    expr (need [dbPath -/- packageDbStamp])
    prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=")
    arg $ prefix ++ dbPath

bootPackageDatabaseArgs :: Args
bootPackageDatabaseArgs = do
    stage  <- getStage
    dbPath <- expr $ packageDbPath stage
    expr $ need [dbPath -/- packageDbStamp]
    stage0 ? packageDatabaseArgs


module Settings.Builders.Configure (configureBuilderArgs) where

import Packages
import Rules.Gmp
import Settings.Builders.Common

configureBuilderArgs :: Args
configureBuilderArgs = do
    gmpPath    <- expr gmpBuildPath
    stage      <- getStage
    libffiPath <- expr (libffiBuildPath stage)
    mconcat [ builder (Configure gmpPath) ? do
                hostPlatform  <- getSetting HostPlatform
                buildPlatform <- getSetting BuildPlatform
                pure [ "--enable-shared=no"
                     , "--host=" ++ hostPlatform
                     , "--build=" ++ buildPlatform ]

            , builder (Configure libffiPath) ? do
                top            <- expr topDirectory
                targetPlatform <- getSetting TargetPlatform
                way            <- getWay
                pure [ "--prefix=" ++ top -/- libffiPath -/- "inst"
                     , "--libdir=" ++ top -/- libffiPath -/- "inst/lib"
                     , "--enable-static=yes"
                     , "--enable-shared="
                            ++ (if wayUnit Dynamic way
                                    then "yes"
                                    else "no")
                     , "--host=" ++ targetPlatform ] ]


module Settings.Builders.DeriveConstants (deriveConstantsBuilderArgs) where

import Builder
import Settings.Builders.Common

-- TODO: do we need to support `includes_CC_OPTS += -DDYNAMIC_BY_DEFAULT`?
deriveConstantsBuilderArgs :: Args
deriveConstantsBuilderArgs = builder DeriveConstants ? do
    cFlags <- includeCcArgs
    outs   <- getOutputs
    let (outputFile, tempDir) = case outs of
            [a, b] -> (a, b)
            _      -> error $ "DeriveConstants: expected two outputs, got " ++ show outs
    mconcat
        [ output "//DerivedConstants.h"             ? arg "--gen-header"
        , output "//GHCConstantsHaskellType.hs"     ? arg "--gen-haskell-type"
        , output "//platformConstants"              ? arg "--gen-haskell-value"
        , output "//GHCConstantsHaskellWrappers.hs" ? arg "--gen-haskell-wrappers"
        , output "//GHCConstantsHaskellExports.hs"  ? arg "--gen-haskell-exports"
        , arg "-o", arg outputFile
        , arg "--tmpdir", arg tempDir
        , arg "--gcc-program", arg =<< getBuilderPath (Cc CompileC Stage1)
        , pure $ concatMap (\a -> ["--gcc-flag", a]) cFlags
        , arg "--nm-program", arg =<< getBuilderPath Nm
        , isSpecified Objdump ? mconcat [ arg "--objdump-program"
                                        , arg =<< getBuilderPath Objdump ]
        , arg "--target-os", arg =<< getSetting TargetOs ]

includeCcArgs :: Args
includeCcArgs = do
    root <- getBuildRoot
    mconcat [ cArgs
            , cWarnings
            , getSettingList $ ConfCcArgs Stage1
            , flag GhcUnregisterised ? arg "-DUSE_MINIINTERPRETER"
            , arg "-Irts"
            , arg "-Iincludes"
            , arg $ "-I" ++ root -/- generatedDir
            , notM ghcWithSMP ? arg "-DNOSMP"
            , arg "-fcommon" ]


module Settings.Builders.GenPrimopCode (genPrimopCodeBuilderArgs) where

import Settings.Builders.Common

genPrimopCodeBuilderArgs :: Args
genPrimopCodeBuilderArgs = builder GenPrimopCode ? mconcat
    [ output "//PrimopWrappers.hs"                 ? arg "--make-haskell-wrappers"
    , output "//Prim.hs"                           ? arg "--make-haskell-source"
    , output "//primop-data-decl.hs-incl"          ? arg "--data-decl"
    , output "//primop-tag.hs-incl"                ? arg "--primop-tag"
    , output "//primop-list.hs-incl"               ? arg "--primop-list"
    , output "//primop-has-side-effects.hs-incl"   ? arg "--has-side-effects"
    , output "//primop-out-of-line.hs-incl"        ? arg "--out-of-line"
    , output "//primop-commutable.hs-incl"         ? arg "--commutable"
    , output "//primop-code-size.hs-incl"          ? arg "--code-size"
    , output "//primop-can-fail.hs-incl"           ? arg "--can-fail"
    , output "//primop-strictness.hs-incl"         ? arg "--strictness"
    , output "//primop-fixity.hs-incl"             ? arg "--fixity"
    , output "//primop-primop-info.hs-incl"        ? arg "--primop-primop-info"
    , output "//primop-vector-uniques.hs-incl"     ? arg "--primop-vector-uniques"
    , output "//primop-vector-tys.hs-incl"         ? arg "--primop-vector-tys"
    , output "//primop-vector-tys-exports.hs-incl" ? arg "--primop-vector-tys-exports"
    , output "//primop-vector-tycons.hs-incl"      ? arg "--primop-vector-tycons"
    , output "//primop-usage.hs-incl"              ? arg "--usage" ]


module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where

import Hadrian.Haskell.Cabal
import Hadrian.Haskell.Cabal.Type

import Flavour
import Packages
import Settings.Builders.Common
import Settings.Warnings
import qualified Context as Context
import Rules.Libffi (libffiName)

ghcBuilderArgs :: Args
ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies]

compileAndLinkHs :: Args
compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
    mconcat [ arg "-Wall"
            , commonGhcArgs
            , ghcLinkArgs
            , defaultGhcWarningsArgs
            , builder (Ghc CompileHs) ? arg "-c"
            , getInputs
            , arg "-o", arg =<< getOutput ]

compileC :: Args
compileC = builder (Ghc CompileCWithGhc) ? do
    way <- getWay
    let ccArgs = [ getContextData ccOpts
                 , getStagedSettingList ConfCcArgs
                 , cIncludeArgs
                 , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ]
    mconcat [ arg "-Wall"
            , ghcLinkArgs
            , commonGhcArgs
            , mconcat (map (map ("-optc" ++) <$>) ccArgs)
            , defaultGhcWarningsArgs
            , arg "-c"
            , getInputs
            , arg "-o"
            , arg =<< getOutput ]

ghcLinkArgs :: Args
ghcLinkArgs = builder (Ghc LinkHs) ? do
    pkg     <- getPackage
    libs    <- getContextData extraLibs
    libDirs <- getContextData extraLibDirs
    fmwks   <- getContextData frameworks
    darwin  <- expr osxHost
    way     <- getWay

    -- Relative path from the output (rpath $ORIGIN).
    originPath <- dropFileName <$> getOutput
    context <- getContext
    libPath' <- expr (libPath context)
    distDir <- expr Context.distDir

    useSystemFfi <- expr (flag UseSystemFfi)
    buildPath <- getBuildPath
    libffiName' <- libffiName

    let
        dynamic = Dynamic `wayUnit` way
        distPath = libPath' -/- distDir
        originToLibsDir = makeRelativeNoSysLink originPath distPath
        rpath | darwin = "@loader_path" -/- originToLibsDir
              | otherwise = "$ORIGIN" -/- originToLibsDir

        -- TODO: an alternative would be to generalize by linking with extra
        -- bundled libraries, but currently the rts is the only use case. It is
        -- a special case when `useSystemFfi == True`: the ffi library files
        -- are not actually bundled with the rts. Perhaps ffi should be part of
        -- rts's extra libraries instead of extra bundled libraries in that
        -- case. Care should be take as to not break the make build.
        rtsFfiArg = package rts ? not useSystemFfi ? mconcat
            [ arg ("-L" ++ buildPath)
            , arg ("-l" ++ libffiName')
            ]

    mconcat [ dynamic ? mconcat
                [ arg "-dynamic"
                -- TODO what about windows?
                , isLibrary pkg ? pure [ "-shared", "-dynload", "deploy" ]
                , notStage0 ?
                  hostSupportsRPaths ? arg ("-optl-Wl,-rpath," ++ rpath)
                ]
            , arg "-no-auto-link-packages"
            ,      nonHsMainPackage pkg  ? arg "-no-hs-main"
            , not (nonHsMainPackage pkg) ? arg "-rtsopts"
            , pure [ "-l" ++ lib    | lib    <- libs    ]
            , pure [ "-L" ++ libDir | libDir <- libDirs ]
            , rtsFfiArg
            , darwin ? pure (concat [ ["-framework", fmwk] | fmwk <- fmwks ])
            ]

findHsDependencies :: Args
findHsDependencies = builder (Ghc FindHsDependencies) ? do
    ways <- getLibraryWays
    mconcat [ arg "-M"
            , commonGhcArgs
            , arg "-include-pkg-deps"
            , arg "-dep-makefile", arg =<< getOutput
            , pure $ concat [ ["-dep-suffix", wayPrefix w] | w <- ways ]
            , getInputs ]

haddockGhcArgs :: Args
haddockGhcArgs = mconcat [ commonGhcArgs
                         , getContextData hcOpts
                         , ghcWarningsArgs ]

-- | Common GHC command line arguments used in 'ghcBuilderArgs',
-- 'ghcCBuilderArgs', 'ghcMBuilderArgs' and 'haddockGhcArgs'.
commonGhcArgs :: Args
commonGhcArgs = do
    way  <- getWay
    path <- getBuildPath
    ghcVersion <- expr ghcVersionH
    mconcat [ arg "-hisuf", arg $ hisuf way
            , arg "-osuf" , arg $  osuf way
            , arg "-hcsuf", arg $ hcsuf way
            , wayGhcArgs
            , packageGhcArgs
            , includeGhcArgs
            -- When compiling RTS for Stage1 or Stage2 we do not have it (yet)
            -- in the package database. We therefore explicity supply the path
            -- to the @ghc-version@ file, to prevent GHC from trying to open the
            -- RTS package in the package database and failing.
            , package rts ? notStage0 ? arg ("-ghcversion-file=" ++ ghcVersion)
            , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs
            , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs
            , map ("-optP" ++) <$> getContextData cppOpts
            , arg "-outputdir", arg path ]

-- TODO: Do '-ticky' in all debug ways?
wayGhcArgs :: Args
wayGhcArgs = do
    way <- getWay
    mconcat [ if Dynamic `wayUnit` way
                then pure ["-fPIC", "-dynamic"]
                else arg "-static"
            , (Threaded  `wayUnit` way) ? arg "-optc-DTHREADED_RTS"
            , (Debug     `wayUnit` way) ? arg "-optc-DDEBUG"
            , (Profiling `wayUnit` way) ? arg "-prof"
            , (Logging   `wayUnit` way) ? arg "-eventlog"
            , (way == debug || way == debugDynamic) ?
              pure ["-ticky", "-DTICKY_TICKY"] ]

packageGhcArgs :: Args
packageGhcArgs = do
    package <- getPackage
    pkgId   <- expr $ pkgIdentifier package
    mconcat [ arg "-hide-all-packages"
            , arg "-no-user-package-db"
            , packageDatabaseArgs
            , libraryPackage ? arg ("-this-unit-id " ++ pkgId)
            , map ("-package-id " ++) <$> getContextData depIds ]

includeGhcArgs :: Args
includeGhcArgs = do
    pkg     <- getPackage
    path    <- getBuildPath
    root    <- getBuildRoot
    context <- getContext
    srcDirs <- getContextData srcDirs
    autogen <- expr $ autogenPath context
    let cabalMacros = autogen -/- "cabal_macros.h"
    expr $ need [cabalMacros]
    mconcat [ arg "-i"
            , arg $ "-i" ++ path
            , arg $ "-i" ++ autogen
            , pure [ "-i" ++ pkgPath pkg -/- dir | dir <- srcDirs ]
            , cIncludeArgs
            , arg $      "-I" ++ root -/- generatedDir
            , arg $ "-optc-I" ++ root -/- generatedDir
            , pure ["-optP-include", "-optP" ++ cabalMacros] ]