Skip to content

Commit

Permalink
Clean ups
Browse files Browse the repository at this point in the history
  • Loading branch information
@alt-romes
alt-romes committed Jan 17, 2024
1 parent cd37fac commit 91b020b
Show file tree
Hide file tree
Showing 4 changed files with 37 additions and 116 deletions.
5 changes: 3 additions & 2 deletions Cabal/src/Distribution/Simple/Build/Monad.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,11 +3,12 @@
{-# LANGUAGE PatternSynonyms #-}

module Distribution.Simple.Build.Monad
( BuildM (BuildM)
( -- * A Monad for building components
BuildM (BuildM)
, runBuildM
, PreBuildComponentInputs (..)

-- * A few queries on @'BuildM'@
-- * Queries over the component being built
, buildVerbosity
, buildWhat
, buildComponent
Expand Down
57 changes: 11 additions & 46 deletions Cabal/src/Distribution/Simple/GHC/Build.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -89,71 +89,36 @@ build numJobs pkg_descr = do
-- See Note [Build Target Dir vs Target Dir] as well
_targetDir <- makeRelativeToCurrentDirectory targetDir_absolute & liftIO
buildTargetDir <-
-- ROMES:TODO: To preserve previous behaviour, we don't use relative dirs
-- for executables. Historically, this isn't needed to reduce the CLI
-- limit because we link executables with the module names instead of
-- passing the path to object file.
-- ROMES:TODO: To preserve the previous behaviour, we don't use relative
-- dirs for executables. Historically, this isn't needed to reduce the CLI
-- limit (unlike for libraries) because we link executables with the module
-- names instead of passing the path to object file -- that's something
-- else we can now fix after the refactor lands.
if isLib
then makeRelativeToCurrentDirectory buildTargetDir_absolute & liftIO
else return buildTargetDir_absolute

(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) & liftIO

-- Determine which ways we want to build the component
-- Determine in which ways we want to build the component
let
-- wantVanilla seems underspecified, maybe we could deprecated it? (TODO)
-- wantVanilla vs wantStatic??
wantVanilla = if isLib then withVanillaLib lbi else False
wantVanilla = if isLib then withVanillaLib lbi else False -- vanilla is the same as static
wantStatic = if isLib then withStaticLib lbi else withFullyStaticExe lbi
wantDynamic = if isLib then withSharedLib lbi else withDynExe lbi
wantProf = if isLib then withProfLib lbi else withProfExe lbi

-- See also Note [Building Haskell Modules accounting for TH] in Distribution.Simple.GHC.Build.Modules
wantedWays =
Set.fromList $
[StaticWay | wantStatic] -- this should be the default, and Static == Vanilla
[StaticWay | wantStatic || wantVanilla ||
-- We build static by default if no other way is wanted
not (wantDynamic || wantProf)]
<> [DynWay | wantDynamic]
<> [ProfWay | wantProf]
-- If no way is explicitly wanted, we take vanilla
-- ROMES:TODO: Drop vanilla altogether, use static as default.
<> [VanillaWay | wantVanilla || not (wantStatic || wantDynamic || wantProf)]
-- ROMES:TODO: Is vanilla necessarily the same as defaultGhcWay? If so,
-- we can deal away with VanillaWay and be explicit in -dynamic vs
-- -static, or always default to -static. Would simplify further.
-- ROMES:TODO: Perhaps, if the component is indefinite, we only pick Vanilla?
-- To mimick the old behaviour we need at least profiled too (Vanilla +
-- Prof), and there's even a test for profiled signature, whatever that
-- means. So only doing vanilla way for indefinite components before seems wrong.
-- Consider...
-- ROMES:TODO: Perhaps for executables we want to limit the "wanted"
-- ways to just one?

-- ROMES:TODO: From #3294, this may now be possible, after the refactor, by
-- simply passing a flag to buildHaskellModules on whether to link, which will
-- be true if the extra sources are null. Or just determine it even inside that
-- function, and then, outside, if extraSources == [], skip the link step!
--
-- Here's the comment from #3294:
-- In the case that there are no C source files that depend on FFI exports, I
-- think there is one more way that this can be fixed: we should revert to
-- pre-#842 and do compilation and linking in one go. This will obviously make
-- the GHC code more complicated, but I suspect it will pay its way: we'll
-- also get faster compilation for new versions of GHC since we don't have to
-- call GHC twice. Duncan previously claimed that the performance hit from
-- calling GHC a second time should not be large, but actually there is a
-- substantial performance hit when module graphs are large, as GHC recomputes
-- the module graph on every computation (one of the reasons why Shake is so
-- much faster.)

-- We need a separate build and link phase, and C sources must be compiled
-- after Haskell modules, because C sources may depend on stub headers
-- generated from compiling Haskell modules (#842).
--
-- ROMES:TODO: To preserve previous behaviour, we still pass absolute build
-- dir to build and extra sources, while passing the relative dir to the
-- linker phase. However, linking takes an absolute target dir which used to
-- be absolute for the output paths of executables and such.
-- We should really fix #9498, then clean this up to always? use the relative dirs.
-- generated from compiling Haskell modules (#842, #3294).
buildOpts <- buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir_absolute wantedWays
extraSources <- buildAllExtraSources ghcProg buildTargetDir
linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir_absolute) (wantedWays, buildOpts)
73 changes: 19 additions & 54 deletions Cabal/src/Distribution/Simple/GHC/Build/Link.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -98,12 +98,13 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (
, ghcOptLinkLibs =
-- ROMES:TODO: Looks wrong, why would we only check for fully
-- static exec, when we could be building libs or foreign libs?
-- We used to use this predicate for libraries too...
if withFullyStaticExe lbi
then extraLibsStatic bi
else extraLibs bi
, ghcOptLinkLibPath =
toNubListR $
-- ROMES:TODO: wb withStaticLib??
-- ROMES:TODO: what about withStaticLib??
if withFullyStaticExe lbi
then cleanedExtraLibDirsStatic
else cleanedExtraLibDirs
Expand All @@ -115,8 +116,8 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (
case what of
BuildRepl replFlags -> liftIO $ do
let
-- For repl we use the vanilla base ghc options
vanillaOpts = buildOpts VanillaWay
-- For repl we use the vanilla ghc options
staticOpts = buildOpts StaticWay
replOpts =
vanillaOpts
{ ghcOptExtra =
Expand Down Expand Up @@ -161,12 +162,7 @@ linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (
CTest test -> linkExeLike (testName test)
CBench bench -> linkExeLike (benchmarkName bench)

-- ROMES:TODO: This module can still be very much refactored. I'm pretty sure we
-- can merge all implementations of link for each component into one simpler
-- one, and that we don't need to pass the path to each object file in each way
-- to the linker invocation. GHC can probably find the right object files to
-- link based on the suffix prefix.

-- | Link a library component
linkLibrary
:: FilePath
-- ^ The library target build directory
Expand Down Expand Up @@ -302,28 +298,6 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li
toNubListR $ PD.extraFrameworkDirs libBi
, ghcOptRPaths = rpaths
}
-- ROMES:TODO: Delete these comments or use them
-- dynOpts
-- { ghcOptMode = toFlag GhcModeLink
-- , ghcOptShared = toFlag True
-- , ghcOptInputFiles = toNubListR dynObjectFiles
-- , ghcOptOutputFile = toFlag sharedLibFilePath
-- , -- For dynamic libs, Mac OS/X needs to know the install location
-- -- at build time. This only applies to GHC < 7.8 - see the
-- -- discussion in #1660.
-- ghcOptDylibName =
-- if hostOS == OSX
-- && ghcVersion < mkVersion [7, 8]
-- then toFlag sharedLibInstallPath
-- else mempty
-- , ghcOptNoAutoLinkPackages = toFlag True
-- , ghcOptLinkLibs = extraLibs libBi
-- , ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs
-- , ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi
-- , ghcOptLinkFrameworkDirs =
-- toNubListR $ PD.extraFrameworkDirs libBi
-- , ghcOptRPaths = rpaths
-- }
ghcStaticLinkArgs staticObjectFiles =
ghcBaseLinkArgs
{ ghcOptStaticLib = toFlag True
Expand All @@ -332,33 +306,13 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li
, ghcOptLinkLibs = extraLibs libBi
, ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs -- ROMES:TODO: why not extra dirs *static*???
}
-- ROMES:TODO: Delete these comments or use them
-- staticOpts
-- { ghcOptMode = toFlag GhcModeLink
-- , ghcOptStaticLib = toFlag True
-- , ghcOptInputFiles = toNubListR staticObjectFiles
-- , ghcOptOutputFile = toFlag staticLibFilePath
-- , ghcOptNoAutoLinkPackages = toFlag True
-- , ghcOptLinkLibs = extraLibs libBi
-- , ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs -- ROMES:TODO: why not extra dirs *static*???
-- }

staticObjectFiles <- getObjFiles StaticWay
profObjectFiles <- getObjFiles ProfWay
dynamicObjectFiles <- getObjFiles DynWay

let
linkWay = \case
VanillaWay -> do
Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
when (withGHCiLib lbi) $ do
(ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
Ld.combineObjectFiles
verbosity
lbi
ldProg
ghciLibFilePath
staticObjectFiles
ProfWay -> do
Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
when (withGHCiLib lbi) $ do
Expand All @@ -370,9 +324,20 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li
ghciProfLibFilePath
profObjectFiles
DynWay -> do
runGhcProg $ ghcSharedLinkArgs {- (buildOpts DynWay) -} dynamicObjectFiles
StaticWay ->
runGhcProg $ ghcStaticLinkArgs {- (buildOpts StaticWay) -} staticObjectFiles
runGhcProg $ ghcSharedLinkArgs dynamicObjectFiles
StaticWay -> do
when (withVanillaLib lbi) $ do
Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
when (withGHCiLib lbi) $ do
(ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
Ld.combineObjectFiles
verbosity
lbi
ldProg
ghciLibFilePath
staticObjectFiles
when (withStaticLib lbi) $ do
runGhcProg $ ghcStaticLinkArgs staticObjectFiles

-- ROMES: Why exactly branch on staticObjectFiles, rather than any other build
-- kind that we might have wanted instead?
Expand Down
18 changes: 4 additions & 14 deletions Cabal/src/Distribution/Simple/GHC/Build/Modules.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@ module Distribution.Simple.GHC.Build.Modules (buildHaskellModules, BuildWay (..)
import Control.Monad.IO.Class
import Distribution.Compat.Prelude

import Data.Function ((&))
import Data.List (sortOn, (\\))
import qualified Data.Set as Set
import Distribution.CabalSpecVersion
Expand Down Expand Up @@ -176,8 +175,6 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do
optSuffixFlag "" _ = NoFlag
optSuffixFlag pre x = toFlag (pre ++ x)

vanillaOpts = baseOpts VanillaWay

staticOpts = (baseOpts StaticWay){ghcOptDynLinkMode = toFlag GhcStaticOnly}
dynOpts =
(baseOpts DynWay)
Expand Down Expand Up @@ -211,10 +208,7 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do
StaticWay -> staticOpts
DynWay -> dynOpts
ProfWay -> profOpts
VanillaWay -> vanillaOpts

-- ROMES:TODO: StaticWay vs VanillaWay, we might infer that we don't
-- actually have the one we need if Static != Vanilla...
defaultGhcWay = if isDynamic comp then DynWay else StaticWay

-- If there aren't modules, or if we're loading the modules in repl, don't build.
Expand All @@ -231,7 +225,7 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do
-- compiling twice (if we support it)
useDynamicToo =
-- ROMES:TODO: These vanilla way are kind of bothersome. Ask Matthew.
(StaticWay `Set.member` neededWays || VanillaWay `Set.member` neededWays)
(StaticWay `Set.member` neededWays)
&& DynWay `Set.member` neededWays
&& supportsDynamicToo comp
&& null (hcSharedOptions GHC bi)
Expand All @@ -243,9 +237,8 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do
-- possibly needed by TH later (e.g. if building profiled) are already built.
| useDynamicToo =
[buildStaticAndDynamicToo]
++ (runGhcProg . buildOpts <$> Set.toList neededWays \\ [StaticWay, VanillaWay, DynWay])
-- Otherwise, we need to ensure the defaultGhcWay is built first.
-- VanillaWay first otherwise (fromEnum lists vanilla first)
++ (runGhcProg . buildOpts <$> Set.toList neededWays \\ [StaticWay, DynWay])
-- Otherwise, we need to ensure the defaultGhcWay is built first
| otherwise =
runGhcProg . buildOpts <$> sortOn (\w -> if w == defaultGhcWay then 0 else fromEnum w + 1) (Set.toList neededWays)

Expand All @@ -266,21 +259,19 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do
sequence_ orderedBuilds
return buildOpts

data BuildWay = VanillaWay | StaticWay | DynWay | ProfWay
data BuildWay = StaticWay | DynWay | ProfWay
deriving (Eq, Ord, Show, Enum)

-- | Returns the object/interface extension prefix for the given build way (e.g. "dyn_" for 'DynWay')
buildWayPrefix :: BuildWay -> String
buildWayPrefix = \case
VanillaWay -> ""
StaticWay -> ""
ProfWay -> "p_"
DynWay -> "dyn_"

-- | Returns the corresponding 'Hpc.Way' for a 'BuildWay'
buildWayHpcWay :: BuildWay -> Hpc.Way
buildWayHpcWay = \case
VanillaWay -> Hpc.Vanilla
StaticWay -> Hpc.Vanilla
ProfWay -> Hpc.Prof
DynWay -> Hpc.Dyn
Expand All @@ -289,7 +280,6 @@ buildWayHpcWay = \case
-- 'BuildInfo' and 'CompilerFlavor'
buildWayExtraHcOptions :: BuildWay -> Maybe (CompilerFlavor -> BuildInfo -> [String])
buildWayExtraHcOptions = \case
VanillaWay -> Nothing -- ROMES:TODO: This should probably be hcStaticOptions too!
StaticWay -> Just hcStaticOptions
ProfWay -> Just hcProfOptions
DynWay -> Just hcSharedOptions
Expand Down

0 comments on commit 91b020b

Please sign in to comment.