Refactor build flavours
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Mon, 9 Jan 2017 03:30:19 +0000 (03:30 +0000)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Mon, 9 Jan 2017 03:30:19 +0000 (03:30 +0000)
hadrian.cabal
src/Settings.hs
src/Settings/Default.hs
src/Settings/Flavours/Development.hs
src/Settings/Flavours/Perf.hs [deleted file]
src/Settings/Flavours/Performance.hs [new file with mode: 0644]
src/Settings/Flavours/Prof.hs [deleted file]
src/Settings/Flavours/Profiled.hs [new file with mode: 0644]
src/Settings/Flavours/Quick.hs
src/Settings/Flavours/Quickest.hs
src/Settings/Optimisation.hs [new file with mode: 0644]

index 598bd27..d3ef74c 100644 (file)
@@ -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
index 01ee122..d581ec4 100644 (file)
@@ -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
index 6db669e..2a9fae4 100644 (file)
@@ -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
index afe42d5..4314a64 100644 (file)
@@ -1,26 +1,22 @@
 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"] }
diff --git a/src/Settings/Flavours/Perf.hs b/src/Settings/Flavours/Perf.hs
deleted file mode 100644 (file)
index 7641657..0000000
+++ /dev/null
@@ -1,21 +0,0 @@
-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"
diff --git a/src/Settings/Flavours/Performance.hs b/src/Settings/Flavours/Performance.hs
new file mode 100644 (file)
index 0000000..69e244a
--- /dev/null
@@ -0,0 +1,18 @@
+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"] }
diff --git a/src/Settings/Flavours/Prof.hs b/src/Settings/Flavours/Prof.hs
deleted file mode 100644 (file)
index 6d94b90..0000000
+++ /dev/null
@@ -1,21 +0,0 @@
-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"
diff --git a/src/Settings/Flavours/Profiled.hs b/src/Settings/Flavours/Profiled.hs
new file mode 100644 (file)
index 0000000..0a1a6ed
--- /dev/null
@@ -0,0 +1,19 @@
+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" }
index 324ec85..dd9cd58 100644 (file)
@@ -1,10 +1,9 @@
 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" }
index 4d64cd0..0473dc6 100644 (file)
@@ -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
diff --git a/src/Settings/Optimisation.hs b/src/Settings/Optimisation.hs
new file mode 100644 (file)
index 0000000..6d47941
--- /dev/null
@@ -0,0 +1,21 @@
+module Settings.Optimisation (Optimisation (..), optimisationArgs) where\r
+\r
+import GHC\r
+import Predicate\r
+\r
+-- TODO: Move C optimisation settings here\r
+data Optimisation = Optimisation\r
+    { hsDefault  :: Args\r
+    , hsLibrary  :: Args\r
+    , hsCompiler :: Args\r
+    , hsGhc      :: Args }\r
+\r
+optimisationArgs :: Optimisation -> Args\r
+optimisationArgs Optimisation {..} = do\r
+    hsCompile <- builder $ Ghc CompileHs\r
+    hsLink    <- builder $ Ghc LinkHs\r
+    pkg       <- getPackage\r
+    mconcat [ (hsCompile || hsLink) ?                    hsDefault\r
+            ,  hsCompile            ? isLibrary pkg    ? hsLibrary\r
+            ,  hsCompile            ? package compiler ? hsCompiler\r
+            , (hsCompile || hsLink) ? package ghc      ? hsGhc ]\r