Clean up code, add comments.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sat, 22 Aug 2015 23:04:55 +0000 (00:04 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Sat, 22 Aug 2015 23:04:55 +0000 (00:04 +0100)
29 files changed:
src/Base.hs
src/Expression.hs
src/Oracles/ArgsHash.hs
src/Oracles/Config/Flag.hs
src/Oracles/Config/Setting.hs
src/Oracles/Dependencies.hs
src/Oracles/PackageData.hs
src/Oracles/PackageDeps.hs
src/Oracles/WindowsRoot.hs
src/Predicates.hs
src/Rules.hs
src/Rules/Actions.hs
src/Rules/Dependencies.hs
src/Rules/Documentation.hs
src/Settings.hs
src/Settings/Args.hs
src/Settings/Builders/Ar.hs
src/Settings/Builders/Gcc.hs
src/Settings/Builders/Ghc.hs
src/Settings/Builders/GhcCabal.hs
src/Settings/Builders/GhcPkg.hs
src/Settings/Builders/Haddock.hs
src/Settings/Builders/Ld.hs
src/Settings/Packages.hs
src/Settings/TargetDirectory.hs
src/Settings/User.hs
src/Settings/Util.hs [deleted file]
src/Settings/Ways.hs
src/Target.hs

index 13483ce..896ddc9 100644 (file)
@@ -1,6 +1,7 @@
 module Base (
     module Control.Applicative,
     module Control.Monad.Extra,
+    module Control.Monad.Reader,
     module Data.Char,
     module Data.Function,
     module Data.List,
@@ -22,6 +23,7 @@ module Base (
 
 import Control.Applicative
 import Control.Monad.Extra
+import Control.Monad.Reader
 import Data.Char
 import Data.Function
 import Data.List
index b870a1d..f3d08b5 100644 (file)
@@ -1,25 +1,21 @@
 {-# LANGUAGE FlexibleInstances #-}
 module Expression (
     module Base,
-    module Control.Monad.Reader,
     module Builder,
     module Package,
     module Stage,
     module Way,
     Expr, DiffExpr, fromDiffExpr,
-    Predicate, (?), applyPredicate,
-    Args, Ways, Packages,
+    Predicate, (?), applyPredicate, Args, Ways, Packages,
     Target, PartialTarget (..), fromPartial, fullTarget, fullTargetWithWay,
-    apply, append, appendM, remove,
-    appendSub, appendSubD, filterSub, removeSub,
+    apply, append, arg, remove, appendSub, appendSubD, filterSub, removeSub,
     interpret, interpretPartial, interpretWithStage, interpretDiff,
-    getStage, getPackage, getBuilder, getFiles, getFile,
-    getSources, getSource, getWay
+    getStage, getPackage, getBuilder, getFiles, getSources, getWay,
+    getSource, getFile
     ) where
 
 import Base
 import Builder
-import Control.Monad.Reader
 import Package
 import Stage
 import Target
@@ -72,6 +68,10 @@ applyPredicate predicate expr = do
     bool <- predicate
     if bool then expr else return mempty
 
+-- Add a single String argument to Args
+arg :: String -> Args
+arg = append . return
+
 -- A convenient operator for predicate application
 class PredicateLike a where
     (?)  :: Monoid m => a -> Expr m -> Expr m
@@ -87,10 +87,6 @@ instance PredicateLike Bool where
 instance PredicateLike (Action Bool) where
     (?)  = applyPredicate . lift
 
--- A monadic version of append
-appendM :: Monoid a => Action a -> DiffExpr a
-appendM = (append =<<) . lift
-
 -- appendSub appends a list of sub-arguments to all arguments starting with a
 -- given prefix. If there is no argument with such prefix then a new argument
 -- of the form 'prefix=listOfSubarguments' is appended to the expression.
index 937f7ae..bc29031 100644 (file)
@@ -1,12 +1,10 @@
 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-module Oracles.ArgsHash (
-    checkArgsHash, argsHashOracle
-    ) where
+module Oracles.ArgsHash (checkArgsHash, argsHashOracle) where
 
-import Target
 import Expression
 import Settings
 import Settings.Args
+import Target
 
 newtype ArgsHashKey = ArgsHashKey Target
     deriving (Show, Eq, Typeable, Binary, Hashable, NFData)
index 80d8c6a..b73a687 100644 (file)
@@ -1,5 +1,5 @@
 module Oracles.Config.Flag (
-    Flag (..), flag,
+    Flag (..), flag, getFlag,
     crossCompiling, gccIsClang, gccGe46,
     platformSupportsSharedLibs, ghcWithSMP, ghcWithNativeCodeGen
     ) where
@@ -8,24 +8,24 @@ import Base
 import Oracles.Config
 import Oracles.Config.Setting
 
-data Flag = GccIsClang
+data Flag = CrossCompiling
+          | GccIsClang
           | GccLt46
-          | CrossCompiling
-          | SupportsPackageKey
+          | GhcUnregisterised
           | SolarisBrokenShld
           | SplitObjectsBroken
-          | GhcUnregisterised
+          | SupportsPackageKey
 
 flag :: Flag -> Action Bool
 flag f = do
     key <- return $ case f of
+        CrossCompiling     -> "cross-compiling"
         GccIsClang         -> "gcc-is-clang"
         GccLt46            -> "gcc-lt-46"
-        CrossCompiling     -> "cross-compiling"
-        SupportsPackageKey -> "supports-package-key"
+        GhcUnregisterised  -> "ghc-unregisterised"
         SolarisBrokenShld  -> "solaris-broken-shld"
         SplitObjectsBroken -> "split-objects-broken"
-        GhcUnregisterised  -> "ghc-unregisterised"
+        SupportsPackageKey -> "supports-package-key"
     value <- askConfigWithDefault key . putError
         $ "\nFlag '" ++ key ++ "' not set in configuration files."
     unless (value == "YES" || value == "NO") . putError
@@ -33,6 +33,9 @@ flag f = do
         ++ "' instead of 'YES' or 'NO'."
     return $ value == "YES"
 
+getFlag :: Flag -> ReaderT a Action Bool
+getFlag = lift . flag
+
 crossCompiling :: Action Bool
 crossCompiling = flag CrossCompiling
 
index a084a16..27b2d89 100644 (file)
@@ -1,6 +1,6 @@
 module Oracles.Config.Setting (
     Setting (..), SettingList (..),
-    setting, settingList,
+    setting, settingList, getSetting, getSettingList,
     targetPlatform, targetPlatforms, targetOs, targetOss, notTargetOs,
     targetArchs, windowsHost, notWindowsHost, ghcWithInterpreter,
     ghcEnableTablesNextToCode, cmdLineLengthLimit
@@ -54,6 +54,12 @@ settingList key = fmap words $ askConfig $ case key of
     GmpIncludeDirs          -> "gmp-include-dirs"
     GmpLibDirs              -> "gmp-lib-dirs"
 
+getSetting :: Setting -> ReaderT a Action String
+getSetting = lift . setting
+
+getSettingList :: SettingList -> ReaderT a Action [String]
+getSettingList = lift . settingList
+
 matchSetting :: Setting -> [String] -> Action Bool
 matchSetting key values = do
     value <- setting key
index 8a7e3fe..d0f926d 100644 (file)
@@ -1,9 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-
-module Oracles.Dependencies (
-    dependencies,
-    dependenciesOracle
-    ) where
+module Oracles.Dependencies (dependencies, dependenciesOracle) where
 
 import Base
 import qualified Data.HashMap.Strict as Map
index 94eab45..e3c1eb5 100644 (file)
@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-
 module Oracles.PackageData (
     PackageData (..), PackageDataList (..),
     pkgData, pkgDataList, packageDataOracle
index 10e7027..1898d21 100644 (file)
@@ -1,9 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-
-module Oracles.PackageDeps (
-    packageDeps,
-    packageDepsOracle
-    ) where
+module Oracles.PackageDeps (packageDeps, packageDepsOracle) where
 
 import Base
 import Package
index 5f4f4cd..51cb516 100644 (file)
@@ -1,8 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-
-module Oracles.WindowsRoot (
-    windowsRoot, windowsRootOracle
-    ) where
+module Oracles.WindowsRoot (windowsRoot, windowsRootOracle) where
 
 import Base
 
index 5bc0aed..00c12ca 100644 (file)
@@ -1,33 +1,36 @@
 module Predicates (
+    module GHC,
+    module Oracles.Config.Flag,
+    module Oracles.Config.Setting,
     stage, package, builder, stagedBuilder, file, way,
-    stage0, stage1, stage2, notStage, notStage0,
-    registerPackage, splitObjects
+    stage0, stage1, stage2, notStage0, registerPackage, splitObjects
     ) where
 
 import Expression
 import GHC
-import Oracles
+import Oracles.Config.Flag
+import Oracles.Config.Setting
 
--- Basic predicates (see Switches.hs for derived predicates)
+-- Basic predicates
 stage :: Stage -> Predicate
-stage s = liftM (s ==) getStage
+stage s = fmap (s ==) getStage
 
 package :: Package -> Predicate
-package p = liftM (p ==) getPackage
+package p = fmap (p ==) getPackage
 
 -- For unstaged builders, e.g. GhcCabal
 builder :: Builder -> Predicate
-builder b = liftM (b ==) getBuilder
+builder b = fmap (b ==) getBuilder
 
 -- For staged builders, e.g. Ghc Stage
 stagedBuilder :: (Stage -> Builder) -> Predicate
 stagedBuilder sb = (builder . sb) =<< getStage
 
 file :: FilePattern -> Predicate
-file f = liftM (any (f ?==)) getFiles
+file f = fmap (any (f ?==)) getFiles
 
 way :: Way -> Predicate
-way w = liftM (w ==) getWay
+way w = fmap (w ==) getWay
 
 -- Derived predicates
 stage0 :: Predicate
@@ -39,11 +42,8 @@ stage1 = stage Stage1
 stage2 :: Predicate
 stage2 = stage Stage2
 
-notStage :: Stage -> Predicate
-notStage = liftM not . stage
-
 notStage0 :: Predicate
-notStage0 = liftM not stage0
+notStage0 = fmap not stage0
 
 -- TODO: Actually, we don't register compiler in some circumstances -- fix.
 registerPackage :: Predicate
@@ -52,9 +52,9 @@ registerPackage = return True
 splitObjects :: Predicate
 splitObjects = do
     goodStage <- notStage0 -- We don't split bootstrap (stage 0) packages
-    goodPkg   <- liftM not $ package compiler -- We don't split compiler
-    broken    <- lift $ flag SplitObjectsBroken
-    ghcUnreg  <- lift $ flag GhcUnregisterised
+    goodPkg   <- fmap not $ package compiler -- We don't split compiler
+    broken    <- getFlag SplitObjectsBroken
+    ghcUnreg  <- getFlag GhcUnregisterised
     goodArch  <- lift $ targetArchs [ "i386", "x86_64", "powerpc", "sparc" ]
     goodOs    <- lift $ targetOss   [ "mingw32", "cygwin32", "linux", "darwin"
                                     , "solaris2", "freebsd", "dragonfly"
index c713c7d..26e57bd 100644 (file)
@@ -17,16 +17,16 @@ generateTargets = action $ do
             libName     <- interpretPartial target $ getPkgData LibName
             needGhciLib <- interpretPartial target $ getPkgData BuildGhciLib
             needHaddock <- interpretPartial target buildHaddock
-            let ghciLib = [ buildPath -/- "HS" ++ libName <.> "o"
-                          | needGhciLib == "YES" && stage /= Stage0 ]
-                haddock = [ pkgHaddockFile pkg | needHaddock ]
-
-            ways <- interpretPartial target getWays
+            ways        <- interpretPartial target getWays
+            let ghciLib = buildPath -/- "HS" ++ libName <.> "o"
+                haddock = pkgHaddockFile pkg
             libs <- forM ways $ \way -> do
                 extension <- libsuf way
                 return $ buildPath -/- "libHS" ++ libName <.> extension
 
-            return $ ghciLib ++ libs ++ haddock
+            return $  [ ghciLib | needGhciLib == "YES" && stage == Stage1 ]
+                   ++ [ haddock | needHaddock          && stage == Stage1 ]
+                   ++ libs
 
     need $ reverse targets
 
index 827e803..4285831 100644 (file)
@@ -5,6 +5,7 @@ import Oracles
 import Oracles.ArgsHash
 import Settings
 import Settings.Args
+import Settings.Builders.Ar
 import qualified Target
 
 -- Build a given target using an appropriate builder and acquiring necessary
index f15bd05..c9b5b89 100644 (file)
@@ -31,4 +31,3 @@ buildPackageDependencies _ target @ (PartialTarget stage pkg) =
             cDeps <- fmap concat $ mapM readFile' cDepFiles
             hDeps <- readFile' hDepFile
             writeFileChanged file $ cDeps ++ hDeps
-
index 2137cae..81e3140 100644 (file)
@@ -10,11 +10,10 @@ import Settings
 -- All of them go into the 'doc' subdirectory. Pedantically tracking all built
 -- files in the Shake databases seems fragile and unnecesarry.
 buildPackageDocumentation :: Resources -> PartialTarget -> Rules ()
-buildPackageDocumentation _ target @ (PartialTarget stage pkg) =
+buildPackageDocumentation _ target @ (PartialTarget _ pkg) =
     let cabalFile   = pkgCabalFile pkg
         haddockFile = pkgHaddockFile pkg
-    in when (stage == Stage1) $ do
-
+    in do
         haddockFile %> \file -> do
             whenM (specified HsColour) $ do
                 need [cabalFile]
@@ -27,13 +26,6 @@ buildPackageDocumentation _ target @ (PartialTarget stage pkg) =
             let haddockWay = if dynamicGhcPrograms then dynamic else vanilla
             build $ fullTargetWithWay target Haddock haddockWay srcs [file]
 
--- $$($1_PACKAGE)-$$($1_$2_VERSION)_HADDOCK_DEPS =
---    $$(foreach n,$$($1_$2_DEPS)
---        ,$$($$n_HADDOCK_FILE) $$($$n_dist-install_$$(HADDOCK_WAY)_LIB))
-
--- $$($$($1_PACKAGE)-$$($1_$2_VERSION)_HADDOCK_FILE) :
---     $$$$($$($1_PACKAGE)-$$($1_$2_VERSION)_HADDOCK_DEPS) | $$$$(dir $$$$@)/.
-
 -- # Make the haddocking depend on the library .a file, to ensure
 -- # that we wait until the library is fully built before we haddock it
 -- $$($$($1_PACKAGE)-$$($1_$2_VERSION)_HADDOCK_FILE) : $$($1_$2_$$(HADDOCK_WAY)_LIB)
index 24ff0e6..1a35a94 100644 (file)
@@ -2,12 +2,78 @@ module Settings (
     module Settings.Packages,
     module Settings.TargetDirectory,
     module Settings.User,
-    module Settings.Util,
-    module Settings.Ways
+    module Settings.Ways,
+    getPkgData, getPkgDataList,
+    getPackagePath, getTargetDirectory, getTargetPath, getPackageSources,
     ) where
 
+import Expression
+import Oracles
 import Settings.Packages
 import Settings.TargetDirectory
 import Settings.User
-import Settings.Util
 import Settings.Ways
+
+getPackagePath :: Expr FilePath
+getPackagePath = liftM pkgPath getPackage
+
+getTargetDirectory :: Expr FilePath
+getTargetDirectory = liftM2 targetDirectory getStage getPackage
+
+getTargetPath :: Expr FilePath
+getTargetPath = liftM2 targetPath getStage getPackage
+
+getPkgData :: (FilePath -> PackageData) -> Expr String
+getPkgData key = lift . pkgData . key =<< getTargetPath
+
+getPkgDataList :: (FilePath -> PackageDataList) -> Expr [String]
+getPkgDataList key = lift . pkgDataList . key =<< getTargetPath
+
+-- Find all Haskell source files for the current target. TODO: simplify.
+getPackageSources :: Expr [FilePath]
+getPackageSources = do
+    path        <- getTargetPath
+    packagePath <- getPackagePath
+    srcDirs     <- getPkgDataList SrcDirs
+
+    let buildPath = path -/- "build"
+        dirs      = (buildPath -/- "autogen") : map (packagePath -/-) srcDirs
+
+    (foundSources, missingSources) <- findModuleFiles dirs "*hs"
+
+    -- Generated source files live in buildPath and have extension "hs"
+    let generatedSources = [ buildPath -/- s <.> "hs" | s <- missingSources ]
+
+    return $ foundSources ++ generatedSources
+
+-- findModuleFiles scans a list of given directories and finds files matching a
+-- given extension pattern (e.g., "*hs") that correspond to modules of the
+-- currently built package. Missing module files are returned in a separate
+-- list. The returned pair contains the following:
+-- * a list of found module files, with paths being relative to one of given
+--   directories, e.g. "codeGen/CodeGen/Platform.hs" for the compiler package.
+-- * a list of module files that have not been found, with paths being relative
+--   to the module directory, e.g. "CodeGen/Platform", and with no extension.
+findModuleFiles :: [FilePath] -> FilePattern -> Expr ([FilePath], [FilePath])
+findModuleFiles dirs extension = do
+    modules <- getPkgDataList Modules
+    let decodedMods    = sort . map decodeModule $ modules
+        modDirFiles    = map (bimap head sort . unzip)
+                       . groupBy ((==) `on` fst) $ decodedMods
+        matchExtension = (?==) ("*" <.> extension)
+
+    result <- lift . fmap concat . forM dirs $ \dir -> do
+        todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
+        forM todo $ \(mDir, mFiles) -> do
+            let fullDir = dir -/- mDir
+            files <- fmap (filter matchExtension) $ getDirectoryContents fullDir
+            let cmp fe f = compare (dropExtension fe) f
+                found    = intersectOrd cmp files mFiles
+            return (map (fullDir -/-) found, (mDir, map dropExtension found))
+
+    let foundFiles   = concatMap fst result
+        foundMods    = [ (d, f) | (d, fs) <- map snd result, f <- fs ]
+        missingMods  = decodedMods `minusOrd` sort foundMods
+        missingFiles = map (uncurry (-/-)) missingMods
+
+    return (foundFiles, missingFiles)
index a2b7c13..4e55a3d 100644 (file)
@@ -1,7 +1,7 @@
-module Settings.Args (args, getArgs, arPersistentArgsCount) where
+module Settings.Args (getArgs) where
 
 import Expression
-import Settings
+import Settings.User
 import Settings.Builders.Ar
 import Settings.Builders.Ld
 import Settings.Builders.Ghc
@@ -10,11 +10,8 @@ import Settings.Builders.GhcPkg
 import Settings.Builders.Haddock
 import Settings.Builders.GhcCabal
 
-args :: Args
-args = defaultArgs <> userArgs
-
 getArgs :: Expr [String]
-getArgs = fromDiffExpr args
+getArgs = fromDiffExpr $ defaultArgs <> userArgs
 
 -- TODO: add all other settings
 -- TODO: add src-hc-args = -H32m -O
index 4bde3f8..617d4e1 100644 (file)
@@ -3,7 +3,6 @@ module Settings.Builders.Ar (arArgs, arPersistentArgsCount) where
 import Builder
 import Expression
 import Predicates (builder)
-import Settings.Util
 
 arArgs :: Args
 arArgs = builder Ar ? do
index 1900ff1..a98a1f6 100644 (file)
@@ -1,18 +1,15 @@
 module Settings.Builders.Gcc (gccArgs, gccMArgs) where
 
 import Expression
+import Oracles
 import Predicates (stagedBuilder)
-import Oracles.PackageData
-import Settings.Util
+import Settings
 
--- TODO: check code duplication
 gccArgs :: Args
 gccArgs = stagedBuilder Gcc ? do
-    file   <- getFile
-    src    <- getSource
-    ccArgs <- getPkgDataList CcArgs
-    mconcat [ append ccArgs
-            , includeGccArgs
+    file <- getFile
+    src  <- getSource
+    mconcat [ commonGccArgs
             , arg "-c"
             , arg src
             , arg "-o"
@@ -21,13 +18,11 @@ gccArgs = stagedBuilder Gcc ? do
 -- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
 gccMArgs :: Args
 gccMArgs = stagedBuilder GccM ? do
-    file   <- getFile
-    src    <- getSource
-    ccArgs <- getPkgDataList CcArgs
+    file <- getFile
+    src  <- getSource
     mconcat [ arg "-E"
             , arg "-MM"
-            , append ccArgs -- TODO: remove? any other flags?
-            , includeGccArgs
+            , commonGccArgs
             , arg "-MF"
             , arg file
             , arg "-MT"
@@ -36,12 +31,13 @@ gccMArgs = stagedBuilder GccM ? do
             , arg "c"
             , arg src ]
 
-includeGccArgs :: Args
-includeGccArgs = do
-    pkg   <- getPackage
-    path  <- getTargetPath
-    iDirs <- getPkgDataList IncludeDirs
-    dDirs <- getPkgDataList DepIncludeDirs
-    mconcat
-        [ arg $ "-I" ++ path -/- "build/autogen"
-        , append . map (\dir -> "-I" ++ pkgPath pkg -/- dir) $ iDirs ++ dDirs ]
+commonGccArgs :: Args
+commonGccArgs = do
+    pkg    <- getPackage
+    path   <- getTargetPath
+    iDirs  <- getPkgDataList IncludeDirs
+    dDirs  <- getPkgDataList DepIncludeDirs
+    ccArgs <- getPkgDataList CcArgs
+    mconcat [ append ccArgs
+            , arg $ "-I" ++ path -/- "build/autogen"
+            , append [ "-I" ++ pkgPath pkg -/- dir | dir <- iDirs ++ dDirs ]]
index d1404a0..6ecc26d 100644 (file)
@@ -1,8 +1,8 @@
 module Settings.Builders.Ghc (ghcArgs, ghcMArgs, commonGhcArgs) where
 
 import Expression
-import Predicates (stagedBuilder, splitObjects, stage0)
 import Oracles
+import Predicates (stagedBuilder, splitObjects, stage0)
 import Settings
 
 -- TODO: add support for -dyno
@@ -33,9 +33,9 @@ ghcMArgs = stagedBuilder GhcM ? do
 commonGhcArgs :: Args
 commonGhcArgs = do
     way     <- getWay
+    path    <- getTargetPath
     hsArgs  <- getPkgDataList HsArgs
     cppArgs <- getPkgDataList CppArgs
-    path    <- getTargetPath
     let buildPath = path -/- "build"
     mconcat [ arg "-hisuf", arg $ hisuf way
             , arg "-osuf" , arg $  osuf way
index 1925daf..dd54097 100644 (file)
@@ -1,15 +1,9 @@
 module Settings.Builders.GhcCabal (
-    cabalArgs, ghcCabalHsColourArgs,
-    bootPackageDbArgs, customPackageArgs
+    cabalArgs, ghcCabalHsColourArgs, bootPackageDbArgs, customPackageArgs
     ) where
 
-import Way
-import Stage
-import Builder
-import Package
 import Expression
 import Predicates
-import Oracles
 import Settings
 
 cabalArgs :: Args
@@ -73,11 +67,10 @@ configureArgs = do
         , conf "LDFLAGS"  ldFlags
         , conf "CPPFLAGS" cppFlags
         , appendSubD "--gcc-options" $ cFlags <> ldFlags
-        , conf "--with-iconv-includes"  $ argSettingList IconvIncludeDirs
-        , conf "--with-iconv-libraries" $ argSettingList IconvLibDirs
-        , conf "--with-gmp-includes"    $ argSettingList GmpIncludeDirs
-        , conf "--with-gmp-libraries"   $ argSettingList GmpLibDirs
-        -- TODO: why TargetPlatformFull and not host?
+        , conf "--with-iconv-includes"    $ argSettingList IconvIncludeDirs
+        , conf "--with-iconv-libraries"   $ argSettingList IconvLibDirs
+        , conf "--with-gmp-includes"      $ argSettingList GmpIncludeDirs
+        , conf "--with-gmp-libraries"     $ argSettingList GmpLibDirs
         , crossCompiling ? (conf "--host" $ argSetting TargetPlatformFull)
         , conf "--with-cc" $ argStagedBuilderPath Gcc ]
 
@@ -190,3 +183,27 @@ with b = specified b ? do
 
 withStaged :: (Stage -> Builder) -> Args
 withStaged sb = (with . sb) =<< getStage
+
+argM :: Action String -> Args
+argM = (arg =<<) . lift
+
+argSetting :: Setting -> Args
+argSetting = argM . setting
+
+argSettingList :: SettingList -> Args
+argSettingList = (append =<<) . lift . settingList
+
+argStagedSettingList :: (Stage -> SettingList) -> Args
+argStagedSettingList ss = (argSettingList . ss) =<< getStage
+
+argStagedBuilderPath :: (Stage -> Builder) -> Args
+argStagedBuilderPath sb = (argM . builderPath . sb) =<< getStage
+
+-- Pass arguments to Gcc and corresponding lists of sub-arguments of GhcCabal
+appendCcArgs :: [String] -> Args
+appendCcArgs xs = do
+    mconcat [ stagedBuilder Gcc  ? append xs
+            , stagedBuilder GccM ? append xs
+            , builder GhcCabal   ? appendSub "--configure-option=CFLAGS" xs
+            , builder GhcCabal   ? appendSub "--gcc-options" xs ]
+
index fcf22c5..bfbf043 100644 (file)
@@ -1,9 +1,8 @@
 module Settings.Builders.GhcPkg (ghcPkgArgs) where
 
-import Builder
 import Expression
 import Predicates
-import Settings.Util
+import Settings
 import Settings.Builders.GhcCabal
 
 ghcPkgArgs :: Args
index fe55e0d..bc6622c 100644 (file)
@@ -1,12 +1,9 @@
 module Settings.Builders.Haddock (haddockArgs) where
 
-import Builder
-import Package
 import Expression
-import Predicates (builder, package, stage1)
-import Oracles.PackageData
-import Settings.Util
-import Settings.Packages
+import Predicates hiding (file)
+import Oracles
+import Settings
 import Settings.Builders.Ghc
 
 haddockArgs :: Args
index ea96947..68d9878 100644 (file)
@@ -1,16 +1,15 @@
 module Settings.Builders.Ld (ldArgs) where
 
-import Builder
 import Expression
 import Oracles
 import Predicates (builder)
-import Settings.Util
 
 ldArgs :: Args
 ldArgs = builder Ld ? do
     file <- getFile
     objs <- getSources
-    mconcat [ argStagedSettingList ConfLdLinkerArgs
+    args <- getSettingList . ConfLdLinkerArgs =<< getStage
+    mconcat [ append args
             , arg "-r"
             , arg "-o", arg file
             , append objs ]
index cafbd52..7f2a64b 100644 (file)
@@ -1,11 +1,8 @@
 module Settings.Packages (
-    module GHC,
     getPackages, knownPackages, findKnownPackage
     ) where
 
 import Expression
-import GHC
-import Oracles
 import Predicates
 import Settings.User
 
@@ -21,7 +18,7 @@ defaultPackages = mconcat
 
 packagesStage0 :: Packages
 packagesStage0 = mconcat
-    [ append [binPackageDb, binary, cabal, compiler, hoopl, hpc, transformers]
+    [ append [ binPackageDb, binary, cabal, compiler, hoopl, hpc, transformers ]
     , notWindowsHost ? notTargetOs "ios" ? append [terminfo] ]
 
 -- TODO: what do we do with parallel, stm, random, primitive, vector and dph?
index 265ae94..58f2d51 100644 (file)
@@ -2,9 +2,7 @@ module Settings.TargetDirectory (
     targetDirectory, targetPath, pkgHaddockFile
     ) where
 
-import Base
-import Stage
-import Package
+import Expression
 import Settings.User
 
 -- User can override the default target directory settings given below
index 6572111..f9a430c 100644 (file)
@@ -6,7 +6,6 @@ module Settings.User (
     ) where
 
 import Expression
-import GHC
 import Predicates
 
 -- No user-specific settings by default
@@ -69,4 +68,4 @@ laxDependencies :: Bool
 laxDependencies = False
 
 buildHaddock :: Predicate
-buildHaddock = stage Stage1
+buildHaddock = return True
diff --git a/src/Settings/Util.hs b/src/Settings/Util.hs
deleted file mode 100644 (file)
index c25b882..0000000
+++ /dev/null
@@ -1,125 +0,0 @@
-module Settings.Util (
-    module Settings.TargetDirectory,
-    arg, argM,
-    argSetting, argSettingList, argStagedSettingList, argStagedBuilderPath,
-    getFlag, getSetting, getSettingList, getStagedSettingList,
-    getPkgData, getPkgDataList,
-    getPackagePath, getTargetDirectory, getTargetPath, getHaddockFile,
-    getPackageSources,
-    appendCcArgs
-    ) where
-
-import Stage
-import Builder
-import Package
-import Expression
-import Predicates
-import Oracles
-import Settings.TargetDirectory
-
--- A single argument.
-arg :: String -> Args
-arg = append . return
-
-argM :: Action String -> Args
-argM = (arg =<<) . lift
-
-argSetting :: Setting -> Args
-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
-
-getSetting :: Setting -> Expr String
-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 = lift . pkgData . key =<< getTargetPath
-
-getPkgDataList :: (FilePath -> PackageDataList) -> Expr [String]
-getPkgDataList key = lift . pkgDataList . key =<< getTargetPath
-
-getPackagePath :: Expr FilePath
-getPackagePath = liftM pkgPath getPackage
-
-getTargetDirectory :: Expr FilePath
-getTargetDirectory = liftM2 targetDirectory getStage getPackage
-
-getTargetPath :: Expr FilePath
-getTargetPath = liftM2 targetPath getStage getPackage
-
-getHaddockFile :: Expr FilePath
-getHaddockFile = liftM pkgHaddockFile getPackage
-
--- Find all Haskell source files for the current target
-getPackageSources :: Expr [FilePath]
-getPackageSources = do
-    path        <- getTargetPath
-    packagePath <- getPackagePath
-    srcDirs     <- getPkgDataList SrcDirs
-
-    let buildPath = path -/- "build"
-        dirs      = (buildPath -/- "autogen") : map (packagePath -/-) srcDirs
-
-    (foundSources, missingSources) <- findModuleFiles dirs "*hs"
-
-    -- Generated source files live in buildPath and have extension "hs"
-    let generatedSources = [ buildPath -/- s <.> "hs" | s <- missingSources ]
-
-    return $ foundSources ++ generatedSources
-
--- findModuleFiles scans a list of given directories and finds files matching a
--- given extension pattern (e.g., "*hs") that correspond to modules of the
--- currently built package. Missing module files are returned in a separate
--- list. The returned pair contains the following:
--- * a list of found module files, with paths being relative to one of given
---   directories, e.g. "codeGen/CodeGen/Platform.hs" for the compiler package.
--- * a list of module files that have not been found, with paths being relative
---   to the module directory, e.g. "CodeGen/Platform", and with no extension.
-findModuleFiles :: [FilePath] -> FilePattern -> Expr ([FilePath], [FilePath])
-findModuleFiles dirs extension = do
-    modules <- getPkgDataList Modules
-    let decodedMods    = sort . map decodeModule $ modules
-        modDirFiles    = map (bimap head sort . unzip)
-                       . groupBy ((==) `on` fst) $ decodedMods
-        matchExtension = (?==) ("*" <.> extension)
-
-    result <- lift . fmap concat . forM dirs $ \dir -> do
-        todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
-        forM todo $ \(mDir, mFiles) -> do
-            let fullDir = dir -/- mDir
-            files <- fmap (filter matchExtension) $ getDirectoryContents fullDir
-            let cmp fe f = compare (dropExtension fe) f
-                found    = intersectOrd cmp files mFiles
-            return (map (fullDir -/-) found, (mDir, map dropExtension found))
-
-    let foundFiles   = concatMap fst result
-        foundMods    = [ (d, f) | (d, fs) <- map snd result, f <- fs ]
-        missingMods  = decodedMods `minusOrd` sort foundMods
-        missingFiles = map (uncurry (-/-)) missingMods
-
-    return (foundFiles, missingFiles)
-
--- Pass arguments to Gcc and corresponding lists of sub-arguments of GhcCabal
-appendCcArgs :: [String] -> Args
-appendCcArgs xs = do
-    mconcat [ stagedBuilder Gcc  ? append xs
-            , stagedBuilder GccM ? append xs
-            , builder GhcCabal   ? appendSub "--configure-option=CFLAGS" xs
-            , builder GhcCabal   ? appendSub "--gcc-options" xs ]
-
index da59f5f..cafed64 100644 (file)
@@ -1,9 +1,7 @@
 module Settings.Ways (getWays, getRtsWays) where
 
-import Stage
 import Expression
 import Predicates
-import Oracles
 import Settings.User
 
 -- Combining default ways with user modifications
@@ -17,7 +15,7 @@ getRtsWays = fromDiffExpr $ defaultRtsWays <> userRtsWays
 defaultWays :: Ways
 defaultWays = mconcat
     [                              append [vanilla] -- always build vanilla
-    , notStage Stage0            ? append [profiling]
+    , notStage0                  ? append [profiling]
     , platformSupportsSharedLibs ? append [dynamic] ]
 
 defaultRtsWays :: Ways
index 5140f91..2901ffe 100644 (file)
@@ -5,7 +5,6 @@ module Target (
 
 import Base
 import Builder
-import Control.Monad.Reader
 import GHC.Generics (Generic)
 import Package
 import Stage
@@ -52,6 +51,7 @@ fromPartial (PartialTarget s p) = Target
         files   = error "fromPartial: files not set"
     }
 
+-- Construct a full target by augmenting a PartialTarget with missing fields.
 -- Most targets are built only one way, vanilla, hence we set it by default.
 fullTarget :: PartialTarget -> Builder -> [FilePath] -> [FilePath] -> Target
 fullTarget (PartialTarget s p) b srcs fs = Target