Commit 5e432d4a authored by Alp Mestanogullari's avatar Alp Mestanogullari Committed by Andrey Mokhov
Browse files

Honour the flavours advertised by the flavours.md document (#691)

* honour the flavours advertised by our flavours.md document

In particular, this patches focuses on enabling back the dynamic-enabled ways
for the runtime system, which required to fix a bug in libsuf.

* address some feedback

* make dynamicGhcPrograms :: Action Bool to implement the default logic faithfully

* remove redundant windows check
parent 996afc7d
......@@ -26,7 +26,7 @@ data Flavour = Flavour {
-- | Build split objects.
splitObjects :: Predicate,
-- | Build dynamic GHC programs.
dynamicGhcPrograms :: Bool,
dynamicGhcPrograms :: Action Bool,
-- | Enable GHCi debugger.
ghciWithDebugger :: Bool,
-- | Build profiled GHC.
......
......@@ -25,7 +25,7 @@ data Flavour = Flavour {
-- | Build split objects.
splitObjects :: Predicate,
-- | Build dynamic GHC programs.
dynamicGhcPrograms :: Bool,
dynamicGhcPrograms :: Action Bool,
-- | Enable GHCi debugger.
ghciWithDebugger :: Bool,
-- | Build profiled GHC.
......
......@@ -11,6 +11,7 @@ import Hadrian.Oracles.TextFile
import Hadrian.Oracles.Path
import Base
import Way.Type
-- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
-- | Each 'Setting' comes from @system.config@ file, e.g. 'target-os = mingw32'.
......@@ -179,11 +180,10 @@ topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath
-- We also need to respect the system's dynamic extension, e.g. .dll or .so.
libsuf :: Way -> Action String
libsuf way =
if not (wayUnit Dynamic way)
then return $ waySuffix way ++ ".a" -- e.g., _p.a
else do
extension <- setting DynamicExtension -- e.g., .dll or .so
version <- setting ProjectVersion -- e.g., 7.11.20141222
let prefix = wayPrefix $ removeWayUnit Dynamic way
-- e.g., p_ghc7.11.20141222.dll (the result)
return $ prefix ++ "-ghc" ++ version ++ extension
if not (wayUnit Dynamic way)
then return $ waySuffix way ++ ".a" -- e.g., _p.a
else do
extension <- setting DynamicExtension -- e.g., .dll or .so
version <- setting ProjectVersion -- e.g., 7.11.20141222
let suffix = waySuffix $ removeWayUnit Dynamic way
return $ "-ghc" ++ version ++ suffix ++ extension
......@@ -155,7 +155,7 @@ buildPackageDocumentation context@Context {..} = when (stage == Stage1 && packag
-- Build Haddock documentation
-- TODO: Pass the correct way from Rules via Context.
dynamicPrograms <- dynamicGhcPrograms <$> flavour
dynamicPrograms <- dynamicGhcPrograms =<< flavour
let haddockWay = if dynamicPrograms then dynamic else vanilla
build $ target (context {way = haddockWay}) (Haddock BuildPackage) srcs [file]
......
......@@ -58,7 +58,7 @@ libraryArgs = do
flavourWays <- getLibraryWays
contextWay <- getWay
withGhci <- expr ghcWithInterpreter
dynPrograms <- dynamicGhcPrograms <$> expr flavour
dynPrograms <- expr (flavour >>= dynamicGhcPrograms)
let ways = flavourWays ++ [contextWay]
pure [ if vanilla `elem` ways
then "--enable-library-vanilla"
......
......@@ -149,25 +149,23 @@ defaultLibraryWays :: Ways
defaultLibraryWays = mconcat
[ pure [vanilla]
, notStage0 ? pure [profiling]
-- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic]
, notStage0 ? platformSupportsSharedLibs ? pure [dynamic]
]
-- | Default build ways for the RTS.
defaultRtsWays :: Ways
defaultRtsWays = do
ways <- getLibraryWays
mconcat
[ pure [ logging, debug, threaded, threadedDebug, threadedLogging ]
, (profiling `elem` ways) ?
pure [ profiling, threadedProfiling, debugProfiling
, threadedDebugProfiling ]
-- we don't add the 'logging' variants of those for now, but we might
-- in the future?
{- , (dynamic `elem` ways) ?
pure [ dynamic, debugDynamic, threadedDynamic, threadedDebugDynamic
, loggingDynamic, threadedLoggingDynamic ] -}
]
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.
......@@ -215,11 +213,22 @@ defaultFlavour = Flavour
, libraryWays = defaultLibraryWays
, rtsWays = defaultRtsWays
, splitObjects = defaultSplitObjects
, dynamicGhcPrograms = False
, dynamicGhcPrograms = defaultDynamicGhcPrograms
, ghciWithDebugger = False
, ghcProfiled = False
, ghcDebugged = False }
-- | 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)
-- | Default condition for building split objects.
defaultSplitObjects :: Predicate
defaultSplitObjects = do
......
module Settings.Default (
SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs,
defaultArgs, defaultLibraryWays, defaultRtsWays, defaultFlavour, defaultSplitObjects
defaultArgs, defaultLibraryWays, defaultRtsWays,
defaultFlavour, defaultSplitObjects
) where
import Flavour
......
......@@ -4,7 +4,7 @@ import Expression
import Flavour
import Oracles.Flag
import {-# SOURCE #-} Settings.Default
import Settings.Flavours.Common (naturalInBaseFixArgs)
import Settings.Flavours.Common
-- Please update doc/flavours.md when changing this file.
quickFlavour :: Flavour
......@@ -13,7 +13,15 @@ quickFlavour = defaultFlavour
, args = defaultBuilderArgs <> quickArgs <> defaultPackageArgs
, libraryWays = mconcat
[ pure [vanilla]
, notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] }
, notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ]
, rtsWays = mconcat
[ pure
[ vanilla, threaded, logging, debug
, threadedDebug, threadedLogging, threaded ]
, notStage0 ? platformSupportsSharedLibs ? pure
[ dynamic, debugDynamic, threadedDynamic, loggingDynamic
, threadedDebugDynamic, threadedLoggingDynamic ]
] }
quickArgs :: Args
quickArgs = sourceArgs SourceArgs
......
......@@ -11,9 +11,18 @@ quickCrossFlavour :: Flavour
quickCrossFlavour = defaultFlavour
{ name = "quick-cross"
, args = defaultBuilderArgs <> quickCrossArgs <> defaultPackageArgs
, dynamicGhcPrograms = pure False
, libraryWays = mconcat
[ pure [vanilla]
, notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] }
, notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ]
, rtsWays = mconcat
[ pure
[ vanilla, threaded, logging, debug
, threadedDebug, threadedLogging, threaded ]
, notStage0 ? platformSupportsSharedLibs ? pure
[ dynamic, debugDynamic, threadedDynamic, loggingDynamic
, threadedDebugDynamic, threadedLoggingDynamic ]
] }
quickCrossArgs :: Args
quickCrossArgs = sourceArgs SourceArgs
......
......@@ -3,7 +3,7 @@ module Settings.Flavours.Quickest (quickestFlavour) where
import Expression
import Flavour
import {-# SOURCE #-} Settings.Default
import Settings.Flavours.Common (naturalInBaseFixArgs)
import Settings.Flavours.Common
-- Please update doc/flavours.md when changing this file.
quickestFlavour :: Flavour
......@@ -11,7 +11,7 @@ quickestFlavour = defaultFlavour
{ name = "quickest"
, args = defaultBuilderArgs <> quickestArgs <> defaultPackageArgs
, libraryWays = pure [vanilla]
, rtsWays = quickestRtsWays }
, rtsWays = pure [vanilla, threaded] }
quickestArgs :: Args
quickestArgs = sourceArgs SourceArgs
......@@ -22,11 +22,3 @@ quickestArgs = sourceArgs SourceArgs
, hsLibrary = mempty
, hsCompiler = stage0 ? arg "-O"
, hsGhc = stage0 ? arg "-O" }
-- Replicate GHCs RtsWays for flavour quickest (without dynamic):
-- $ make show! VALUE=GhcLibWays
-- GhcLibWays="v"
-- $ make show! VALUE=GhcRTSWays
-- GhcRTSWays="l debug thr thr_debug thr_l"
quickestRtsWays :: Ways
quickestRtsWays = pure [vanilla, logging, debug, threaded, threadedDebug, threadedLogging]
......@@ -281,7 +281,11 @@ rtsPackageArgs = package rts ? do
anyTargetArch ["powerpc"] ? arg "-Wno-undef" ]
mconcat
[ builder (Cabal Flags) ? any (wayUnit Profiling) rtsWays ? arg "profiling"
[ builder (Cabal Flags) ? mconcat
[ any (wayUnit Profiling) rtsWays ? arg "profiling"
, any (wayUnit Debug) rtsWays ? arg "debug"
, any (wayUnit Logging) rtsWays ? arg "logging"
]
, builder (Cc FindCDependencies) ? cArgs
, builder (Ghc CompileCWithGhc) ? map ("-optc" ++) <$> cArgs
, builder Ghc ? arg "-Irts"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment