Re-export basic data type definitions from Base
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 13 Aug 2017 02:20:46 +0000 (03:20 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 13 Aug 2017 02:20:46 +0000 (03:20 +0100)
29 files changed:
src/Base.hs
src/Builder.hs
src/Context.hs
src/Expression.hs
src/Oracles/Dependencies.hs
src/Oracles/ModuleFiles.hs
src/Oracles/Setting.hs
src/Package.hs
src/Rules/Cabal.hs
src/Rules/Clean.hs
src/Rules/Compile.hs
src/Rules/Configure.hs
src/Rules/Dependencies.hs
src/Rules/Generate.hs
src/Rules/Gmp.hs
src/Rules/Library.hs
src/Rules/Perl.hs
src/Rules/Register.hs
src/Rules/Selftest.hs
src/Rules/SourceDist.hs
src/Rules/Test.hs
src/Settings/Builders/Common.hs
src/Settings/Packages/Rts.hs
src/Settings/Path.hs
src/Stage.hs
src/Target.hs
src/UserSettings.hs
src/Util.hs
src/Way.hs

index f4f4c4b..b07ada0 100644 (file)
@@ -2,38 +2,43 @@ module Base (
     -- * General utilities
     module Control.Applicative,
     module Control.Monad.Extra,
-    module Data.Bifunctor,
-    module Data.Function,
     module Data.List.Extra,
     module Data.Maybe,
     module Data.Semigroup,
+    module Hadrian.Utilities,
 
     -- * Shake
     module Development.Shake,
     module Development.Shake.Classes,
     module Development.Shake.FilePath,
+    module Development.Shake.Util,
 
-    -- * Paths
-    configPath, configFile, sourcePath,
+    -- * Basic data types
+    module Builder,
+    module Package,
+    module Stage,
+    module Way,
 
-    -- * Miscellaneous utilities
-    unifyPath, quote, (-/-)
+    -- * Paths
+    configPath, configFile, sourcePath, configH
     ) where
 
 import Control.Applicative
 import Control.Monad.Extra
 import Control.Monad.Reader
-import Data.Bifunctor
-import Data.Function
 import Data.List.Extra
 import Data.Maybe
 import Data.Semigroup
 import Development.Shake hiding (parallel, unit, (*>), Normal)
 import Development.Shake.Classes
 import Development.Shake.FilePath
+import Development.Shake.Util
 import Hadrian.Utilities
 
--- TODO: reexport Stage, etc.?
+import Builder
+import Package
+import Stage
+import Way
 
 -- | Hadrian lives in 'hadrianPath' directory of the GHC tree.
 hadrianPath :: FilePath
@@ -43,6 +48,7 @@ hadrianPath = "hadrian"
 configPath :: FilePath
 configPath = hadrianPath -/- "cfg"
 
+-- | Path to the file with configuration settings.
 configFile :: FilePath
 configFile = configPath -/- "system.config"
 
@@ -50,3 +56,8 @@ configFile = configPath -/- "system.config"
 -- sourcePath -/- "Base.hs". We use this to `need` some of the source files.
 sourcePath :: FilePath
 sourcePath = hadrianPath -/- "src"
+
+-- TODO: change @mk/config.h@ to @shake-build/cfg/config.h@
+-- | Path to the generated @mk/config.h file.
+configH :: FilePath
+configH = "mk/config.h"
\ No newline at end of file
index ad9805d..3d00701 100644 (file)
@@ -1,13 +1,11 @@
-{-# LANGUAGE DeriveGeneric, FlexibleInstances, LambdaCase #-}
+{-# LANGUAGE DeriveGeneric, LambdaCase #-}
 module Builder (
-    CcMode (..), GhcMode (..), GhcPkgMode (..), Builder (..), isOptional, builder
+    CcMode (..), GhcMode (..), GhcPkgMode (..), Builder (..), isOptional
     ) where
 
+import Development.Shake.Classes
 import GHC.Generics
-import Hadrian.Expression
 
-import Base
-import Context
 import Stage
 
 -- | C compiler can be used in two different modes:
@@ -84,38 +82,3 @@ isOptional = \case
     HsColour -> True
     Objdump  -> True
     _        -> False
-
--- | This type class allows the user to construct both precise builder
--- predicates, such as @builder (Ghc CompileHs Stage1)@, as well as predicates
--- covering a set of similar builders. For example, @builder (Ghc CompileHs)@
--- matches any stage, and @builder Ghc@ matches any stage and any GHC mode.
-class BuilderPredicate a where
-    -- | Is a particular builder being used?
-    builder :: a -> Predicate Context Builder
-
-instance BuilderPredicate Builder where
-    builder b = (b ==) <$> getBuilder
-
-instance BuilderPredicate a => BuilderPredicate (Stage -> a) where
-    builder f = builder . f =<< getStage
-
-instance BuilderPredicate a => BuilderPredicate (CcMode -> a) where
-    builder f = do
-        b <- getBuilder
-        case b of
-            Cc  c _ -> builder (f c)
-            _       -> return False
-
-instance BuilderPredicate a => BuilderPredicate (GhcMode -> a) where
-    builder f = do
-        b <- getBuilder
-        case b of
-            Ghc c _ -> builder (f c)
-            _       -> return False
-
-instance BuilderPredicate a => BuilderPredicate (FilePath -> a) where
-    builder f = do
-        b <- getBuilder
-        case b of
-            Configure path -> builder (f path)
-            _              -> return False
index 006fc74..4b02839 100644 (file)
@@ -1,15 +1,14 @@
 {-# LANGUAGE DeriveGeneric #-}
 module Context (
-    Context (..), vanillaContext, stageContext, getStage, getPackage, getWay
+    Context (..), vanillaContext, stageContext, getStage, getPackage, getWay,
+    getStagedSettingList
     ) where
 
 import GHC.Generics
 import Hadrian.Expression
 
 import Base
-import Package
-import Stage
-import Way
+import Oracles.Setting
 
 -- | Build context for a currently built 'Target'. We generate potentially
 -- different build rules for each 'Context'.
@@ -44,3 +43,6 @@ getPackage = package <$> getContext
 getWay :: Expr Context b Way
 getWay = way <$> getContext
 
+-- | Get a list of configuration settings for the current stage.
+getStagedSettingList :: (Stage -> SettingList) -> Args Context b
+getStagedSettingList f = getSettingList . f =<< getStage
index 58eb62b..f11e86b 100644 (file)
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances #-}
 module Expression (
     -- * Expressions
     Expr, Predicate, Args, Ways, Packages,
@@ -7,7 +8,7 @@ module Expression (
 
     -- ** Predicates
     (?), stage, stage0, stage1, stage2, notStage0, package, notPackage,
-    libraryPackage, way, input, inputs, output, outputs,
+    libraryPackage, builder, way, input, inputs, output, outputs,
 
     -- ** Evaluation
     interpret, interpretInContext,
@@ -17,7 +18,7 @@ module Expression (
 
     -- * Convenient accessors
     getContext, getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
-    getInput, getOutput, getSetting, getSettingList, getStagedSettingList,
+    getInput, getOutput,
 
     -- * Re-exports
     module Data.Semigroup,
@@ -40,8 +41,6 @@ import Stage
 import Target hiding (builder, inputs, outputs)
 import Way
 
-import Oracles.Setting
-
 -- | @Expr a@ is a computation that produces a value of type @Action a@ and can
 -- read parameters of the current build 'Target'.
 type Expr a = H.Expr Context Builder a
@@ -54,18 +53,6 @@ type Args      = H.Args      Context Builder
 type Packages  = Expr [Package]
 type Ways      = Expr [Way]
 
--- | Get a configuration setting.
-getSetting :: Setting -> Expr String
-getSetting = expr . setting
-
--- | Get a list of configuration settings.
-getSettingList :: SettingList -> Args
-getSettingList = expr . settingList
-
--- | Get a list of configuration settings for the current stage.
-getStagedSettingList :: (Stage -> SettingList) -> Args
-getStagedSettingList f = getSettingList . f =<< getStage
-
 -- | Is the build currently in the provided stage?
 stage :: Stage -> Predicate
 stage s = (s ==) <$> getStage
@@ -74,6 +61,41 @@ stage s = (s ==) <$> getStage
 package :: Package -> Predicate
 package p = (p ==) <$> getPackage
 
+-- | This type class allows the user to construct both precise builder
+-- predicates, such as @builder (Ghc CompileHs Stage1)@, as well as predicates
+-- covering a set of similar builders. For example, @builder (Ghc CompileHs)@
+-- matches any stage, and @builder Ghc@ matches any stage and any GHC mode.
+class BuilderPredicate a where
+    -- | Is a particular builder being used?
+    builder :: a -> Predicate
+
+instance BuilderPredicate Builder where
+    builder b = (b ==) <$> getBuilder
+
+instance BuilderPredicate a => BuilderPredicate (Stage -> a) where
+    builder f = builder . f =<< getStage
+
+instance BuilderPredicate a => BuilderPredicate (CcMode -> a) where
+    builder f = do
+        b <- getBuilder
+        case b of
+            Cc  c _ -> builder (f c)
+            _       -> return False
+
+instance BuilderPredicate a => BuilderPredicate (GhcMode -> a) where
+    builder f = do
+        b <- getBuilder
+        case b of
+            Ghc c _ -> builder (f c)
+            _       -> return False
+
+instance BuilderPredicate a => BuilderPredicate (FilePath -> a) where
+    builder f = do
+        b <- getBuilder
+        case b of
+            Configure path -> builder (f path)
+            _              -> return False
+
 -- | Is the current build 'Way' equal to a certain value?
 way :: Way -> Predicate
 way w = (w ==) <$> getWay
index 6ae0b0d..748a5a2 100644 (file)
@@ -5,7 +5,6 @@ module Oracles.Dependencies (
     ) where
 
 import qualified Data.HashMap.Strict as Map
-import Hadrian.Utilities
 
 import Base
 import Context
index ebe3ab1..2258a00 100644 (file)
@@ -4,11 +4,9 @@ module Oracles.ModuleFiles (
     ) where
 
 import qualified Data.HashMap.Strict as Map
-import Hadrian.Utilities
 
 import Base
 import Context
-import Expression
 import Oracles.PackageData
 import Settings.Path
 
index d74a15c..095dbaa 100644 (file)
@@ -1,15 +1,17 @@
 module Oracles.Setting (
-    Setting (..), SettingList (..), setting, settingList,
-    anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,
+    configFile, Setting (..), SettingList (..), setting, settingList, getSetting,
+    getSettingList,  anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,
     ghcWithInterpreter, ghcEnableTablesNextToCode, useLibFFIForAdjustors,
     ghcCanonVersion, cmdLineLengthLimit, iosHost, osxHost, windowsHost,
-    relocatableBuild, installDocDir, installGhcLibDir
+    topDirectory, relocatableBuild, installDocDir, installGhcLibDir, libsuf
     ) where
 
+import Development.Shake
+import Hadrian.Expression
 import Hadrian.Oracles.KeyValue
+import Hadrian.Oracles.Path
 
 import Base
-import Stage
 
 -- 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'.
@@ -129,6 +131,14 @@ settingList key = fmap words $ lookupValueOrError configFile $ case key of
     ConfLdLinkerArgs  stage -> "conf-ld-linker-args-"  ++ stageString stage
     HsCppArgs               -> "hs-cpp-args"
 
+-- | Get a configuration setting.
+getSetting :: Setting -> Expr c b String
+getSetting = expr . setting
+
+-- | Get a list of configuration settings.
+getSettingList :: SettingList -> Args c b
+getSettingList = expr . settingList
+
 matchSetting :: Setting -> [String] -> Action Bool
 matchSetting key values = fmap (`elem` values) $ setting key
 
@@ -207,6 +217,10 @@ installDocDir = do
     dataDir <- setting InstallDataRootDir
     return $ dataDir -/- ("doc/ghc-" ++ version)
 
+-- | Path to the GHC source tree.
+topDirectory :: Action FilePath
+topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath
+
 -- ref: mk/install.mk:101
 -- TODO: CroosCompilePrefix
 -- | Unix: override @libdir@ and @datadir@ to put GHC-specific files in a
@@ -219,3 +233,20 @@ installGhcLibDir = do
          else do
              version <- setting ProjectVersion
              return $ libdir -/- ("ghc-" ++ version)
+
+-- TODO: find out why we need version number in the dynamic suffix
+-- The current theory: dynamic libraries are eventually placed in a single
+-- giant directory in the load path of the dynamic linker, and hence we must
+-- distinguish different versions of GHC. In contrast static libraries live
+-- in their own per-package directory and hence do not need a unique filename.
+-- 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
index 8a1a8d2..426640e 100644 (file)
@@ -8,9 +8,10 @@ module Package (
     ) where
 
 import Data.String
+import Development.Shake.Classes
+import Development.Shake.FilePath
 import GHC.Generics
-
-import Base
+import Hadrian.Utilities
 
 -- | The name of a Cabal package.
 newtype PackageName = PackageName { fromPackageName :: String }
@@ -28,6 +29,24 @@ data Package = Package
     , pkgType :: PackageType -- ^ A library or a program.
     } deriving Generic
 
+-- TODO: Get rid of non-derived Show instances.
+instance Show Package where
+    show = pkgNameString
+
+instance Eq Package where
+    p == q = pkgName p == pkgName q
+
+instance Ord Package where
+    compare p q = compare (pkgName p) (pkgName q)
+
+instance Binary   Package
+instance Hashable Package
+instance NFData   Package
+
+instance Binary   PackageType
+instance Hashable PackageType
+instance NFData   PackageType
+
 -- | Prettyprint 'Package' name.
 pkgNameString :: Package -> String
 pkgNameString = fromPackageName . pkgName
@@ -65,21 +84,3 @@ isLibrary _ = False
 isProgram :: Package -> Bool
 isProgram (Package _ _ Program) = True
 isProgram _ = False
-
--- TODO: Get rid of non-derived Show instances.
-instance Show Package where
-    show = pkgNameString
-
-instance Eq Package where
-    (==) = (==) `on` pkgName
-
-instance Ord Package where
-    compare = compare `on` pkgName
-
-instance Binary Package
-instance Hashable Package where
-instance NFData Package
-
-instance Binary PackageType
-instance Hashable PackageType
-instance NFData PackageType
index 9c02185..71f68e8 100644 (file)
@@ -8,7 +8,6 @@ import Distribution.Types.CondTree
 import Distribution.Verbosity
 
 import Base
-import Expression hiding (package)
 import GHC
 import Settings
 import Settings.Path
index a8528e8..5752850 100644 (file)
@@ -2,7 +2,6 @@ module Rules.Clean (clean, cleanSourceTree, cleanRules) where
 
 import Base
 import Settings.Path
-import Stage
 import UserSettings
 import Util
 
index bf896fb..2d76d2e 100644 (file)
@@ -1,7 +1,5 @@
 module Rules.Compile (compilePackage) where
 
-import Development.Shake.Util
-
 import Base
 import Context
 import Expression
index 12eccea..0c76dff 100644 (file)
@@ -3,12 +3,9 @@ module Rules.Configure (configureRules) where
 import qualified System.Info as System
 
 import Base
-import Builder
 import CmdLineFlag
 import Context
 import GHC
-import Settings.Path
-import Stage
 import Target
 import UserSettings
 import Util
index 8cbb50d..0ff79b2 100644 (file)
@@ -1,6 +1,7 @@
 module Rules.Dependencies (buildPackageDependencies) where
 
-import Development.Shake.Util
+import Data.Bifunctor
+import Data.Function
 
 import Base
 import Context
index ec394a1..43d9272 100644 (file)
@@ -3,8 +3,6 @@ module Rules.Generate (
     copyRules, includesDependencies, generatedDependencies
     ) where
 
-import Hadrian.Utilities
-
 import Base
 import Context hiding (package)
 import Expression
index 02ef819..b8ce5c2 100644 (file)
@@ -1,15 +1,10 @@
 module Rules.Gmp (gmpRules) where
 
-import Hadrian.Utilities
-
 import Base
-import Builder
 import GHC
 import Oracles.Setting
-import Package
 import Settings.Packages.IntegerGmp
 import Settings.Path
-import Stage
 import Target
 import UserSettings
 import Util
index 7b32f55..1b36279 100644 (file)
@@ -3,7 +3,6 @@ module Rules.Library (
 ) where
 
 import Data.Char
-import Hadrian.Utilities
 import qualified System.Directory as IO
 
 import Base
@@ -11,9 +10,10 @@ import Context
 import Expression hiding (way, package)
 import Flavour
 import GHC
+import Oracles.Dependencies
 import Oracles.ModuleFiles
 import Oracles.PackageData
-import Oracles.Dependencies
+import Oracles.Setting
 import Settings
 import Settings.Path
 import Target
index 5b81011..50e9cdb 100644 (file)
@@ -1,7 +1,6 @@
 module Rules.Perl (perlScriptRules) where
 
 import Base
-import Expression
 import Util
 
 -- | Build Perl scripts, such as @ghc-split@, from their literate Perl sources.
index 6f4f5b4..7ba9c9e 100644 (file)
@@ -1,10 +1,7 @@
 module Rules.Register (registerPackage) where
 
-import Hadrian.Utilities
-
 import Base
 import Context
-import Expression
 import GHC
 import Settings.Path
 import Target
index 1334bda..82c1ee7 100644 (file)
@@ -3,11 +3,9 @@
 module Rules.Selftest (selftestRules) where
 
 import Development.Shake
-import Hadrian.Utilities
 import Test.QuickCheck
 
 import Base
-import Expression
 import GHC
 import Oracles.ModuleFiles
 import Oracles.Setting
@@ -64,7 +62,7 @@ testLookupAll = do
         in lookupAll items (sort dict) == map (flip lookup dict) items
   where
     dicts :: Gen [(Int, Int)]
-    dicts = nubBy ((==) `on` fst) <$> vector 20
+    dicts = nubBy (\x y -> fst x == fst y) <$> vector 20
     extras :: Gen [Int]
     extras = vector 20
 
index 1a10ba0..bf70b79 100644 (file)
@@ -3,7 +3,6 @@ module Rules.SourceDist (sourceDistRules) where
 import Hadrian.Oracles.DirectoryContents
 
 import Base
-import Builder
 import Oracles.Setting
 import Rules.Clean
 import UserSettings
index 9899c03..fc210e7 100644 (file)
@@ -1,9 +1,6 @@
 module Rules.Test (testRules) where
 
-import Hadrian.Utilities
-
 import Base
-import Builder
 import Expression
 import Flavour
 import GHC
index e7bea57..d8f843a 100644 (file)
@@ -1,5 +1,6 @@
 module Settings.Builders.Common (
     module Base,
+    module Context,
     module Expression,
     module GHC,
     module Oracles.Flag,
@@ -12,6 +13,7 @@ module Settings.Builders.Common (
     ) where
 
 import Base
+import Context (getStagedSettingList)
 import Expression
 import GHC
 import Oracles.Flag
index 27c8790..8d2ff14 100644 (file)
@@ -1,7 +1,5 @@
 module Settings.Packages.Rts (rtsPackageArgs, rtsLibffiLibrary) where
 
-import Hadrian.Utilities
-
 import Base
 import Expression
 import GHC
index a764bcb..df30ad2 100644 (file)
@@ -1,19 +1,32 @@
 module Settings.Path (
-    stageDirectory, buildPath, pkgDataFile, pkgHaddockFile, pkgLibraryFile,
-    pkgLibraryFile0, pkgGhciLibraryFile, gmpContext, gmpBuildPath, gmpObjects,
-    gmpLibraryH, gmpBuildInfoPath, generatedPath, libffiContext, libffiBuildPath,
-    rtsContext, rtsBuildPath, rtsConfIn, shakeFilesPath,inplacePackageDbDirectory,
-    pkgConfFile, packageDbStamp, bootPackageConstraints, packageDependencies,
-    objectPath, inplaceBinPath, inplaceLibBinPath, inplaceLibPath, configH,
-    inplaceInstallPath, autogenPath, pkgInplaceConfig, ghcSplitPath, stripCmdPath,
-    pkgSetupConfigFile, inplaceLibCopyTargets, templateHscPath, topDirectory
-    ) where
+    -- * Hadrian configuration and source files
+    shakeFilesPath, bootPackageConstraints, packageDependencies,
+
+    -- * Build artefacts
+    buildPath, stageDirectory, pkgDataFile, pkgHaddockFile, pkgLibraryFile,
+    pkgLibraryFile0, pkgGhciLibraryFile, generatedPath, inplacePackageDbDirectory,
+    pkgConfFile, packageDbStamp, objectPath, autogenPath, pkgInplaceConfig,
+    pkgSetupConfigFile,
+
+    -- * RTS library
+    rtsContext, rtsBuildPath, rtsConfIn,
+
+    -- * GMP library
+    gmpContext, gmpBuildPath, gmpObjects, gmpLibraryH, gmpBuildInfoPath,
+
+    -- * LibFFI library
+    libffiContext, libffiBuildPath,
 
-import Hadrian.Oracles.Path
+    -- * Installation
+    inplaceBinPath, inplaceLibBinPath, inplaceLibPath, inplaceInstallPath,
+    inplaceLibCopyTargets, templateHscPath,
+
+    -- * Miscellaneous
+    ghcSplitPath, stripCmdPath
+    ) where
 
 import Base
 import Context
-import Expression hiding (stage)
 import GHC
 import Oracles.PackageData
 import Oracles.Setting
@@ -24,10 +37,6 @@ import UserSettings
 shakeFilesPath :: FilePath
 shakeFilesPath = buildRootPath -/- "hadrian"
 
--- | Path to the GHC source tree.
-topDirectory :: Action FilePath
-topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath
-
 -- | Boot package versions extracted from @.cabal@ files.
 bootPackageConstraints :: FilePath
 bootPackageConstraints = shakeFilesPath -/- "boot-package-constraints"
@@ -45,38 +54,10 @@ generatedPath = buildRootPath -/- "generated"
 stageDirectory :: Stage -> FilePath
 stageDirectory = stageString
 
--- TODO: change @mk/config.h@ to @shake-build/cfg/config.h@
--- | Path to the generated @mk/config.h file.
-configH :: FilePath
-configH = "mk/config.h"
-
--- | Directory for binaries that are built "in place".
-inplaceBinPath :: FilePath
-inplaceBinPath = "inplace/bin"
-
--- | Directory for libraries that are built "in place".
-inplaceLibPath :: FilePath
-inplaceLibPath = "inplace/lib"
-
--- | Directory for binary wrappers, and auxiliary binaries such as @touchy@.
-inplaceLibBinPath :: FilePath
-inplaceLibBinPath = "inplace/lib/bin"
-
 -- | Path to the directory containing build artefacts of a given 'Context'.
 buildPath :: Context -> FilePath
 buildPath Context {..} = buildRootPath -/- stageDirectory stage -/- pkgPath package
 
--- | Path to the autogen directory generated by @ghc-cabal@ of a given 'Context'.
-autogenPath :: Context -> FilePath
-autogenPath context@Context {..}
-    | isLibrary package   = autogen "build"
-    | package == ghc      = autogen "build/ghc"
-    | package == hpcBin   = autogen "build/hpc"
-    | package == iservBin = autogen "build/iserv"
-    | otherwise           = autogen $ "build" -/- pkgNameString package
-  where
-    autogen dir = buildPath context -/- dir -/- "autogen"
-
 -- | Path to inplace package configuration of a given 'Context'.
 pkgInplaceConfig :: Context -> FilePath
 pkgInplaceConfig context = buildPath context -/- "inplace-pkg-config"
@@ -85,7 +66,6 @@ pkgInplaceConfig context = buildPath context -/- "inplace-pkg-config"
 pkgDataFile :: Context -> FilePath
 pkgDataFile context = buildPath context -/- "package-data.mk"
 
-
 -- | Path to the @setup-config@ of a given 'Context'.
 pkgSetupConfigFile :: Context -> FilePath
 pkgSetupConfigFile context = buildPath context -/- "setup-config"
@@ -122,6 +102,53 @@ pkgFile context prefix suffix = do
     componentId <- pkgData $ ComponentId path
     return $ path -/- prefix ++ componentId ++ suffix
 
+-- | Path to the autogen directory generated by @ghc-cabal@ of a given 'Context'.
+autogenPath :: Context -> FilePath
+autogenPath context@Context {..}
+    | isLibrary package   = autogen "build"
+    | package == ghc      = autogen "build/ghc"
+    | package == hpcBin   = autogen "build/hpc"
+    | package == iservBin = autogen "build/iserv"
+    | otherwise           = autogen $ "build" -/- pkgNameString package
+  where
+    autogen dir = buildPath context -/- dir -/- "autogen"
+
+-- | Path to package database directory of a given 'Stage'. Note: StageN, N > 0,
+-- share the same packageDbDirectory.
+inplacePackageDbDirectory :: Stage -> FilePath
+inplacePackageDbDirectory Stage0 = buildRootPath -/- "stage0/bootstrapping.conf"
+inplacePackageDbDirectory _      = "inplace/lib/package.conf.d"
+
+-- | We use a stamp file to track the existence of a package database.
+packageDbStamp :: Stage -> FilePath
+packageDbStamp stage = inplacePackageDbDirectory stage -/- ".stamp"
+
+-- | Path to the configuration file of a given 'Context'.
+pkgConfFile :: Context -> Action FilePath
+pkgConfFile context@Context {..} = do
+    componentId <- pkgData . ComponentId $ buildPath context
+    return $ inplacePackageDbDirectory stage -/- componentId <.> "conf"
+
+-- | Given a 'FilePath' to a source file, return 'True' if it is generated.
+-- The current implementation simply assumes that a file is generated if it
+-- lives in 'buildRootPath'. Since most files are not generated the test is
+-- usually very fast.
+isGeneratedSource :: FilePath -> Bool
+isGeneratedSource = (buildRootPath `isPrefixOf`)
+
+-- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
+-- to its object file. For example:
+-- * "Task.c"                              -> "_build/stage1/rts/Task.thr_o"
+-- * "_build/stage1/rts/cmm/AutoApply.cmm" -> "_build/stage1/rts/cmm/AutoApply.o"
+objectPath :: Context -> FilePath -> FilePath
+objectPath context@Context {..} src
+    | isGeneratedSource src = obj
+    | "*hs*" ?== extension  = buildPath context -/- obj
+    | otherwise             = buildPath context -/- extension -/- obj
+  where
+    extension = drop 1 $ takeExtension src
+    obj       = src -<.> osuf way
+
 -- | RTS is considered a Stage1 package. This determines RTS build directory.
 rtsContext :: Context
 rtsContext = vanillaContext Stage1 rts
@@ -162,41 +189,17 @@ libffiContext = vanillaContext Stage1 libffi
 libffiBuildPath :: FilePath
 libffiBuildPath = buildPath libffiContext
 
--- | Path to package database directory of a given 'Stage'. Note: StageN, N > 0,
--- share the same packageDbDirectory.
-inplacePackageDbDirectory :: Stage -> FilePath
-inplacePackageDbDirectory Stage0 = buildRootPath -/- "stage0/bootstrapping.conf"
-inplacePackageDbDirectory _      = "inplace/lib/package.conf.d"
-
--- | We use a stamp file to track the existence of a package database.
-packageDbStamp :: Stage -> FilePath
-packageDbStamp stage = inplacePackageDbDirectory stage -/- ".stamp"
-
--- | Path to the configuration file of a given 'Context'.
-pkgConfFile :: Context -> Action FilePath
-pkgConfFile context@Context {..} = do
-    componentId <- pkgData . ComponentId $ buildPath context
-    return $ inplacePackageDbDirectory stage -/- componentId <.> "conf"
+-- | Directory for binaries that are built "in place".
+inplaceBinPath :: FilePath
+inplaceBinPath = "inplace/bin"
 
--- | Given a 'FilePath' to a source file, return 'True' if it is generated.
--- The current implementation simply assumes that a file is generated if it
--- lives in 'buildRootPath'. Since most files are not generated the test is
--- usually very fast.
-isGeneratedSource :: FilePath -> Bool
-isGeneratedSource = (buildRootPath `isPrefixOf`)
+-- | Directory for libraries that are built "in place".
+inplaceLibPath :: FilePath
+inplaceLibPath = "inplace/lib"
 
--- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
--- to its object file. For example:
--- * "Task.c"                              -> "_build/stage1/rts/Task.thr_o"
--- * "_build/stage1/rts/cmm/AutoApply.cmm" -> "_build/stage1/rts/cmm/AutoApply.o"
-objectPath :: Context -> FilePath -> FilePath
-objectPath context@Context {..} src
-    | isGeneratedSource src = obj
-    | "*hs*" ?== extension  = buildPath context -/- obj
-    | otherwise             = buildPath context -/- extension -/- obj
-  where
-    extension = drop 1 $ takeExtension src
-    obj       = src -<.> osuf way
+-- | Directory for binary wrappers, and auxiliary binaries such as @touchy@.
+inplaceLibBinPath :: FilePath
+inplaceLibBinPath = "inplace/lib/bin"
 
 -- | Given a 'Package', return the path where the corresponding program is
 -- installed. Most programs are installed in 'programInplacePath'.
@@ -207,6 +210,22 @@ inplaceInstallPath pkg
     | pkg == iservBin = inplaceLibBinPath
     | otherwise       = inplaceBinPath
 
+-- ref: ghc/ghc.mk:142
+-- ref: driver/ghc.mk
+-- ref: utils/hsc2hs/ghc.mk:35
+-- | Files that need to be copied over to inplace/lib
+inplaceLibCopyTargets :: [FilePath]
+inplaceLibCopyTargets = map (inplaceLibPath -/-)
+    [ "ghc-usage.txt"
+    , "ghci-usage.txt"
+    , "platformConstants"
+    , "settings"
+    , "template-hsc.h" ]
+
+-- | Path to hsc2hs template.
+templateHscPath :: FilePath
+templateHscPath = "inplace/lib/template-hsc.h"
+
 -- | @ghc-split@ is a Perl script used by GHC with @-split-objs@ flag. It is
 -- generated in "Rules.Generators.GhcSplit".
 ghcSplitPath :: FilePath
@@ -224,18 +243,3 @@ stripCmdPath = do
         "arm-unknown-linux" ->
              return ":" -- HACK: from the make-based system, see the ref above
         _ -> return "strip"
-
--- | Files that need to be copied over to inplace/lib
--- ref: ghc/ghc.mk:142
--- ref: driver/ghc.mk
--- ref: utils/hsc2hs/ghc.mk:35
-inplaceLibCopyTargets :: [FilePath]
-inplaceLibCopyTargets = map (inplaceLibPath -/-)
-  [ "ghc-usage.txt"
-  , "ghci-usage.txt"
-  , "platformConstants"
-  , "settings"
-  , "template-hsc.h" ]
-
-templateHscPath :: FilePath
-templateHscPath = "inplace/lib/template-hsc.h"
index 0e299ca..074faa1 100644 (file)
@@ -21,12 +21,12 @@ import GHC.Generics
 --   for the compiler. Since it serves no other purpose than that, the stage 3
 --   build is usually omitted in the build process.
 data Stage = Stage0 | Stage1 | Stage2 | Stage3
-           deriving (Show, Eq, Ord, Enum, Generic, Bounded)
+    deriving (Show, Eq, Ord, Enum, Generic, Bounded)
+
+instance Binary   Stage
+instance Hashable Stage
+instance NFData   Stage
 
 -- | Prettyprint a 'Stage'.
 stageString :: Stage -> String
 stageString stage = "stage" ++ show (fromEnum stage)
-
-instance Binary Stage
-instance Hashable Stage
-instance NFData Stage
index 97e7040..c3a117b 100644 (file)
@@ -8,7 +8,7 @@ import Data.List.Extra
 import qualified Hadrian.Target as H
 import Hadrian.Target hiding (Target)
 
-import Builder hiding (builder)
+import Builder
 import Context
 
 type Target = H.Target Context Builder
index debd7cd..0c9c68a 100644 (file)
@@ -7,10 +7,10 @@ module UserSettings (
     putBuild, putSuccess, defaultDestDir, defaultStage1Only
     ) where
 
+import Development.Shake
 import Hadrian.Utilities
 import System.Console.ANSI
 
-import Base
 import CmdLineFlag
 import Flavour
 import Expression
index f6ab1dd..79d7f32 100644 (file)
@@ -22,7 +22,6 @@ import Expression hiding (builder, inputs, outputs, way, stage, package)
 import GHC
 import Oracles.Setting
 import Settings
-import Settings.Path
 import Settings.Builders.Ar
 import Target
 import UserSettings
index 4121cdb..e904d93 100644 (file)
@@ -1,21 +1,21 @@
 module Way (
-    WayUnit (..), Way, wayUnit, wayFromUnits, allWays,
+    WayUnit (..), Way, wayUnit, removeWayUnit, wayFromUnits, allWays,
 
     vanilla, profiling, dynamic, profilingDynamic, threaded, debug, logging,
     threadedDebug, threadedProfiling, threadedLogging, threadedDynamic,
     threadedDebugProfiling, threadedDebugDynamic, threadedProfilingDynamic,
     threadedLoggingDynamic, debugProfiling, debugDynamic, loggingDynamic,
 
-    wayPrefix, waySuffix, hisuf, osuf, hcsuf, obootsuf, hibootsuf, ssuf, libsuf
+    wayPrefix, waySuffix, hisuf, osuf, hcsuf, obootsuf, hibootsuf, ssuf
     ) where
 
 import Data.IntSet (IntSet)
 import qualified Data.IntSet as Set
+import Data.List
+import Data.Maybe
+import Development.Shake.Classes
 import Hadrian.Utilities
 
-import Base
-import Oracles.Setting
-
 -- Note: order of constructors is important for compatibility with the old build
 -- system, e.g. we want "thr_p", not "p_thr" (see instance Show Way).
 -- | A 'WayUnit' is a single way of building source code, for example with
@@ -43,6 +43,16 @@ instance Read WayUnit where
 -- is to be built.
 newtype Way = Way IntSet
 
+instance Binary Way where
+    put = put . show
+    get = fmap read get
+
+instance Hashable Way where
+    hashWithSalt salt = hashWithSalt salt . show
+
+instance NFData Way where
+    rnf (Way s) = s `seq` ()
+
 -- | Construct a 'Way' from multiple 'WayUnit's. Inverse of 'wayToUnits'.
 wayFromUnits :: [WayUnit] -> Way
 wayFromUnits = Way . Set.fromList . map fromEnum
@@ -56,6 +66,10 @@ wayToUnits (Way set) = map toEnum . Set.elems $ set
 wayUnit :: WayUnit -> Way -> Bool
 wayUnit unit (Way set) = fromEnum unit `Set.member` set
 
+-- | Remove a 'WayUnit' from 'Way'.
+removeWayUnit :: WayUnit -> Way -> Way
+removeWayUnit unit (Way set) = Way . Set.delete (fromEnum unit) $ set
+
 instance Show Way where
     show way = if null tag then "v" else tag
       where
@@ -146,30 +160,3 @@ hisuf     = (++ "hi"     ) . wayPrefix
 hcsuf     = (++ "hc"     ) . wayPrefix
 obootsuf  = (++ "o-boot" ) . wayPrefix
 hibootsuf = (++ "hi-boot") . wayPrefix
-
--- TODO: find out why we need version number in the dynamic suffix
--- The current theory: dynamic libraries are eventually placed in a single
--- giant directory in the load path of the dynamic linker, and hence we must
--- distinguish different versions of GHC. In contrast static libraries live
--- in their own per-package directory and hence do not need a unique filename.
--- We also need to respect the system's dynamic extension, e.g. .dll or .so.
-libsuf :: Way -> Action String
-libsuf way@(Way set) =
-    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 . Way . Set.delete (fromEnum Dynamic) $ set
-        -- e.g., p_ghc7.11.20141222.dll (the result)
-        return $ prefix ++ "-ghc" ++ version ++ extension
-
-instance Binary Way where
-    put = put . show
-    get = fmap read get
-
-instance Hashable Way where
-    hashWithSalt salt = hashWithSalt salt . show
-
-instance NFData Way where
-    rnf (Way s) = s `seq` ()