summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC.hs9
-rw-r--r--compiler/GHC/CoreToStg.hs3
-rw-r--r--compiler/GHC/Driver/Pipeline.hs6
-rw-r--r--compiler/GHC/Driver/Pipeline/Execute.hs8
-rw-r--r--compiler/GHC/Driver/Session.hs6
-rw-r--r--compiler/GHC/Iface/Tidy.hs2
-rw-r--r--compiler/GHC/Linker/Dynamic.hs3
-rw-r--r--compiler/GHC/Linker/Loader.hs4
-rw-r--r--compiler/GHC/Linker/Static.hs4
-rw-r--r--compiler/GHC/Linker/Unit.hs2
-rw-r--r--compiler/GHC/Platform/Ways.hs12
-rw-r--r--compiler/GHC/Unit/Info.hs9
12 files changed, 37 insertions, 31 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 3405d36c55..f419e21534 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -404,7 +404,6 @@ import GHC.Unit.Home.ModInfo
import Data.Foldable
import qualified Data.Map.Strict as Map
import Data.Set (Set)
-import qualified Data.Set as S
import qualified Data.Sequence as Seq
import Data.Maybe
import Data.Typeable ( Typeable )
@@ -590,10 +589,10 @@ checkBrokenTablesNextToCode logger dflags
checkBrokenTablesNextToCode' :: MonadIO m => Logger -> DynFlags -> m Bool
checkBrokenTablesNextToCode' logger dflags
- | not (isARM arch) = return False
- | WayDyn `S.notMember` ways dflags = return False
- | not tablesNextToCode = return False
- | otherwise = do
+ | not (isARM arch) = return False
+ | ways dflags `hasNotWay` WayDyn = return False
+ | not tablesNextToCode = return False
+ | otherwise = do
linkerInfo <- liftIO $ getLinkerInfo logger dflags
case linkerInfo of
GnuLD _ -> return True
diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index 38050e79e1..a258a424dc 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -61,7 +61,6 @@ import GHC.Utils.Trace
import Control.Monad (ap)
import Data.Maybe (fromMaybe)
import Data.Tuple (swap)
-import qualified Data.Set as Set
-- Note [Live vs free]
-- ~~~~~~~~~~~~~~~~~~~
@@ -248,7 +247,7 @@ coreToStg dflags this_mod ml pgm
then collectDebugInformation dflags ml pgm'
else (pgm', emptyInfoTableProvMap)
- prof = WayProf `Set.member` ways dflags
+ prof = ways dflags `hasWay` WayProf
final_ccs
| prof && gopt Opt_AutoSccsOnIndividualCafs dflags
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 26d2213a01..b282304a1a 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -252,8 +252,8 @@ compileOne' mHscMessage
input_fnpp = ms_hspp_file summary
mod_graph = hsc_mod_graph hsc_env0
needsLinker = needsTemplateHaskellOrQQ mod_graph
- isDynWay = any (== WayDyn) (ways lcl_dflags)
- isProfWay = any (== WayProf) (ways lcl_dflags)
+ isDynWay = hasWay (ways lcl_dflags) WayDyn
+ isProfWay = hasWay (ways lcl_dflags) WayProf
internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags)
pipelineOutput = case bcknd of
@@ -496,7 +496,7 @@ linkingNeeded logger dflags unit_env staticLink linkables pkg_deps = do
findHSLib :: Platform -> Ways -> [String] -> String -> IO (Maybe FilePath)
findHSLib platform ws dirs lib = do
- let batch_lib_file = if WayDyn `notElem` ws
+ let batch_lib_file = if ws `hasNotWay` WayDyn
then "lib" ++ lib <.> "a"
else platformSOName platform lib
found <- filterM doesFileExist (map (</> batch_lib_file) dirs)
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index 022e8ce1a1..997cddf121 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -832,10 +832,10 @@ llvmOptions dflags =
Just (LlvmTarget _ mcpu mattr) = lookup target (llvmTargets $ llvmConfig dflags)
-- Relocation models
- rmodel | gopt Opt_PIC dflags = "pic"
- | positionIndependent dflags = "pic"
- | WayDyn `elem` ways dflags = "dynamic-no-pic"
- | otherwise = "static"
+ rmodel | gopt Opt_PIC dflags = "pic"
+ | positionIndependent dflags = "pic"
+ | ways dflags `hasWay` WayDyn = "dynamic-no-pic"
+ | otherwise = "static"
platform = targetPlatform dflags
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 64a1f16ebb..ffb9108723 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -4053,7 +4053,7 @@ addWay' w dflags0 =
in dflags3
removeWayDyn :: DynP ()
-removeWayDyn = upd (\dfs -> dfs { targetWays_ = Set.filter (WayDyn /=) (targetWays_ dfs) })
+removeWayDyn = upd (\dfs -> dfs { targetWays_ = removeWay WayDyn (targetWays_ dfs) })
--------------------------
setGeneralFlag, unSetGeneralFlag :: GeneralFlag -> DynP ()
@@ -4470,7 +4470,7 @@ picCCOpts dflags = pieOpts ++ picOpts
-- correctly. They need to reference data in the Haskell
-- objects, but can't without -fPIC. See
-- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/position-independent-code
- | gopt Opt_PIC dflags || WayDyn `Set.member` ways dflags ->
+ | gopt Opt_PIC dflags || ways dflags `hasWay` WayDyn ->
["-fPIC", "-U__PIC__", "-D__PIC__"]
-- gcc may be configured to have PIC on by default, let's be
-- explicit here, see #15847
@@ -4653,7 +4653,7 @@ makeDynFlagsConsistent dflags
, not (gopt Opt_ExternalInterpreter dflags)
, hostIsProfiled
, backendProducesObject (backend dflags)
- , WayProf `Set.notMember` ways dflags
+ , ways dflags `hasNotWay` WayProf
= loop dflags{targetWays_ = addWay WayProf (targetWays_ dflags)}
"Enabling -prof, because -fobject-code is enabled and GHCi is profiled"
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index a9bcdeecc6..41b1ad6b9e 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -437,7 +437,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod
; local_ccs
- | WayProf `S.member` ways dflags
+ | ways dflags `hasWay` WayProf
= collectCostCentres mod all_tidy_binds tidy_rules
| otherwise
= S.empty
diff --git a/compiler/GHC/Linker/Dynamic.hs b/compiler/GHC/Linker/Dynamic.hs
index 48c3c6fcbd..e8c31a1f20 100644
--- a/compiler/GHC/Linker/Dynamic.hs
+++ b/compiler/GHC/Linker/Dynamic.hs
@@ -23,7 +23,6 @@ import GHC.SysTools.Tasks
import GHC.Utils.Logger
import GHC.Utils.TmpFs
-import qualified Data.Set as Set
import System.FilePath
linkDynLib :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
@@ -55,7 +54,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
| osElfTarget os || osMachOTarget os
, dynLibLoader dflags == SystemDependent
, -- Only if we want dynamic libraries
- WayDyn `Set.member` ways dflags
+ ways dflags `hasWay` WayDyn
-- Only use RPath if we explicitly asked for it
, useXLinkerRPath dflags os
= ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l]
diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs
index 68484eb288..c9617f1c28 100644
--- a/compiler/GHC/Linker/Loader.hs
+++ b/compiler/GHC/Linker/Loader.hs
@@ -638,8 +638,8 @@ failNonStd dflags srcspan = dieWith dflags srcspan $
text " with" <+> compWay <+>
text "using -osuf to set a different object file suffix."
where compWay
- | WayDyn `elem` ways dflags = text "-dynamic"
- | WayProf `elem` ways dflags = text "-prof"
+ | ways dflags `hasWay` WayDyn = text "-dynamic"
+ | ways dflags `hasWay` WayProf = text "-prof"
| otherwise = text "normal"
ghciWay
| hostIsDynamic = text "with -dynamic"
diff --git a/compiler/GHC/Linker/Static.hs b/compiler/GHC/Linker/Static.hs
index ae7a334f98..c4549d5274 100644
--- a/compiler/GHC/Linker/Static.hs
+++ b/compiler/GHC/Linker/Static.hs
@@ -89,7 +89,7 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
get_pkg_lib_path_opts l
| osElfTarget (platformOS platform) &&
dynLibLoader dflags == SystemDependent &&
- WayDyn `elem` ways dflags
+ ways dflags `hasWay` WayDyn
= let libpath = if gopt Opt_RelativeDynlibPaths dflags
then "$ORIGIN" </>
(l `makeRelativeTo` full_output_fn)
@@ -110,7 +110,7 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
in ["-L" ++ l] ++ rpathlink ++ rpath
| osMachOTarget (platformOS platform) &&
dynLibLoader dflags == SystemDependent &&
- WayDyn `elem` ways dflags &&
+ ways dflags `hasWay` WayDyn &&
useXLinkerRPath dflags (platformOS platform)
= let libpath = if gopt Opt_RelativeDynlibPaths dflags
then "@loader_path" </>
diff --git a/compiler/GHC/Linker/Unit.hs b/compiler/GHC/Linker/Unit.hs
index 7aec5263e3..718d5667bc 100644
--- a/compiler/GHC/Linker/Unit.hs
+++ b/compiler/GHC/Linker/Unit.hs
@@ -50,7 +50,7 @@ collectArchives dflags pc =
-- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way.
libraryDirsForWay :: Ways -> UnitInfo -> [String]
libraryDirsForWay ws
- | WayDyn `elem` ws = map ST.unpack . unitLibraryDynDirs
+ | hasWay ws WayDyn = map ST.unpack . unitLibraryDynDirs
| otherwise = map ST.unpack . unitLibraryDirs
getLibs :: DynFlags -> UnitEnv -> [UnitId] -> IO [(String,String)]
diff --git a/compiler/GHC/Platform/Ways.hs b/compiler/GHC/Platform/Ways.hs
index f9e70b7b92..71337187d8 100644
--- a/compiler/GHC/Platform/Ways.hs
+++ b/compiler/GHC/Platform/Ways.hs
@@ -24,7 +24,9 @@ module GHC.Platform.Ways
( Way(..)
, Ways
, hasWay
+ , hasNotWay
, addWay
+ , removeWay
, allowed_combination
, wayGeneralFlags
, wayUnsetGeneralFlags
@@ -72,14 +74,22 @@ data Way
type Ways = Set Way
--- | Test if a ways is enabled
+-- | Test if a way is enabled
hasWay :: Ways -> Way -> Bool
hasWay ws w = Set.member w ws
+-- | Test if a way is not enabled
+hasNotWay :: Ways -> Way -> Bool
+hasNotWay ws w = Set.notMember w ws
+
-- | Add a way
addWay :: Way -> Ways -> Ways
addWay = Set.insert
+-- | Remove a way
+removeWay :: Way -> Ways -> Ways
+removeWay = Set.delete
+
-- | Check if a combination of ways is allowed
allowed_combination :: Ways -> Bool
allowed_combination ways = not disallowed
diff --git a/compiler/GHC/Unit/Info.hs b/compiler/GHC/Unit/Info.hs
index b2fb1c5e4c..8e86c84db8 100644
--- a/compiler/GHC/Unit/Info.hs
+++ b/compiler/GHC/Unit/Info.hs
@@ -50,7 +50,6 @@ import GHC.Settings
import Data.Version
import Data.Bifunctor
import Data.List (isPrefixOf, stripPrefix)
-import qualified Data.Set as Set
-- | Information about an installed unit
@@ -205,19 +204,19 @@ collectFrameworksDirs ps = map ST.unpack (ordNub (filter (not . ST.null) (concat
-- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way.
libraryDirsForWay :: Ways -> UnitInfo -> [String]
libraryDirsForWay ws
- | WayDyn `elem` ws = map ST.unpack . unitLibraryDynDirs
+ | hasWay ws WayDyn = map ST.unpack . unitLibraryDynDirs
| otherwise = map ST.unpack . unitLibraryDirs
unitHsLibs :: GhcNameVersion -> Ways -> UnitInfo -> [String]
unitHsLibs namever ways0 p = map (mkDynName . addSuffix . ST.unpack) (unitLibraries p)
where
- ways1 = Set.filter (/= WayDyn) ways0
+ ways1 = removeWay WayDyn ways0
-- the name of a shared library is libHSfoo-ghc<version>.so
-- we leave out the _dyn, because it is superfluous
-- debug and profiled RTSs include support for -eventlog
- ways2 | WayDebug `Set.member` ways1 || WayProf `Set.member` ways1
- = Set.filter (/= WayTracing) ways1
+ ways2 | ways1 `hasWay` WayDebug || ways1 `hasWay` WayProf
+ = removeWay WayTracing ways1
| otherwise
= ways1
View Lorry Controller Status