Clean up, fix -Wall warnings.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Fri, 21 Aug 2015 15:28:03 +0000 (16:28 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Fri, 21 Aug 2015 15:28:03 +0000 (16:28 +0100)
27 files changed:
src/Main.hs
src/Oracles/ArgsHash.hs
src/Oracles/Base.hs
src/Oracles/Dependencies.hs
src/Oracles/Flag.hs
src/Oracles/PackageDeps.hs
src/Oracles/WindowsRoot.hs
src/Package.hs
src/Rules.hs
src/Rules/Actions.hs
src/Rules/Cabal.hs
src/Rules/Config.hs
src/Rules/Data.hs
src/Rules/Dependencies.hs
src/Rules/Documentation.hs
src/Rules/Resources.hs
src/Settings/Builders/Ar.hs
src/Settings/Builders/Gcc.hs
src/Settings/Builders/Ghc.hs
src/Settings/Builders/GhcCabal.hs
src/Settings/Builders/Haddock.hs
src/Settings/Builders/Ld.hs
src/Settings/TargetDirectory.hs
src/Settings/User.hs
src/Settings/Util.hs
src/Settings/Ways.hs
src/Util.hs

index 60bd20a..b578f70 100644 (file)
@@ -1,6 +1,7 @@
 import Base
 import Rules
 
+main :: IO ()
 main = shakeArgs shakeOptions{shakeFiles = shakeFilesPath} $ do
     oracleRules     -- see module Rules.Oracles
     cabalRules      -- see module Rules.Cabal
index 422cacd..4d674c6 100644 (file)
@@ -25,11 +25,11 @@ newtype ArgsHashKey = ArgsHashKey Target
 -- TODO: enforce the above assumption via type trickery?
 checkArgsHash :: FullTarget -> Action ()
 checkArgsHash target = do
-    tmp <- askOracle . ArgsHashKey $ target { sources = ["src"] } :: Action Int
+    _ <- askOracle . ArgsHashKey $ target { sources = ["src"] } :: Action Int
     return ()
 
 -- Oracle for storing per-target argument list hashes
 argsHashOracle :: Rules ()
 argsHashOracle = do
-    addOracle $ \(ArgsHashKey target) -> hash <$> interpret target getArgs
+    _ <- addOracle $ \(ArgsHashKey target) -> hash <$> interpret target getArgs
     return ()
index a6abbfc..83fe741 100644 (file)
@@ -36,5 +36,5 @@ configOracle = do
         need [configFile]
         putOracle $ "Reading " ++ configFile ++ "..."
         liftIO $ readConfigFile configFile
-    addOracle $ \(ConfigKey key) -> Map.lookup key <$> cfg ()
+    _ <- addOracle $ \(ConfigKey key) -> Map.lookup key <$> cfg ()
     return ()
index c301547..f9cfb25 100644 (file)
@@ -45,5 +45,5 @@ dependenciesOracle = do
                               . groupBy ((==) `on` fst)
                               . sortBy (compare `on` fst) $ contents
 
-    addOracle $ \(DependenciesKey (file, obj)) -> Map.lookup obj <$> deps file
+    _ <- addOracle $ \(DependenciesKey (file, obj)) -> Map.lookup obj <$> deps file
     return ()
index 391ed5e..cc761de 100644 (file)
@@ -1,6 +1,6 @@
 module Oracles.Flag (
     Flag (..), flag,
-    supportsPackageKey, crossCompiling, gccIsClang, gccLt46,
+    crossCompiling, gccIsClang, gccLt46,
     platformSupportsSharedLibs, ghcWithSMP, ghcWithNativeCodeGen
     ) where
 
@@ -35,9 +35,6 @@ flag f = do
         ++ "' instead of 'YES' or 'NO'."
     return $ value == "YES"
 
-supportsPackageKey :: Action Bool
-supportsPackageKey = flag SupportsPackageKey
-
 crossCompiling :: Action Bool
 crossCompiling = flag CrossCompiling
 
index 8823c38..3c2d4ea 100644 (file)
@@ -31,5 +31,5 @@ packageDepsOracle = do
         contents <- readFileLines packageDependencies
         return . Map.fromList
                $ [ (head ps, tail ps) | line <- contents, let ps = words line ]
-    addOracle $ \(PackageDepsKey pkg) -> Map.lookup pkg <$> deps ()
+    _ <- addOracle $ \(PackageDepsKey pkg) -> Map.lookup pkg <$> deps ()
     return ()
index a69caa8..4eb23ad 100644 (file)
@@ -24,5 +24,5 @@ windowsRootOracle = do
         let root = dropWhileEnd isSpace out
         putOracle $ "Detected root on Windows: " ++ root
         return root
-    addOracle $ \WindowsRoot{} -> root ()
+    _ <- addOracle $ \WindowsRoot{} -> root ()
     return ()
index 27a19fd..fab8f28 100644 (file)
@@ -1,7 +1,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 
 module Package (
-    Package (..), PackageName, pkgCabalPath,
+    Package (..), PackageName, pkgCabalFile,
     library, topLevel, setPath
     ) where
 
@@ -22,8 +22,8 @@ data Package = Package
      deriving Generic
 
 -- Relative path to cabal file, e.g.: "libraries/Cabal/Cabal/Cabal.cabal"
-pkgCabalPath :: Package -> FilePath
-pkgCabalPath pkg = pkgPath pkg -/- pkgName pkg <.> "cabal"
+pkgCabalFile :: Package -> FilePath
+pkgCabalFile pkg = pkgPath pkg -/- pkgName pkg <.> "cabal"
 
 instance Show Package where
     show = pkgName
index 65ae2e4..842bc0b 100644 (file)
@@ -27,17 +27,17 @@ generateTargets = action $ do
         fmap concat . forM pkgs $ \pkg -> do
             let target    = stagePackageTarget stage pkg
                 buildPath = targetPath stage pkg -/- "build"
-            buildGhciLib <- interpret target $ getPkgData BuildGhciLib
-            pkgKey       <- interpret target $ getPkgData PackageKey
-            buildHaddock <- interpret target $ Settings.User.buildHaddock
-            let ghciLib = [ buildPath -/- "HS" ++ pkgKey <.> "o"
-                          | buildGhciLib == "YES" && stage /= Stage0 ]
-                haddock = [ pkgHaddockPath pkg | buildHaddock ]
+            libName     <- interpret target $ getPkgData LibName
+            needGhciLib <- interpret target $ getPkgData BuildGhciLib
+            needHaddock <- interpret target buildHaddock
+            let ghciLib = [ buildPath -/- "HS" ++ libName <.> "o"
+                          | needGhciLib == "YES" && stage /= Stage0 ]
+                haddock = [ pkgHaddockFile pkg | needHaddock ]
 
             ways <- interpret target getWays
             libs <- forM ways $ \way -> do
                 extension <- libsuf way
-                return $ buildPath -/- "libHS" ++ pkgKey <.> extension
+                return $ buildPath -/- "libHS" ++ libName <.> extension
 
             return $ ghciLib ++ libs ++ haddock
 
index 9726e2f..a6000d1 100644 (file)
@@ -10,7 +10,6 @@ import qualified Target
 import Oracles.Setting
 import Oracles.ArgsHash
 import Settings.Args
-import Settings.Util
 import Settings.User
 import Settings.Builders.Ar
 
@@ -20,7 +19,7 @@ import Settings.Builders.Ar
 buildWithResources :: [(Resource, Int)] -> FullTarget -> Action ()
 buildWithResources rs target = do
     let builder = Target.builder target
-    needBuilder builder
+    needBuilder laxDependencies builder
     path    <- builderPath builder
     argList <- interpret target getArgs
     -- The line below forces the rule to be rerun if the args hash has changed
@@ -55,11 +54,11 @@ interestingInfo builder ss = case builder of
     GhcCabal -> prefixAndSuffix 3 0 ss
     _        -> ss
   where
-    prefixAndSuffix n m ss =
-        if length ss <= n + m + 1
-        then ss
-        else take n ss
+    prefixAndSuffix n m list =
+        if length list <= n + m + 1
+        then list
+        else take n list
              ++ ["... skipping "
-             ++ show (length ss - n - m)
+             ++ show (length list - n - m)
              ++ " arguments ..."]
-             ++ drop (length ss - m) ss
+             ++ drop (length list - m) list
index 55d909d..fc2bc95 100644 (file)
@@ -3,7 +3,7 @@ module Rules.Cabal (cabalRules) where
 import Base
 import Stage
 import Package hiding (library)
-import Expression hiding (package)
+import Expression
 import Settings.Packages
 import Data.List
 import Data.Version
@@ -15,29 +15,27 @@ import Distribution.PackageDescription.Parse
 cabalRules :: Rules ()
 cabalRules = do
     -- Cache boot package constraints (to be used in cabalArgs)
-    bootPackageConstraints %> \file -> do
+    bootPackageConstraints %> \out -> do
         pkgs <- interpret (stageTarget Stage0) getPackages
         constraints <- forM (sort pkgs) $ \pkg -> do
-            let cabal = pkgCabalPath pkg
-            need [cabal]
-            description <- liftIO $ readPackageDescription silent cabal
-            let identifier       = package . packageDescription $ description
+            need [pkgCabalFile pkg]
+            pd <- liftIO . readPackageDescription silent $ pkgCabalFile pkg
+            let identifier       = package . packageDescription $ pd
                 version          = showVersion . pkgVersion $ identifier
                 PackageName name = Distribution.Package.pkgName identifier
             return $ name ++ " == " ++ version
-        writeFileChanged file . unlines $ constraints
+        writeFileChanged out . unlines $ constraints
 
     -- Cache package dependencies
-    packageDependencies %> \file -> do
+    packageDependencies %> \out -> do
         pkgs <- interpret (stageTarget Stage1) getPackages
         pkgDeps <- forM (sort pkgs) $ \pkg -> do
-            let cabal = pkgCabalPath pkg
-            need [cabal]
-            description <- liftIO $ readPackageDescription silent cabal
-            let deps     = collectDeps . condLibrary $ description
+            need [pkgCabalFile pkg]
+            pd <- liftIO . readPackageDescription silent $ pkgCabalFile pkg
+            let deps     = collectDeps . condLibrary $ pd
                 depNames = [ name | Dependency (PackageName name) _ <- deps ]
             return . unwords $ Package.pkgName pkg : sort depNames
-        writeFileChanged file . unlines $ pkgDeps
+        writeFileChanged out . unlines $ pkgDeps
 
 collectDeps :: Maybe (CondTree v [Dependency] a) -> [Dependency]
 collectDeps Nothing = []
index 94b024b..bc4663a 100644 (file)
@@ -12,12 +12,13 @@ configCommand = "AC_CONFIG_FILES([" ++ configPath ++ "system.config])"
 
 configRules :: Rules ()
 configRules = do
-    configPath -/- "system.config" %> \out -> do
+    configPath -/- "system.config" %> \_ -> do
         need [configPath -/- "system.config.in", "configure"]
         putBuild "Running configure..."
         cmd "bash configure" -- TODO: get rid of 'bash'
 
-    "configure" %> \out -> do
+    -- TODO: this rule won't rebuild if configure.ac is changed. Worth fixing?
+    "configure" %> \_ -> do
         -- Make sure 'configure.ac' script contains a line with configCommand
         script <- fmap lines . liftIO $ readFile "configure.ac"
         when (configCommand `notElem` script) $ do
index 7cf8a3c..b8cd1ba 100644 (file)
@@ -4,7 +4,7 @@ import Base
 import Util
 import Package
 import Builder
-import Switches
+import Switches (registerPackage)
 import Expression
 import qualified Target
 import Oracles.PackageDeps
@@ -18,11 +18,11 @@ import Control.Monad.Extra
 
 -- Build package-data.mk by using GhcCabal to process pkgCabal file
 buildPackageData :: Resources -> StagePackageTarget -> Rules ()
-buildPackageData (Resources ghcCabal ghcPkg) target = do
+buildPackageData rs target = do
     let stage     = Target.stage target
         pkg       = Target.package target
         path      = targetPath stage pkg
-        cabal     = pkgCabalPath pkg
+        cabalFile = pkgCabalFile pkg
         configure = pkgPath pkg -/- "configure"
 
     (path -/-) <$>
@@ -33,7 +33,7 @@ buildPackageData (Resources ghcCabal ghcPkg) target = do
         , "build" -/- "autogen" -/- "cabal_macros.h"
         -- TODO: Is this needed? Also check out Paths_cpsa.hs.
         -- , "build" -/- "autogen" -/- ("Paths_" ++ name) <.> "hs"
-        ] &%> \files -> do
+        ] &%> \outs -> do
             -- GhcCabal may run the configure script, so we depend on it
             -- We don't know who built the configure script from configure.ac
             whenM (doesFileExist $ configure <.> "ac") $ need [configure]
@@ -41,18 +41,18 @@ buildPackageData (Resources ghcCabal ghcPkg) target = do
             -- We configure packages in the order of their dependencies
             deps <- packageDeps pkg
             pkgs <- interpret target getPackages
-            let cmp pkg name = compare (pkgName pkg) name
-                depPkgs      = intersectOrd cmp (sort pkgs) deps
+            let cmp p name = compare (pkgName p) name
+                depPkgs    = intersectOrd cmp (sort pkgs) deps
             need [ targetPath stage p -/- "package-data.mk" | p <- depPkgs ]
 
-            need [cabal]
-            buildWithResources [(ghcCabal, 1)] $
-                fullTarget target GhcCabal [cabal] files
+            need [cabalFile]
+            buildWithResources [(ghcCabal rs, 1)] $
+                fullTarget target GhcCabal [cabalFile] outs
 
             -- TODO: find out of ghc-cabal can be concurrent with ghc-pkg
             whenM (interpret target registerPackage) .
-                buildWithResources [(ghcPkg, 1)] $
-                fullTarget target (GhcPkg stage) [cabal] files
+                buildWithResources [(ghcPkg rs, 1)] $
+                fullTarget target (GhcPkg stage) [cabalFile] outs
 
             postProcessPackageData $ path -/- "package-data.mk"
 
index e63d27d..5e62509 100644 (file)
@@ -21,10 +21,10 @@ buildPackageDependencies _ target =
         dropBuild = (pkgPath pkg ++) . drop (length buildPath)
         hDepFile  = buildPath -/- ".hs-dependencies"
     in do
-        (buildPath <//> "*.c.deps") %> \file -> do
-            let srcFile = dropBuild . dropExtension $ file
+        (buildPath <//> "*.c.deps") %> \out -> do
+            let srcFile = dropBuild . dropExtension $ out
             need [srcFile]
-            build $ fullTarget target (GccM stage) [srcFile] [file]
+            build $ fullTarget target (GccM stage) [srcFile] [out]
 
         hDepFile %> \file -> do
             srcs <- interpret target getPackageSources
index 9cde8d1..f198577 100644 (file)
@@ -21,20 +21,19 @@ import Control.Monad.Extra
 -- files in the Shake databases seems fragile and unnecesarry.
 buildPackageDocumentation :: Resources -> StagePackageTarget -> Rules ()
 buildPackageDocumentation _ target =
-    let stage   = Target.stage target
-        pkg     = Target.package target
-        name    = pkgName pkg
-        cabal   = pkgCabalPath pkg
-        haddock = pkgHaddockPath pkg
+    let stage       = Target.stage target
+        pkg         = Target.package target
+        cabalFile   = pkgCabalFile pkg
+        haddockFile = pkgHaddockFile pkg
     in when (stage == Stage1) $ do
 
-        haddock %> \file -> do
+        haddockFile %> \file -> do
             whenM (specified HsColour) $ do
-                need [cabal]
-                build $ fullTarget target GhcCabalHsColour [cabal] []
+                need [cabalFile]
+                build $ fullTarget target GhcCabalHsColour [cabalFile] []
             srcs <- interpret target getPackageSources
             deps <- interpret target $ getPkgDataList DepNames
-            let haddocks = [ pkgHaddockPath depPkg
+            let haddocks = [ pkgHaddockFile depPkg
                            | Just depPkg <- map findKnownPackage deps ]
             need $ srcs ++ haddocks
             let haddockWay = if dynamicGhcPrograms then dynamic else vanilla
index eab151b..8a91400 100644 (file)
@@ -3,6 +3,7 @@ module Rules.Resources (
     ) where
 
 import Base
+import Control.Monad
 
 data Resources = Resources
     {
@@ -14,7 +15,5 @@ data Resources = Resources
 -- * https://mail.haskell.org/pipermail/ghc-commits/2013-May/001712.html
 -- * ghc.mk: see comment about parallel ghc-pkg invokations
 resourceRules :: Rules Resources
-resourceRules = do
-    ghcCabal <- newResource "ghc-cabal" 1
-    ghcPkg   <- newResource "ghc-pkg"   1
-    return $ Resources ghcCabal ghcPkg
+resourceRules = liftM2 Resources (newResource "ghc-cabal" 1)
+                                 (newResource "ghc-pkg"   1)
index a67c168..ec8b6ac 100644 (file)
@@ -1,6 +1,7 @@
 module Settings.Builders.Ar (arArgs, arPersistentArgsCount) where
 
 import Builder
+import Switches (builder)
 import Expression
 import Settings.Util
 
index 0f8955e..748e544 100644 (file)
@@ -3,6 +3,7 @@ module Settings.Builders.Gcc (gccArgs, gccMArgs) where
 import Base
 import Util
 import Builder
+import Switches (stagedBuilder)
 import Expression
 import Oracles.PackageData
 import Settings.Util
@@ -10,7 +11,6 @@ import Settings.Util
 -- TODO: check code duplication
 gccArgs :: Args
 gccArgs = stagedBuilder Gcc ? do
-    path   <- getTargetPath
     file   <- getFile
     src    <- getSource
     ccArgs <- getPkgDataList CcArgs
@@ -24,28 +24,25 @@ gccArgs = stagedBuilder Gcc ? do
 -- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
 gccMArgs :: Args
 gccMArgs = stagedBuilder GccM ? do
-    path   <- getTargetPath
     file   <- getFile
     src    <- getSource
     ccArgs <- getPkgDataList CcArgs
-    mconcat
-        [ arg "-E"
-        , arg "-MM"
-        , append ccArgs -- TODO: remove? any other flags?
-        , includeGccArgs
-        , arg "-MF"
-        , arg file
-        , arg "-MT"
-        , arg $ dropExtension file -<.> "o"
-        , arg "-x"
-        , arg "c"
-        , arg src ]
+    mconcat [ arg "-E"
+            , arg "-MM"
+            , append ccArgs -- TODO: remove? any other flags?
+            , includeGccArgs
+            , arg "-MF"
+            , arg file
+            , arg "-MT"
+            , arg $ dropExtension file -<.> "o"
+            , arg "-x"
+            , arg "c"
+            , arg src ]
 
 includeGccArgs :: Args
 includeGccArgs = do
     path    <- getTargetPath
     pkgPath <- getPackagePath
-    pkg     <- getPackage
     iDirs   <- getPkgDataList IncludeDirs
     dDirs   <- getPkgDataList DepIncludeDirs
     mconcat
index c686d13..af20c7a 100644 (file)
@@ -4,7 +4,7 @@ import Way
 import Util
 import Stage
 import Builder
-import Switches
+import Switches (stagedBuilder, splitObjects, stage0)
 import Expression
 import Oracles.Flag
 import Oracles.PackageData
@@ -32,7 +32,7 @@ ghcMArgs = stagedBuilder GhcM ? do
     mconcat [ arg "-M"
             , commonGhcArgs
             , arg "-dep-makefile", arg file
-            , append $ concat [ ["-dep-suffix", wayPrefix way] | way <- ways ]
+            , append $ concat [ ["-dep-suffix", wayPrefix w] | w <- ways ]
             , append srcs ]
 
 -- This is included into ghcArgs, ghcMArgs and haddockArgs.
@@ -78,18 +78,16 @@ packageGhcArgs = do
     stage              <- getStage
     supportsPackageKey <- getFlag SupportsPackageKey
     pkgKey             <- getPkgData PackageKey
-    pkgDepKeys         <- getPkgDataList DepKeys
-    pkgDeps            <- getPkgDataList Deps
+    pkgDepIds          <- getPkgDataList DepIds
     mconcat
         [ arg "-hide-all-packages"
         , arg "-no-user-package-db"
         , arg "-include-pkg-deps"
         , stage0 ? arg "-package-db libraries/bootstrapping.conf"
         , if supportsPackageKey || stage /= Stage0
-          then mconcat [ arg $ "-this-package-key " ++ pkgKey
-                       , append $ map ("-package-key " ++) pkgDepKeys ]
-          else mconcat [ arg $ "-package-name " ++ pkgKey
-                       , append $ map ("-package " ++) pkgDeps ]]
+          then arg $ "-this-package-key " ++ pkgKey
+          else arg $ "-package-name "     ++ pkgKey
+        , append $ map ("-package-id " ++) pkgDepIds ]
 
 includeGhcArgs :: Args
 includeGhcArgs = do
index 54b1176..623110b 100644 (file)
@@ -68,13 +68,12 @@ libraryArgs = do
 
 configureArgs :: Args
 configureArgs = do
-    stage <- getStage
     let conf key = appendSubD $ "--configure-option=" ++ key
         cFlags   = mconcat [ ccArgs
                            , remove ["-Werror"]
-                           , argSettingList $ ConfCcArgs stage ]
-        ldFlags  = ldArgs <> (argSettingList $ ConfGccLinkerArgs stage)
-        cppFlags = cppArgs <> (argSettingList $ ConfCppArgs stage)
+                           , argStagedSettingList ConfCcArgs ]
+        ldFlags  = ldArgs  <> (argStagedSettingList ConfGccLinkerArgs)
+        cppFlags = cppArgs <> (argStagedSettingList ConfCppArgs)
     mconcat
         [ conf "CFLAGS"   cFlags
         , conf "LDFLAGS"  ldFlags
@@ -86,7 +85,7 @@ configureArgs = do
         , conf "--with-gmp-libraries"   $ argSettingList GmpLibDirs
         -- TODO: why TargetPlatformFull and not host?
         , crossCompiling ? (conf "--host" $ argSetting TargetPlatformFull)
-        , conf "--with-cc" . argM . builderPath $ Gcc stage ]
+        , conf "--with-cc" $ argStagedBuilderPath Gcc ]
 
 bootPackageDbArgs :: Args
 bootPackageDbArgs = do
@@ -128,16 +127,21 @@ ghcIncludeDirs = [ "includes", "includes/dist"
 cppArgs :: Args
 cppArgs = append $ map ("-I" ++) ghcIncludeDirs
 
+-- TODO: Is this needed?
+-- ifeq "$(GMP_PREFER_FRAMEWORK)" "YES"
+-- libraries/integer-gmp_CONFIGURE_OPTS += --with-gmp-framework-preferred
+-- endif
+
 -- TODO: move this somewhere
 customPackageArgs :: Args
 customPackageArgs = do
-    stage   <- getStage
-    rtsWays <- getRtsWays
+    nextStage <- fmap succ getStage
+    rtsWays   <- getRtsWays
     mconcat
-        [ package integerGmp2 ?
+        [ package integerGmp ?
           mconcat [ windowsHost ? builder GhcCabal ?
                     arg "--configure-option=--with-intree-gmp"
-                  , appendCcArgs ["-I" ++ pkgPath integerGmp2 -/- "gmp"] ]
+                  , appendCcArgs ["-I" ++ pkgPath integerGmp -/- "gmp"] ]
 
         , package base ?
           builder GhcCabal ?
@@ -148,8 +152,8 @@ customPackageArgs = do
 
         , package compiler ?
           builder GhcCabal ?
-          mconcat [ arg $ "--ghc-option=-DSTAGE=" ++ show (succ stage)
-                  , arg $ "--flags=stage" ++ show (succ stage)
+          mconcat [ arg $ "--ghc-option=-DSTAGE=" ++ show nextStage
+                  , arg $ "--flags=stage" ++ show nextStage
                   , arg "--disable-library-for-ghci"
                   , targetOs "openbsd" ? arg "--ld-options=-E"
                   , flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS"
@@ -173,7 +177,7 @@ customPackageArgs = do
         ]
 
 withBuilderKey :: Builder -> String
-withBuilderKey builder = case builder of
+withBuilderKey b = case b of
     Ar       -> "--with-ar="
     Ld       -> "--with-ld="
     Gcc _    -> "--with-gcc="
@@ -186,12 +190,10 @@ withBuilderKey builder = case builder of
 
 -- Expression 'with Gcc' appends "--with-gcc=/path/to/gcc" and needs Gcc.
 with :: Builder -> Args
-with builder = specified builder ? do
-    path <- lift $ builderPath builder
-    lift $ needBuilder builder
-    append [withBuilderKey builder ++ path]
+with b = specified b ? do
+    path <- lift $ builderPath b
+    lift $ needBuilder laxDependencies b
+    append [withBuilderKey b ++ path]
 
 withStaged :: (Stage -> Builder) -> Args
-withStaged sb = do
-    stage <- getStage
-    with $ sb stage
+withStaged sb = (with . sb) =<< getStage
index 8225867..94a1669 100644 (file)
@@ -4,7 +4,7 @@ import Base
 import Util
 import Builder
 import Package
-import Switches
+import Switches (builder, package, stage1)
 import Expression
 import Oracles.PackageData
 import Settings.Util
@@ -35,7 +35,7 @@ haddockArgs = builder Haddock ? do
         , append $ map ("--hide=" ++) hidden
         , append $ [ "--read-interface=../" ++ dep
                      ++ ",../" ++ dep ++ "/src/%{MODULE/./-}.html\\#%{NAME},"
-                     ++ pkgHaddockPath depPkg
+                     ++ pkgHaddockFile depPkg
                    | (dep, depName) <- zip deps depNames
                    , Just depPkg <- [findKnownPackage depName] ]
         , append [ "--optghc=" ++ opt | opt <- ghcOpts ]
@@ -51,6 +51,7 @@ customPackageArgs :: Args
 customPackageArgs = mconcat
     [ package compiler ? stage1 ?
       arg "--optghc=-DSTAGE=2" ]
+    -- TODO: move to getPackageSources
     -- , package ghcPrim  ? stage1 ?
     --   arg "libraries/ghc-prim/dist-install/build/autogen/GHC/Prim.hs" ]
 
index 7a05072..e21a262 100644 (file)
@@ -1,18 +1,16 @@
 module Settings.Builders.Ld (ldArgs) where
 
 import Builder
+import Switches (builder)
 import Expression
 import Oracles.Setting
 import Settings.Util
 
 ldArgs :: Args
 ldArgs = builder Ld ? do
-    stage    <- getStage
-    file     <- getFile
-    objs     <- getSources
-    confArgs <- getSettingList $ ConfLdLinkerArgs stage
-    mconcat [ append confArgs
+    file <- getFile
+    objs <- getSources
+    mconcat [ argStagedSettingList ConfLdLinkerArgs
             , arg "-r"
-            , arg "-o"
-            , arg file
+            , arg "-o", arg file
             , append objs ]
index 10f0f67..568ec05 100644 (file)
@@ -1,5 +1,5 @@
 module Settings.TargetDirectory (
-    targetDirectory, targetPath, pkgHaddockPath
+    targetDirectory, targetPath, pkgHaddockFile
     ) where
 
 import Base
@@ -18,6 +18,6 @@ targetPath stage pkg = pkgPath pkg -/- targetDirectory stage pkg
 
 -- Relative path to a package haddock file, e.g.:
 -- "libraries/array/dist-install/doc/html/array/array.haddock"
-pkgHaddockPath :: Package -> FilePath
-pkgHaddockPath pkg @ (Package name _) =
+pkgHaddockFile :: Package -> FilePath
+pkgHaddockFile pkg @ (Package name _) =
     targetPath Stage1 pkg -/- "doc/html" -/- name -/- name <.> "haddock"
index 3646994..e67afc3 100644 (file)
@@ -7,6 +7,7 @@ module Settings.User (
 
 import Stage
 import Package
+import Switches
 import Expression
 import Settings.Default
 
@@ -36,7 +37,7 @@ userTargetDirectory = defaultTargetDirectory
 
 -- Choose integer library: integerGmp, integerGmp2 or integerSimple
 integerLibrary :: Package
-integerLibrary = integerGmp2
+integerLibrary = integerGmp
 
 -- User-defined flags. Note the following type semantics:
 -- * Bool: a plain Boolean flag whose value is known at compile time
@@ -62,6 +63,10 @@ ghciWithDebugger = False
 ghcProfiled :: Bool
 ghcProfiled = False
 
+-- When laxDependencies flag is set to True, dependencies on the GHC executable
+-- are turned into order-only dependencies to avoid needless recompilation when
+-- making changes to GHC's sources. In certain situations this can lead to build
+-- failures, in which case you should reset the flag (at least temporarily).
 laxDependencies :: Bool
 laxDependencies = False
 
index 52ebe18..81b7b69 100644 (file)
@@ -1,30 +1,23 @@
 module Settings.Util (
-    -- Primitive settings elements
     arg, argM,
-    argSetting, argSettingList,
-    getFlag, getSetting, getSettingList,
+    argSetting, argSettingList, argStagedSettingList, argStagedBuilderPath,
+    getFlag, getSetting, getSettingList, getStagedSettingList,
     getPkgData, getPkgDataList,
-    getPackagePath, getTargetDirectory, getTargetPath, getHaddockPath,
+    getPackagePath, getTargetDirectory, getTargetPath, getHaddockFile,
     getPackageSources,
-    appendCcArgs,
-    needBuilder
-    -- argBuilderPath, argStagedBuilderPath,
-    -- argPackageKey, argPackageDeps, argPackageDepKeys, argSrcDirs,
-    -- argIncludeDirs, argDepIncludeDirs,
-    -- argConcat, argConcatPath, argConcatSpace,
-    -- argPairs, argPrefix, argPrefixPath,
-    -- argPackageConstraints,
+    appendCcArgs
     ) where
 
 import Base
 import Util
+import Stage
 import Builder
 import Package
+import Switches
 import Expression
 import Oracles.Flag
 import Oracles.Setting
 import Oracles.PackageData
-import Settings.User
 import Settings.TargetDirectory
 import Data.List
 import Data.Function
@@ -34,7 +27,7 @@ arg :: String -> Args
 arg = append . return
 
 argM :: Action String -> Args
-argM = appendM . fmap return
+argM = (arg =<<) . lift
 
 argSetting :: Setting -> Args
 argSetting = argM . setting
@@ -42,6 +35,12 @@ argSetting = argM . setting
 argSettingList :: SettingList -> Args
 argSettingList = appendM . settingList
 
+argStagedSettingList :: (Stage -> SettingList) -> Args
+argStagedSettingList ss = (argSettingList . ss) =<< getStage
+
+argStagedBuilderPath :: (Stage -> Builder) -> Args
+argStagedBuilderPath sb = (argM . builderPath . sb) =<< getStage
+
 getFlag :: Flag -> Expr Bool
 getFlag = lift . flag
 
@@ -51,17 +50,14 @@ getSetting = lift . setting
 getSettingList :: SettingList -> Expr [String]
 getSettingList = lift . settingList
 
+getStagedSettingList :: (Stage -> SettingList) -> Expr [String]
+getStagedSettingList ss = lift . settingList . ss =<< getStage
+
 getPkgData :: (FilePath -> PackageData) -> Expr String
-getPkgData key = do
-    stage <- getStage
-    pkg   <- getPackage
-    lift . pkgData . key $ targetPath stage pkg
+getPkgData key = lift . pkgData . key =<< getTargetPath
 
 getPkgDataList :: (FilePath -> PackageDataList) -> Expr [String]
-getPkgDataList key = do
-    stage <- getStage
-    pkg   <- getPackage
-    lift . pkgDataList . key $ targetPath stage pkg
+getPkgDataList key = lift . pkgDataList . key =<< getTargetPath
 
 getPackagePath :: Expr FilePath
 getPackagePath = liftM pkgPath getPackage
@@ -72,18 +68,18 @@ getTargetDirectory = liftM2 targetDirectory getStage getPackage
 getTargetPath :: Expr FilePath
 getTargetPath = liftM2 targetPath getStage getPackage
 
-getHaddockPath :: Expr FilePath
-getHaddockPath = liftM pkgHaddockPath getPackage
+getHaddockFile :: Expr FilePath
+getHaddockFile = liftM pkgHaddockFile getPackage
 
 -- Find all Haskell source files for the current target
 getPackageSources :: Expr [FilePath]
 getPackageSources = do
-    path    <- getTargetPath
-    pkgPath <- getPackagePath
-    srcDirs <- getPkgDataList SrcDirs
+    path        <- getTargetPath
+    packagePath <- getPackagePath
+    srcDirs     <- getPkgDataList SrcDirs
 
     let buildPath = path -/- "build"
-        dirs      = (buildPath -/- "autogen") : map (pkgPath -/-) srcDirs
+        dirs      = (buildPath -/- "autogen") : map (packagePath -/-) srcDirs
 
     (foundSources, missingSources) <- findModuleFiles dirs "*hs"
 
@@ -127,20 +123,8 @@ findModuleFiles dirs extension = do
 -- Pass arguments to Gcc and corresponding lists of sub-arguments of GhcCabal
 appendCcArgs :: [String] -> Args
 appendCcArgs xs = do
-    stage <- getStage
-    mconcat [ builder (Gcc stage)  ? append xs
-            , builder (GccM stage) ? append xs
-            , builder GhcCabal     ? appendSub "--configure-option=CFLAGS" xs
-            , builder GhcCabal     ? appendSub "--gcc-options" xs ]
-
--- Make sure a builder exists on the given path and rebuild it if out of date.
--- If laxDependencies is true (Settings/User.hs) then we do not rebuild GHC
--- even if it is out of date (can save a lot of build time when changing GHC).
-needBuilder :: Builder -> Action ()
-needBuilder ghc @ (Ghc stage) = do
-    path <- builderPath ghc
-    if laxDependencies then orderOnly [path] else need [path]
-
-needBuilder builder = do
-    path <- builderPath builder
-    need [path]
+    mconcat [ stagedBuilder Gcc  ? append xs
+            , stagedBuilder GccM ? append xs
+            , builder GhcCabal   ? appendSub "--configure-option=CFLAGS" xs
+            , builder GhcCabal   ? appendSub "--gcc-options" xs ]
+
index 0ea3432..d6e541e 100644 (file)
@@ -1,27 +1,18 @@
-module Settings.Ways (
-    ways, getWays,
-    rtsWays, getRtsWays
-    ) where
+module Settings.Ways (getWays, getRtsWays) where
 
 import Way
 import Stage
 import Switches
 import Expression
 import Oracles.Flag
-import Settings.User hiding (parallel)
+import Settings.User
 
 -- Combining default ways with user modifications
-ways :: Ways
-ways = defaultWays <> userWays
-
-rtsWays :: Ways
-rtsWays = defaultRtsWays <> userRtsWays
-
 getWays :: Expr [Way]
-getWays = fromDiffExpr ways
+getWays = fromDiffExpr $ defaultWays <> userWays
 
 getRtsWays :: Expr [Way]
-getRtsWays = fromDiffExpr rtsWays
+getRtsWays = fromDiffExpr $ defaultRtsWays <> userRtsWays
 
 -- These are default ways
 defaultWays :: Ways
index b78592a..b39fc6c 100644 (file)
@@ -40,20 +40,18 @@ a -/- b = unifyPath $ a </> b
 
 infixr 6 -/-
 
--- (chunksOfSize size ss) splits a list of strings 'ss' into chunks not
+-- (chunksOfSize size strings) splits a given list of strings into chunks not
 -- exceeding the given 'size'.
 chunksOfSize :: Int -> [String] -> [[String]]
 chunksOfSize _    [] = []
-chunksOfSize size ss = reverse chunk : chunksOfSize size rest
+chunksOfSize size strings = reverse chunk : chunksOfSize size rest
   where
-    (chunk, rest) = go [] 0 ss
-    go chunk _         []     = (chunk, [])
-    go chunk chunkSize (s:ss) = let newSize = chunkSize + length s
-                                    (newChunk, rest) = go (s:chunk) newSize ss
-                                in
-                                if newSize > size
-                                then (chunk   , s:ss)
-                                else (newChunk, rest)
+    (chunk, rest) = go [] 0 strings
+    go res _         []     = (res, [])
+    go res chunkSize (s:ss) =
+        if newSize > size then (chunk, s:ss) else go (s:res) newSize ss
+      where
+        newSize = chunkSize + length s
 
 -- A more colourful version of Shake's putNormal
 putColoured :: Color -> String -> Action ()