Refactor build flavours

hadrian.cabal

@@ -86,10 +86,11 @@ executable hadrian
                        , Settings.Builders.Tar
                        , Settings.Default
                        , Settings.Flavours.Development
-                       , Settings.Flavours.Perf
-                       , Settings.Flavours.Prof
+                       , Settings.Flavours.Performance
+                       , Settings.Flavours.Profiled
                        , Settings.Flavours.Quick
                        , Settings.Flavours.Quickest
+                       , Settings.Optimisation
                        , Settings.Packages.Base
                        , Settings.Packages.Compiler
                        , Settings.Packages.Ghc

src/Settings.hs

@@ -16,8 +16,8 @@ import Oracles.PackageData
 import Oracles.Path
 import {-# SOURCE #-} Settings.Default
 import Settings.Flavours.Development
-import Settings.Flavours.Perf
-import Settings.Flavours.Prof
+import Settings.Flavours.Performance
+import Settings.Flavours.Profiled
 import Settings.Flavours.Quick
 import Settings.Flavours.Quickest
 import Settings.Path
@@ -56,7 +56,7 @@ getPkgDataList key = lift . pkgDataList . key =<< getBuildPath
 hadrianFlavours :: [Flavour]
 hadrianFlavours =
     [ defaultFlavour, developmentFlavour Stage1, developmentFlavour Stage2
-    , perfFlavour, profFlavour, quickFlavour, quickestFlavour ]
+    , performanceFlavour, profiledFlavour, quickFlavour, quickestFlavour ]
 
 flavour :: Flavour
 flavour = fromMaybe unknownFlavour $ find ((== flavourName) . name) flavours

src/Settings/Default.hs

@@ -27,6 +27,7 @@ import Settings.Builders.HsCpp
 import Settings.Builders.Ld
 import Settings.Builders.Make
 import Settings.Builders.Tar
+import Settings.Optimisation
 import Settings.Packages.Base
 import Settings.Packages.Compiler
 import Settings.Packages.Ghc
@@ -42,9 +43,17 @@ import Settings.Packages.RunGhc
 defaultArgs :: Args
 defaultArgs = mconcat
     [ defaultBuilderArgs
-    , builder Ghc ? mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2", arg "-H32m"]
+    , optimisationArgs defaultOptimisation
     , defaultPackageArgs ]
 
+-- | Default optimisation settings.
+defaultOptimisation :: Optimisation
+defaultOptimisation = Optimisation
+    { hsDefault  = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2", arg "-H32m"]
+    , hsLibrary  = mempty
+    , hsCompiler = mempty
+    , hsGhc      = mempty }
+
 -- | Packages that are built by default. You can change this by editing
 -- 'userPackages' in "UserSettings".
 defaultPackages :: Packages

src/Settings/Flavours/Development.hs

 module Settings.Flavours.Development (developmentFlavour) where
 
 import Flavour
-import GHC
 import Predicate
 import {-# SOURCE #-} Settings.Default
+import Settings.Optimisation
 
 -- TODO: Implement an equivalent of LAX_DEPENDENCIES = YES setting, see #250.
 developmentFlavour :: Stage -> Flavour
 developmentFlavour ghcStage = defaultFlavour
-    { name        = "devel" ++ show (fromEnum ghcStage)
-    , args        = developmentArgs ghcStage
+    { name = "devel" ++ show (fromEnum ghcStage)
+    , args = defaultBuilderArgs <> developmentArgs ghcStage <> defaultPackageArgs
     , libraryWays = append [vanilla] }
 
 developmentArgs :: Stage -> Args
 developmentArgs ghcStage = do
     stage <- getStage
-    pkg   <- getPackage
-    let now = succ stage == ghcStage
-    mconcat [ defaultBuilderArgs
-            , builder Ghc ? mconcat
-              [ append ["-O", "-H64m"]
-              , now ? pkg == compiler ? append ["-O0", "-DDEBUG", "-dcore-lint"]
-              , now ? pkg == ghc      ? append ["-O0", "-DDEBUG"]
-              , notStage0 ? isLibrary pkg ? arg "-dcore-lint" ]
-            , defaultPackageArgs ]
+    optimisationArgs $ Optimisation
+        { hsDefault  = append ["-O", "-H64m"]
+        , hsLibrary  = notStage0 ? arg "-dcore-lint"
+        , hsCompiler = succ stage == ghcStage ? append ["-O0", "-DDEBUG"]
+        , hsGhc      = succ stage == ghcStage ? append ["-O0", "-DDEBUG"] }

src/Settings/Flavours/Perf.hs

-module Settings.Flavours.Perf (perfFlavour) where
-
-import Context
-import Flavour
-import GHC
-import Predicate
-import {-# SOURCE #-} Settings.Default
-
-perfFlavour :: Flavour
-perfFlavour = defaultFlavour
-    { name = "perf"
-    , args = defaultBuilderArgs <> perfArgs <> defaultPackageArgs }
-
-optimise :: Context -> Bool
-optimise Context {..} =
-    package `elem` [compiler, ghc] && stage == Stage2 || isLibrary package
-
-perfArgs :: Args
-perfArgs = builder Ghc ? do
-    context <- getContext
-    if optimise context then arg "-O2" else arg "-O"

src/Settings/Flavours/Performance.hs

+module Settings.Flavours.Performance (performanceFlavour) where
+
+import Flavour
+import Predicate
+import {-# SOURCE #-} Settings.Default
+import Settings.Optimisation
+
+performanceFlavour :: Flavour
+performanceFlavour = defaultFlavour
+    { name = "perf"
+    , args = defaultBuilderArgs <> performanceArgs <> defaultPackageArgs }
+
+performanceArgs :: Args
+performanceArgs = optimisationArgs $ Optimisation
+    { hsDefault  = append ["-O", "-H64m"]
+    , hsLibrary  = notStage0 ? arg "-O2"
+    , hsCompiler = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"]
+    , hsGhc      = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"] }

src/Settings/Flavours/Prof.hs

-module Settings.Flavours.Prof (profFlavour) where
-
-import Context
-import Flavour
-import GHC
-import Predicate
-import {-# SOURCE #-} Settings.Default
-
-profFlavour :: Flavour
-profFlavour = defaultFlavour
-    { name        = "prof"
-    , args        = defaultBuilderArgs <> profArgs <> defaultPackageArgs
-    , ghcProfiled = True }
-
-optimise :: Context -> Bool
-optimise Context {..} = package `elem` [compiler, ghc] || isLibrary package
-
-profArgs :: Args
-profArgs = builder Ghc ? do
-    context <- getContext
-    if optimise context then arg "-O" else arg "-O0"

src/Settings/Flavours/Profiled.hs

+module Settings.Flavours.Profiled (profiledFlavour) where
+
+import Flavour
+import Predicate
+import {-# SOURCE #-} Settings.Default
+import Settings.Optimisation
+
+profiledFlavour :: Flavour
+profiledFlavour = defaultFlavour
+    { name        = "prof"
+    , args        = defaultBuilderArgs <> profiledArgs <> defaultPackageArgs
+    , ghcProfiled = True }
+
+profiledArgs :: Args
+profiledArgs = optimisationArgs $ Optimisation
+    { hsDefault  = append ["-O0", "-H64m"]
+    , hsLibrary  = notStage0 ? arg "-O"
+    , hsCompiler = arg "-O"
+    , hsGhc      = arg "-O" }

src/Settings/Flavours/Quick.hs

 module Settings.Flavours.Quick (quickFlavour) where
 
-import Context
 import Flavour
-import GHC
 import Predicate
 import {-# SOURCE #-} Settings.Default
+import Settings.Optimisation
 
 quickFlavour :: Flavour
 quickFlavour = defaultFlavour
@@ -12,11 +11,10 @@ quickFlavour = defaultFlavour
     , args        = defaultBuilderArgs <> quickArgs <> defaultPackageArgs
     , libraryWays = append [vanilla] }
 
-optimise :: Context -> Bool
-optimise Context {..} =
-    package `elem` [compiler, ghc] || stage == Stage1 && isLibrary package
-
+-- TODO: the hsLibrary setting seems wrong, but it matches mk/flavours/quick.mk
 quickArgs :: Args
-quickArgs = builder Ghc ? do
-    context <- getContext
-    if optimise context then arg "-O" else arg "-O0"
+quickArgs = optimisationArgs $ Optimisation
+    { hsDefault  = append ["-O0", "-H64m"]
+    , hsLibrary  = notStage0 ? arg "-O"
+    , hsCompiler =    stage0 ? arg "-O"
+    , hsGhc      =    stage0 ? arg "-O" }

src/Settings/Flavours/Quickest.hs

@@ -3,6 +3,7 @@ module Settings.Flavours.Quickest (quickestFlavour) where
 import Flavour
 import Predicate
 import {-# SOURCE #-} Settings.Default
+import Settings.Optimisation
 
 quickestFlavour :: Flavour
 quickestFlavour = defaultFlavour
@@ -12,7 +13,11 @@ quickestFlavour = defaultFlavour
     , rtsWays     = quickestRtsWays }
 
 quickestArgs :: Args
-quickestArgs = builder Ghc ? arg "-O0"
+quickestArgs = optimisationArgs $ Optimisation
+    { hsDefault  = append ["-O0", "-H64m"]
+    , hsLibrary  = mempty
+    , hsCompiler = mempty
+    , hsGhc      = mempty }
 
 quickestRtsWays :: Ways
 quickestRtsWays = mconcat

src/Settings/Optimisation.hs

+module Settings.Optimisation (Optimisation (..), optimisationArgs) where
+
+import GHC
+import Predicate
+
+-- TODO: Move C optimisation settings here
+data Optimisation = Optimisation
+    { hsDefault  :: Args
+    , hsLibrary  :: Args
+    , hsCompiler :: Args
+    , hsGhc      :: Args }
+
+optimisationArgs :: Optimisation -> Args
+optimisationArgs Optimisation {..} = do
+    hsCompile <- builder $ Ghc CompileHs
+    hsLink    <- builder $ Ghc LinkHs
+    pkg       <- getPackage
+    mconcat [ (hsCompile || hsLink) ?                    hsDefault
+            ,  hsCompile            ? isLibrary pkg    ? hsLibrary
+            ,  hsCompile            ? package compiler ? hsCompiler
+            , (hsCompile || hsLink) ? package ghc      ? hsGhc ]