Merge all generators into a single file, factor our common functionality into the...
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 6 Aug 2017 13:17:06 +0000 (14:17 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 6 Aug 2017 13:17:06 +0000 (14:17 +0100)
See #347

25 files changed:
hadrian.cabal
src/Base.hs
src/Expression.hs
src/Hadrian/Expression.hs
src/Hadrian/Utilities.hs
src/Oracles/Dependencies.hs
src/Oracles/ModuleFiles.hs
src/Rules/Configure.hs
src/Rules/Generate.hs
src/Rules/Generators/Common.hs [deleted file]
src/Rules/Generators/ConfigHs.hs [deleted file]
src/Rules/Generators/GhcAutoconfH.hs [deleted file]
src/Rules/Generators/GhcBootPlatformH.hs [deleted file]
src/Rules/Generators/GhcPlatformH.hs [deleted file]
src/Rules/Generators/GhcSplit.hs [deleted file]
src/Rules/Generators/GhcVersionH.hs [deleted file]
src/Rules/Generators/VersionHs.hs [deleted file]
src/Rules/Gmp.hs
src/Rules/Libffi.hs
src/Rules/Selftest.hs
src/Rules/Test.hs
src/Settings/Builders/Haddock.hs
src/Settings/Packages/Rts.hs
src/Settings/Path.hs
src/Way.hs

index 8d0b63a..4a908e2 100644 (file)
@@ -49,14 +49,6 @@ executable hadrian
                        , Rules.Dependencies
                        , Rules.Documentation
                        , Rules.Generate
-                       , Rules.Generators.Common
-                       , Rules.Generators.ConfigHs
-                       , Rules.Generators.GhcAutoconfH
-                       , Rules.Generators.GhcBootPlatformH
-                       , Rules.Generators.GhcPlatformH
-                       , Rules.Generators.GhcSplit
-                       , Rules.Generators.GhcVersionH
-                       , Rules.Generators.VersionHs
                        , Rules.Gmp
                        , Rules.Install
                        , Rules.Libffi
index 3512e1b..6ae3ead 100644 (file)
@@ -17,8 +17,8 @@ module Base (
     configPath, configFile, sourcePath,
 
     -- * Miscellaneous utilities
-    minusOrd, intersectOrd, lookupAll, replaceEq, replaceSeparators, unifyPath,
-    quote, (-/-), matchVersionedFilePath, matchGhcVersionedFilePath, putColoured
+    unifyPath, quote, (-/-), matchVersionedFilePath, matchGhcVersionedFilePath,
+    putColoured
     ) where
 
 import Control.Applicative
@@ -58,53 +58,6 @@ configFile = configPath -/- "system.config"
 sourcePath :: FilePath
 sourcePath = hadrianPath -/- "src"
 
--- | Find and replace all occurrences of a value in a list.
-replaceEq :: Eq a => a -> a -> [a] -> [a]
-replaceEq from = replaceWhen (== from)
-
--- | Find and replace all occurrences of path separators in a String with a Char.
-replaceSeparators :: Char -> String -> String
-replaceSeparators = replaceWhen isPathSeparator
-
-replaceWhen :: (a -> Bool) -> a -> [a] -> [a]
-replaceWhen p to = map (\from -> if p from then to else from)
-
--- Explicit definition to avoid dependency on Data.List.Ordered
--- | Difference of two ordered lists.
-minusOrd :: Ord a => [a] -> [a] -> [a]
-minusOrd [] _  = []
-minusOrd xs [] = xs
-minusOrd (x:xs) (y:ys) = case compare x y of
-    LT -> x : minusOrd xs (y:ys)
-    EQ ->     minusOrd xs ys
-    GT ->     minusOrd (x:xs) ys
-
--- Explicit definition to avoid dependency on Data.List.Ordered. TODO: add tests
--- | Intersection of two ordered lists by a predicate.
-intersectOrd :: (a -> b -> Ordering) -> [a] -> [b] -> [a]
-intersectOrd cmp = loop
-  where
-    loop [] _ = []
-    loop _ [] = []
-    loop (x:xs) (y:ys) = case cmp x y of
-        LT ->     loop xs (y:ys)
-        EQ -> x : loop xs (y:ys)
-        GT ->     loop (x:xs) ys
-
--- | Lookup all elements of a given sorted list in a given sorted dictionary.
--- @lookupAll list dict@ is equivalent to @map (flip lookup dict) list@ but has
--- linear complexity O(|list| + |dist|) instead of quadratic O(|list| * |dict|).
---
--- > lookupAll ["b", "c"] [("a", 1), ("c", 3), ("d", 4)] == [Nothing, Just 3]
--- > list & dict are sorted: lookupAll list dict == map (flip lookup dict) list
-lookupAll :: Ord a => [a] -> [(a, b)] -> [Maybe b]
-lookupAll []     _      = []
-lookupAll (_:xs) []     = Nothing : lookupAll xs []
-lookupAll (x:xs) (y:ys) = case compare x (fst y) of
-    LT -> Nothing      : lookupAll xs (y:ys)
-    EQ -> Just (snd y) : lookupAll xs (y:ys)
-    GT -> lookupAll (x:xs) ys
-
 -- | Given a @prefix@ and a @suffix@ check whether a @filePath@ matches the
 -- template @prefix ++ version ++ suffix@ where @version@ is an arbitrary string
 -- comprising digits (@0-9@), dashes (@-@), and dots (@.@). Examples:
index 0552fcd..6b441bb 100644 (file)
@@ -13,7 +13,7 @@ module Expression (
 
     -- * Convenient accessors
     getContext, getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
-    getInput, getOutput, getSingleton, getSetting, getSettingList, getFlag,
+    getInput, getOutput, getSetting, getSettingList, getFlag,
 
     -- * Re-exports
     module Data.Semigroup,
index 58347ab..8010695 100644 (file)
@@ -11,7 +11,7 @@ module Hadrian.Expression (
     interpret, interpretInContext,
 
     -- * Convenient accessors
-    getContext, getBuilder, getOutputs, getInputs, getInput, getOutput, getSingleton
+    getContext, getBuilder, getOutputs, getInputs, getInput, getOutput
     ) where
 
 import Control.Monad.Trans
@@ -20,6 +20,7 @@ import Data.Semigroup
 import Development.Shake
 
 import Hadrian.Target
+import Hadrian.Utilities
 
 -- | 'Expr' @c b a@ is a computation that produces a value of type 'Action' @a@
 -- and can read parameters of the current build 'Target' @c b@.
@@ -106,7 +107,7 @@ getInputs = Expr $ asks inputs
 getInput :: (Show b, Show c) => Expr c b FilePath
 getInput = Expr $ do
     target <- ask
-    getSingleton ("Exactly one input file expected in " ++ show target) <$> asks inputs
+    fromSingleton ("Exactly one input file expected in " ++ show target) <$> asks inputs
 
 -- | Get the files produced by the current 'Target'.
 getOutputs :: Expr c b [FilePath]
@@ -116,10 +117,4 @@ getOutputs = Expr $ asks outputs
 getOutput :: (Show b, Show c) => Expr c b FilePath
 getOutput = Expr $ do
     target <- ask
-    getSingleton ("Exactly one output file expected in " ++ show target) <$> asks outputs
-
--- | Extract a value from a singleton list, or raise an error if the list does
--- not contain exactly one value.
-getSingleton :: String -> [a] -> a
-getSingleton _ [res] = res
-getSingleton msg _   = error msg
+    fromSingleton ("Exactly one output file expected in " ++ show target) <$> asks outputs
index bdcf1d4..56b53ce 100644 (file)
@@ -1,7 +1,10 @@
 module Hadrian.Utilities (
 
+    -- * List manipulation
+    fromSingleton, replaceEq, minusOrd, intersectOrd, lookupAll,
+
     -- * String manipulation
-    quote,
+    quote, yesNo,
 
     -- * FilePath manipulation
     unifyPath, (-/-)
@@ -9,10 +12,61 @@ module Hadrian.Utilities (
 
 import Development.Shake.FilePath
 
+-- | Extract a value from a singleton list, or terminate with an error message
+-- if the list does not contain exactly one value.
+fromSingleton :: String -> [a] -> a
+fromSingleton _   [res] = res
+fromSingleton msg _     = error msg
+
+-- | Find and replace all occurrences of a value in a list.
+replaceEq :: Eq a => a -> a -> [a] -> [a]
+replaceEq from to = map (\cur -> if cur == from then to else cur)
+
+-- Explicit definition to avoid dependency on Data.List.Ordered
+-- | Difference of two ordered lists.
+minusOrd :: Ord a => [a] -> [a] -> [a]
+minusOrd [] _  = []
+minusOrd xs [] = xs
+minusOrd (x:xs) (y:ys) = case compare x y of
+    LT -> x : minusOrd xs (y:ys)
+    EQ ->     minusOrd xs ys
+    GT ->     minusOrd (x:xs) ys
+
+-- Explicit definition to avoid dependency on Data.List.Ordered. TODO: add tests
+-- | Intersection of two ordered lists by a predicate.
+intersectOrd :: (a -> b -> Ordering) -> [a] -> [b] -> [a]
+intersectOrd cmp = loop
+  where
+    loop [] _ = []
+    loop _ [] = []
+    loop (x:xs) (y:ys) = case cmp x y of
+        LT ->     loop xs (y:ys)
+        EQ -> x : loop xs (y:ys)
+        GT ->     loop (x:xs) ys
+
+-- | Lookup all elements of a given sorted list in a given sorted dictionary.
+-- @lookupAll list dict@ is equivalent to @map (flip lookup dict) list@ but has
+-- linear complexity O(|list| + |dist|) instead of quadratic O(|list| * |dict|).
+--
+-- > lookupAll ["b", "c"] [("a", 1), ("c", 3), ("d", 4)] == [Nothing, Just 3]
+-- > list & dict are sorted: lookupAll list dict == map (flip lookup dict) list
+lookupAll :: Ord a => [a] -> [(a, b)] -> [Maybe b]
+lookupAll []     _      = []
+lookupAll (_:xs) []     = Nothing : lookupAll xs []
+lookupAll (x:xs) (y:ys) = case compare x (fst y) of
+    LT -> Nothing      : lookupAll xs (y:ys)
+    EQ -> Just (snd y) : lookupAll xs (y:ys)
+    GT -> lookupAll (x:xs) ys
+
 -- | Add single quotes around a String.
 quote :: String -> String
 quote s = "'" ++ s ++ "'"
 
+-- | Pretty-print a 'Bool' as a @"YES"@ or @"NO"@ string.
+yesNo :: Bool -> String
+yesNo True  = "YES"
+yesNo False = "NO"
+
 -- | Normalise a path and convert all path separators to @/@, even on Windows.
 unifyPath :: FilePath -> FilePath
 unifyPath = toStandard . normaliseEx
index cd2e224..66f1842 100644 (file)
@@ -5,6 +5,7 @@ module Oracles.Dependencies (
     ) where
 
 import qualified Data.HashMap.Strict as Map
+import Hadrian.Utilities
 
 import Base
 import Context
index bf34790..409a586 100644 (file)
@@ -4,6 +4,7 @@ module Oracles.ModuleFiles (
     ) where
 
 import qualified Data.HashMap.Strict as Map
+import Hadrian.Utilities
 
 import Base
 import Context
index 74f6564..12eccea 100644 (file)
@@ -7,7 +7,7 @@ import Builder
 import CmdLineFlag
 import Context
 import GHC
-import Rules.Generators.GhcAutoconfH
+import Settings.Path
 import Stage
 import Target
 import UserSettings
index 378852b..180d921 100644 (file)
@@ -3,20 +3,17 @@ module Rules.Generate (
     copyRules, includesDependencies, generatedDependencies
     ) where
 
+import Hadrian.Utilities
+
 import Base
 import Context hiding (package)
 import Expression
 import Flavour
 import GHC
+import Oracles.Config.Flag
+import Oracles.Config.Setting
 import Oracles.ModuleFiles
 import Predicate
-import Rules.Generators.ConfigHs
-import Rules.Generators.GhcAutoconfH
-import Rules.Generators.GhcBootPlatformH
-import Rules.Generators.GhcPlatformH
-import Rules.Generators.GhcSplit
-import Rules.Generators.GhcVersionH
-import Rules.Generators.VersionHs
 import Rules.Libffi
 import Settings
 import Settings.Path
@@ -24,6 +21,10 @@ import Target
 import UserSettings
 import Util
 
+-- | Track this file to rebuild generated files whenever it changes.
+trackGenerateHs :: Expr ()
+trackGenerateHs = expr $ need [sourcePath -/- "Rules/Generate.hs"]
+
 primopsSource :: FilePath
 primopsSource = "compiler/prelude/primops.txt.pp"
 
@@ -171,3 +172,298 @@ generateRules = do
 emptyTarget :: Context
 emptyTarget = vanillaContext (error "Rules.Generate.emptyTarget: unknown stage")
                              (error "Rules.Generate.emptyTarget: unknown package")
+
+-- Generators
+
+-- | Given a 'String' replace charaters '.' and '-' by underscores ('_') so that
+-- the resulting 'String' is a valid C preprocessor identifier.
+cppify :: String -> String
+cppify = replaceEq '-' '_' . replaceEq '.' '_'
+
+ghcSplitSource :: FilePath
+ghcSplitSource = "driver/split/ghc-split.pl"
+
+-- ref: rules/build-perl.mk
+-- | Generate the @ghc-split@ Perl script.
+generateGhcSplit :: Expr String
+generateGhcSplit = do
+    trackGenerateHs
+    targetPlatform <- getSetting TargetPlatform
+    ghcEnableTNC   <- expr $ yesNo <$> ghcEnableTablesNextToCode
+    perlPath       <- getBuilderPath Perl
+    contents       <- expr $ readFileLines ghcSplitSource
+    return . unlines $
+        [ "#!" ++ perlPath
+        , "my $TARGETPLATFORM = " ++ show targetPlatform ++ ";"
+        -- I don't see where the ghc-split tool uses TNC, but
+        -- it's in the build-perl macro.
+        , "my $TABLES_NEXT_TO_CODE = " ++ show ghcEnableTNC ++ ";"
+        ] ++ contents
+
+-- | Generate @ghcplatform.h@ header.
+generateGhcPlatformH :: Expr String
+generateGhcPlatformH = do
+    trackGenerateHs
+    hostPlatform   <- getSetting HostPlatform
+    hostArch       <- getSetting HostArch
+    hostOs         <- getSetting HostOs
+    hostVendor     <- getSetting HostVendor
+    targetPlatform <- getSetting TargetPlatform
+    targetArch     <- getSetting TargetArch
+    targetOs       <- getSetting TargetOs
+    targetVendor   <- getSetting TargetVendor
+    ghcUnreg       <- getFlag GhcUnregisterised
+    return . unlines $
+        [ "#ifndef __GHCPLATFORM_H__"
+        , "#define __GHCPLATFORM_H__"
+        , ""
+        , "#define BuildPlatform_TYPE  " ++ cppify hostPlatform
+        , "#define HostPlatform_TYPE   " ++ cppify targetPlatform
+        , ""
+        , "#define " ++ cppify hostPlatform   ++ "_BUILD 1"
+        , "#define " ++ cppify targetPlatform ++ "_HOST 1"
+        , ""
+        , "#define " ++ hostArch   ++ "_BUILD_ARCH 1"
+        , "#define " ++ targetArch ++ "_HOST_ARCH 1"
+        , "#define BUILD_ARCH " ++ show hostArch
+        , "#define HOST_ARCH "  ++ show targetArch
+        , ""
+        , "#define " ++ hostOs   ++ "_BUILD_OS 1"
+        , "#define " ++ targetOs ++ "_HOST_OS 1"
+        , "#define BUILD_OS " ++ show hostOs
+        , "#define HOST_OS "  ++ show targetOs
+        , ""
+        , "#define " ++ hostVendor   ++ "_BUILD_VENDOR 1"
+        , "#define " ++ targetVendor ++ "_HOST_VENDOR 1"
+        , "#define BUILD_VENDOR " ++ show hostVendor
+        , "#define HOST_VENDOR "  ++ show targetVendor
+        , ""
+        , "/* These TARGET macros are for backwards compatibility... DO NOT USE! */"
+        , "#define TargetPlatform_TYPE " ++ cppify targetPlatform
+        , "#define " ++ cppify targetPlatform ++ "_TARGET 1"
+        , "#define " ++ targetArch ++ "_TARGET_ARCH 1"
+        , "#define TARGET_ARCH " ++ show targetArch
+        , "#define " ++ targetOs ++ "_TARGET_OS 1"
+        , "#define TARGET_OS " ++ show targetOs
+        , "#define " ++ targetVendor ++ "_TARGET_VENDOR 1" ]
+        ++
+        [ "#define UnregisterisedCompiler 1" | ghcUnreg ]
+        ++
+        [ "\n#endif /* __GHCPLATFORM_H__ */" ]
+
+-- | Generate @Config.hs@ files.
+generateConfigHs :: Expr String
+generateConfigHs = do
+    trackGenerateHs
+    cProjectName        <- getSetting ProjectName
+    cProjectGitCommitId <- getSetting ProjectGitCommitId
+    cProjectVersion     <- getSetting ProjectVersion
+    cProjectVersionInt  <- getSetting ProjectVersionInt
+    cProjectPatchLevel  <- getSetting ProjectPatchLevel
+    cProjectPatchLevel1 <- getSetting ProjectPatchLevel1
+    cProjectPatchLevel2 <- getSetting ProjectPatchLevel2
+    cBooterVersion      <- getSetting GhcVersion
+    let cIntegerLibraryType
+            | integerLibrary flavour == integerGmp    = "IntegerGMP"
+            | integerLibrary flavour == integerSimple = "IntegerSimple"
+            | otherwise = error $ "Unknown integer library: " ++ integerLibraryName
+    cSupportsSplitObjs         <- expr $ yesNo <$> supportsSplitObjects
+    cGhcWithInterpreter        <- expr $ yesNo <$> ghcWithInterpreter
+    cGhcWithNativeCodeGen      <- expr $ yesNo <$> ghcWithNativeCodeGen
+    cGhcWithSMP                <- expr $ yesNo <$> ghcWithSMP
+    cGhcEnableTablesNextToCode <- expr $ yesNo <$> ghcEnableTablesNextToCode
+    cLeadingUnderscore         <- expr $ yesNo <$> flag LeadingUnderscore
+    cGHC_UNLIT_PGM             <- fmap takeFileName $ getBuilderPath Unlit
+    cLibFFI                    <- expr useLibFFIForAdjustors
+    rtsWays                    <- getRtsWays
+    cGhcRtsWithLibdw           <- getFlag WithLibdw
+    let cGhcRTSWays = unwords $ map show rtsWays
+    return $ unlines
+        [ "{-# LANGUAGE CPP #-}"
+        , "module Config where"
+        , ""
+        , "#include \"ghc_boot_platform.h\""
+        , ""
+        , "data IntegerLibrary = IntegerGMP"
+        , "                    | IntegerSimple"
+        , "                    deriving Eq"
+        , ""
+        , "cBuildPlatformString :: String"
+        , "cBuildPlatformString = BuildPlatform_NAME"
+        , "cHostPlatformString :: String"
+        , "cHostPlatformString = HostPlatform_NAME"
+        , "cTargetPlatformString :: String"
+        , "cTargetPlatformString = TargetPlatform_NAME"
+        , ""
+        , "cProjectName          :: String"
+        , "cProjectName          = " ++ show cProjectName
+        , "cProjectGitCommitId   :: String"
+        , "cProjectGitCommitId   = " ++ show cProjectGitCommitId
+        , "cProjectVersion       :: String"
+        , "cProjectVersion       = " ++ show cProjectVersion
+        , "cProjectVersionInt    :: String"
+        , "cProjectVersionInt    = " ++ show cProjectVersionInt
+        , "cProjectPatchLevel    :: String"
+        , "cProjectPatchLevel    = " ++ show cProjectPatchLevel
+        , "cProjectPatchLevel1   :: String"
+        , "cProjectPatchLevel1   = " ++ show cProjectPatchLevel1
+        , "cProjectPatchLevel2   :: String"
+        , "cProjectPatchLevel2   = " ++ show cProjectPatchLevel2
+        , "cBooterVersion        :: String"
+        , "cBooterVersion        = " ++ show cBooterVersion
+        , "cStage                :: String"
+        , "cStage                = show (STAGE :: Int)"
+        , "cIntegerLibrary       :: String"
+        , "cIntegerLibrary       = " ++ show integerLibraryName
+        , "cIntegerLibraryType   :: IntegerLibrary"
+        , "cIntegerLibraryType   = " ++ cIntegerLibraryType
+        , "cSupportsSplitObjs    :: String"
+        , "cSupportsSplitObjs    = " ++ show cSupportsSplitObjs
+        , "cGhcWithInterpreter   :: String"
+        , "cGhcWithInterpreter   = " ++ show cGhcWithInterpreter
+        , "cGhcWithNativeCodeGen :: String"
+        , "cGhcWithNativeCodeGen = " ++ show cGhcWithNativeCodeGen
+        , "cGhcWithSMP           :: String"
+        , "cGhcWithSMP           = " ++ show cGhcWithSMP
+        , "cGhcRTSWays           :: String"
+        , "cGhcRTSWays           = " ++ show cGhcRTSWays
+        , "cGhcEnableTablesNextToCode :: String"
+        , "cGhcEnableTablesNextToCode = " ++ show cGhcEnableTablesNextToCode
+        , "cLeadingUnderscore    :: String"
+        , "cLeadingUnderscore    = " ++ show cLeadingUnderscore
+        , "cGHC_UNLIT_PGM        :: String"
+        , "cGHC_UNLIT_PGM        = " ++ show cGHC_UNLIT_PGM
+        , "cGHC_SPLIT_PGM        :: String"
+        , "cGHC_SPLIT_PGM        = " ++ show "ghc-split"
+        , "cLibFFI               :: Bool"
+        , "cLibFFI               = " ++ show cLibFFI
+        , "cGhcThreaded :: Bool"
+        , "cGhcThreaded = " ++ show (threaded `elem` rtsWays)
+        , "cGhcDebugged :: Bool"
+        , "cGhcDebugged = " ++ show (ghcDebugged flavour)
+        , "cGhcRtsWithLibdw :: Bool"
+        , "cGhcRtsWithLibdw = " ++ show cGhcRtsWithLibdw ]
+
+-- | Generate @ghcautoconf.h@ header.
+generateGhcAutoconfH :: Expr String
+generateGhcAutoconfH = do
+    trackGenerateHs
+    configHContents  <- expr $ map undefinePackage <$> readFileLines configH
+    tablesNextToCode <- expr ghcEnableTablesNextToCode
+    ghcUnreg         <- getFlag GhcUnregisterised
+    ccLlvmBackend    <- getSetting CcLlvmBackend
+    ccClangBackend   <- getSetting CcClangBackend
+    return . unlines $
+        [ "#ifndef __GHCAUTOCONF_H__"
+        , "#define __GHCAUTOCONF_H__" ]
+        ++ configHContents ++
+        [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode && not ghcUnreg ]
+        ++
+        [ "\n#define llvm_CC_FLAVOR 1"      | ccLlvmBackend == "1" ]
+        ++
+        [ "\n#define clang_CC_FLAVOR 1"     | ccClangBackend == "1" ]
+        ++
+        [ "#endif /* __GHCAUTOCONF_H__ */" ]
+  where
+    undefinePackage s
+        | "#define PACKAGE_" `isPrefixOf` s
+            = "/* #undef " ++ takeWhile (/=' ') (drop 8 s) ++ " */"
+        | otherwise = s
+
+-- | Generate @ghc_boot_platform.h@ headers.
+generateGhcBootPlatformH :: Expr String
+generateGhcBootPlatformH = do
+    trackGenerateHs
+    stage <- getStage
+    let chooseSetting x y = getSetting $ if stage == Stage0 then x else y
+    buildPlatform  <- chooseSetting BuildPlatform HostPlatform
+    buildArch      <- chooseSetting BuildArch     HostArch
+    buildOs        <- chooseSetting BuildOs       HostOs
+    buildVendor    <- chooseSetting BuildVendor   HostVendor
+    hostPlatform   <- chooseSetting HostPlatform  TargetPlatform
+    hostArch       <- chooseSetting HostArch      TargetArch
+    hostOs         <- chooseSetting HostOs        TargetOs
+    hostVendor     <- chooseSetting HostVendor    TargetVendor
+    targetPlatform <- getSetting TargetPlatform
+    targetArch     <- getSetting TargetArch
+    targetOs       <- getSetting TargetOs
+    targetVendor   <- getSetting TargetVendor
+    return $ unlines
+        [ "#ifndef __PLATFORM_H__"
+        , "#define __PLATFORM_H__"
+        , ""
+        , "#define BuildPlatform_NAME  " ++ show buildPlatform
+        , "#define HostPlatform_NAME   " ++ show hostPlatform
+        , "#define TargetPlatform_NAME " ++ show targetPlatform
+        , ""
+        , "#define " ++ cppify buildPlatform  ++ "_BUILD 1"
+        , "#define " ++ cppify hostPlatform   ++ "_HOST 1"
+        , "#define " ++ cppify targetPlatform ++ "_TARGET 1"
+        , ""
+        , "#define " ++ buildArch  ++ "_BUILD_ARCH 1"
+        , "#define " ++ hostArch   ++ "_HOST_ARCH 1"
+        , "#define " ++ targetArch ++ "_TARGET_ARCH 1"
+        , "#define BUILD_ARCH "  ++ show buildArch
+        , "#define HOST_ARCH "   ++ show hostArch
+        , "#define TARGET_ARCH " ++ show targetArch
+        , ""
+        , "#define " ++ buildOs  ++ "_BUILD_OS 1"
+        , "#define " ++ hostOs   ++ "_HOST_OS 1"
+        , "#define " ++ targetOs ++ "_TARGET_OS 1"
+        , "#define BUILD_OS "  ++ show buildOs
+        , "#define HOST_OS "   ++ show hostOs
+        , "#define TARGET_OS " ++ show targetOs
+        , ""
+        , "#define " ++ buildVendor  ++ "_BUILD_VENDOR 1"
+        , "#define " ++ hostVendor   ++ "_HOST_VENDOR 1"
+        , "#define " ++ targetVendor ++ "_TARGET_VENDOR  1"
+        , "#define BUILD_VENDOR "  ++ show buildVendor
+        , "#define HOST_VENDOR "   ++ show hostVendor
+        , "#define TARGET_VENDOR " ++ show targetVendor
+        , ""
+        , "#endif /* __PLATFORM_H__ */" ]
+
+-- | Generate @ghcversion.h@ header.
+generateGhcVersionH :: Expr String
+generateGhcVersionH = do
+    trackGenerateHs
+    version     <- getSetting ProjectVersionInt
+    patchLevel1 <- getSetting ProjectPatchLevel1
+    patchLevel2 <- getSetting ProjectPatchLevel2
+    return . unlines $
+        [ "#ifndef __GHCVERSION_H__"
+        , "#define __GHCVERSION_H__"
+        , ""
+        , "#ifndef __GLASGOW_HASKELL__"
+        , "# define __GLASGOW_HASKELL__ " ++ version
+        , "#endif"
+        , ""]
+        ++
+        [ "#define __GLASGOW_HASKELL_PATCHLEVEL1__ " ++ patchLevel1 | patchLevel1 /= "" ]
+        ++
+        [ "#define __GLASGOW_HASKELL_PATCHLEVEL2__ " ++ patchLevel2 | patchLevel2 /= "" ]
+        ++
+        [ ""
+        , "#define MIN_VERSION_GLASGOW_HASKELL(ma,mi,pl1,pl2) (\\"
+        , "   ((ma)*100+(mi)) <  __GLASGOW_HASKELL__ || \\"
+        , "   ((ma)*100+(mi)) == __GLASGOW_HASKELL__    \\"
+        , "          && (pl1) <  __GLASGOW_HASKELL_PATCHLEVEL1__ || \\"
+        , "   ((ma)*100+(mi)) == __GLASGOW_HASKELL__    \\"
+        , "          && (pl1) == __GLASGOW_HASKELL_PATCHLEVEL1__ \\"
+        , "          && (pl2) <= __GLASGOW_HASKELL_PATCHLEVEL2__ )"
+        , ""
+        , "#endif /* __GHCVERSION_H__ */" ]
+
+-- | Generate @Version.hs@ files.
+generateVersionHs :: Expr String
+generateVersionHs = do
+    trackGenerateHs
+    projectVersion <- getSetting ProjectVersion
+    targetOs       <- getSetting TargetOs
+    targetArch     <- getSetting TargetArch
+    return $ unlines
+        [ "module Version where"
+        , "version, targetOS, targetARCH :: String"
+        , "version    = " ++ show projectVersion
+        , "targetOS   = " ++ show targetOs
+        , "targetARCH = " ++ show targetArch ]
diff --git a/src/Rules/Generators/Common.hs b/src/Rules/Generators/Common.hs
deleted file mode 100644 (file)
index 64aadcf..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
-module Rules.Generators.Common (trackSource, yesNo, cppify) where
-
-import Base
-import Expression
-
--- | Track a given source file when constructing an expression.
-trackSource :: FilePath -> Expr ()
-trackSource file = expr $ need [ sourcePath -/- file ]
-
--- | Turn a 'Bool' computed by an 'Action' into a 'String' expression returning
--- "YES" (when the Boolean is 'True') or "NO" (when the Boolean is 'False').
-yesNo :: Action Bool -> Expr String
-yesNo = expr . fmap (\x -> if x then "YES" else "NO")
-
--- | Given a 'String' replace charaters '.' and '-' by underscores ('_') so that
--- the resulting 'String' becomes a valid C identifier.
-cppify :: String -> String
-cppify = replaceEq '-' '_' . replaceEq '.' '_'
diff --git a/src/Rules/Generators/ConfigHs.hs b/src/Rules/Generators/ConfigHs.hs
deleted file mode 100644 (file)
index c12ffd5..0000000
+++ /dev/null
@@ -1,102 +0,0 @@
-module Rules.Generators.ConfigHs (generateConfigHs) where
-
-import Base
-import Expression
-import Flavour
-import GHC
-import Oracles.Config.Flag
-import Oracles.Config.Setting
-import Rules.Generators.Common
-import Settings
-
-generateConfigHs :: Expr String
-generateConfigHs = do
-    trackSource "Rules/Generators/ConfigHs.hs"
-    cProjectName        <- getSetting ProjectName
-    cProjectGitCommitId <- getSetting ProjectGitCommitId
-    cProjectVersion     <- getSetting ProjectVersion
-    cProjectVersionInt  <- getSetting ProjectVersionInt
-    cProjectPatchLevel  <- getSetting ProjectPatchLevel
-    cProjectPatchLevel1 <- getSetting ProjectPatchLevel1
-    cProjectPatchLevel2 <- getSetting ProjectPatchLevel2
-    cBooterVersion      <- getSetting GhcVersion
-    let cIntegerLibraryType
-            | integerLibrary flavour == integerGmp    = "IntegerGMP"
-            | integerLibrary flavour == integerSimple = "IntegerSimple"
-            | otherwise = error $ "Unknown integer library: " ++ integerLibraryName
-    cSupportsSplitObjs         <- yesNo supportsSplitObjects
-    cGhcWithInterpreter        <- yesNo ghcWithInterpreter
-    cGhcWithNativeCodeGen      <- yesNo ghcWithNativeCodeGen
-    cGhcWithSMP                <- yesNo ghcWithSMP
-    cGhcEnableTablesNextToCode <- yesNo ghcEnableTablesNextToCode
-    cLeadingUnderscore         <- yesNo $ flag LeadingUnderscore
-    cGHC_UNLIT_PGM             <- fmap takeFileName $ getBuilderPath Unlit
-    cLibFFI                    <- expr useLibFFIForAdjustors
-    rtsWays                    <- getRtsWays
-    cGhcRtsWithLibdw           <- getFlag WithLibdw
-    let cGhcRTSWays = unwords $ map show rtsWays
-    return $ unlines
-        [ "{-# LANGUAGE CPP #-}"
-        , "module Config where"
-        , ""
-        , "#include \"ghc_boot_platform.h\""
-        , ""
-        , "data IntegerLibrary = IntegerGMP"
-        , "                    | IntegerSimple"
-        , "                    deriving Eq"
-        , ""
-        , "cBuildPlatformString :: String"
-        , "cBuildPlatformString = BuildPlatform_NAME"
-        , "cHostPlatformString :: String"
-        , "cHostPlatformString = HostPlatform_NAME"
-        , "cTargetPlatformString :: String"
-        , "cTargetPlatformString = TargetPlatform_NAME"
-        , ""
-        , "cProjectName          :: String"
-        , "cProjectName          = " ++ show cProjectName
-        , "cProjectGitCommitId   :: String"
-        , "cProjectGitCommitId   = " ++ show cProjectGitCommitId
-        , "cProjectVersion       :: String"
-        , "cProjectVersion       = " ++ show cProjectVersion
-        , "cProjectVersionInt    :: String"
-        , "cProjectVersionInt    = " ++ show cProjectVersionInt
-        , "cProjectPatchLevel    :: String"
-        , "cProjectPatchLevel    = " ++ show cProjectPatchLevel
-        , "cProjectPatchLevel1   :: String"
-        , "cProjectPatchLevel1   = " ++ show cProjectPatchLevel1
-        , "cProjectPatchLevel2   :: String"
-        , "cProjectPatchLevel2   = " ++ show cProjectPatchLevel2
-        , "cBooterVersion        :: String"
-        , "cBooterVersion        = " ++ show cBooterVersion
-        , "cStage                :: String"
-        , "cStage                = show (STAGE :: Int)"
-        , "cIntegerLibrary       :: String"
-        , "cIntegerLibrary       = " ++ show integerLibraryName
-        , "cIntegerLibraryType   :: IntegerLibrary"
-        , "cIntegerLibraryType   = " ++ cIntegerLibraryType
-        , "cSupportsSplitObjs    :: String"
-        , "cSupportsSplitObjs    = " ++ show cSupportsSplitObjs
-        , "cGhcWithInterpreter   :: String"
-        , "cGhcWithInterpreter   = " ++ show cGhcWithInterpreter
-        , "cGhcWithNativeCodeGen :: String"
-        , "cGhcWithNativeCodeGen = " ++ show cGhcWithNativeCodeGen
-        , "cGhcWithSMP           :: String"
-        , "cGhcWithSMP           = " ++ show cGhcWithSMP
-        , "cGhcRTSWays           :: String"
-        , "cGhcRTSWays           = " ++ show cGhcRTSWays
-        , "cGhcEnableTablesNextToCode :: String"
-        , "cGhcEnableTablesNextToCode = " ++ show cGhcEnableTablesNextToCode
-        , "cLeadingUnderscore    :: String"
-        , "cLeadingUnderscore    = " ++ show cLeadingUnderscore
-        , "cGHC_UNLIT_PGM        :: String"
-        , "cGHC_UNLIT_PGM        = " ++ show cGHC_UNLIT_PGM
-        , "cGHC_SPLIT_PGM        :: String"
-        , "cGHC_SPLIT_PGM        = " ++ show "ghc-split"
-        , "cLibFFI               :: Bool"
-        , "cLibFFI               = " ++ show cLibFFI
-        , "cGhcThreaded :: Bool"
-        , "cGhcThreaded = " ++ show (threaded `elem` rtsWays)
-        , "cGhcDebugged :: Bool"
-        , "cGhcDebugged = " ++ show (ghcDebugged flavour)
-        , "cGhcRtsWithLibdw :: Bool"
-        , "cGhcRtsWithLibdw = " ++ show cGhcRtsWithLibdw ]
diff --git a/src/Rules/Generators/GhcAutoconfH.hs b/src/Rules/Generators/GhcAutoconfH.hs
deleted file mode 100644 (file)
index b8eeb69..0000000
+++ /dev/null
@@ -1,37 +0,0 @@
-module Rules.Generators.GhcAutoconfH (generateGhcAutoconfH, configH) where
-
-import Base
-import Expression
-import Oracles.Config.Flag
-import Oracles.Config.Setting
-import Rules.Generators.Common
-
--- TODO: change `mk/config.h` to `shake-build/cfg/config.h`
-configH :: FilePath
-configH = "mk/config.h"
-
-undefinePackage :: String -> String
-undefinePackage s
-    | "#define PACKAGE_" `isPrefixOf` s
-                = "/* #undef " ++ takeWhile (/=' ') (drop 8 s) ++ " */"
-    | otherwise = s
-
-generateGhcAutoconfH :: Expr String
-generateGhcAutoconfH = do
-    trackSource "Rules/Generators/GhcAutoconfH.hs"
-    configHContents  <- expr $ map undefinePackage <$> readFileLines configH
-    tablesNextToCode <- expr ghcEnableTablesNextToCode
-    ghcUnreg         <- getFlag GhcUnregisterised
-    ccLlvmBackend    <- getSetting CcLlvmBackend
-    ccClangBackend   <- getSetting CcClangBackend
-    return . unlines $
-        [ "#ifndef __GHCAUTOCONF_H__"
-        , "#define __GHCAUTOCONF_H__" ]
-        ++ configHContents ++
-        [ "\n#define TABLES_NEXT_TO_CODE 1" | tablesNextToCode && not ghcUnreg ]
-        ++
-        [ "\n#define llvm_CC_FLAVOR 1"      | ccLlvmBackend == "1" ]
-        ++
-        [ "\n#define clang_CC_FLAVOR 1"     | ccClangBackend == "1" ]
-        ++
-        [ "#endif /* __GHCAUTOCONF_H__ */" ]
diff --git a/src/Rules/Generators/GhcBootPlatformH.hs b/src/Rules/Generators/GhcBootPlatformH.hs
deleted file mode 100644 (file)
index 84c85dc..0000000
+++ /dev/null
@@ -1,57 +0,0 @@
-module Rules.Generators.GhcBootPlatformH (generateGhcBootPlatformH) where
-
-import Expression
-import Oracles.Config.Setting
-import Rules.Generators.Common
-
-generateGhcBootPlatformH :: Expr String
-generateGhcBootPlatformH = do
-    trackSource "Rules/Generators/GhcBootPlatformH.hs"
-    stage <- getStage
-    let chooseSetting x y = getSetting $ if stage == Stage0 then x else y
-    buildPlatform  <- chooseSetting BuildPlatform HostPlatform
-    buildArch      <- chooseSetting BuildArch     HostArch
-    buildOs        <- chooseSetting BuildOs       HostOs
-    buildVendor    <- chooseSetting BuildVendor   HostVendor
-    hostPlatform   <- chooseSetting HostPlatform  TargetPlatform
-    hostArch       <- chooseSetting HostArch      TargetArch
-    hostOs         <- chooseSetting HostOs        TargetOs
-    hostVendor     <- chooseSetting HostVendor    TargetVendor
-    targetPlatform <- getSetting TargetPlatform
-    targetArch     <- getSetting TargetArch
-    targetOs       <- getSetting TargetOs
-    targetVendor   <- getSetting TargetVendor
-    return $ unlines
-        [ "#ifndef __PLATFORM_H__"
-        , "#define __PLATFORM_H__"
-        , ""
-        , "#define BuildPlatform_NAME  " ++ show buildPlatform
-        , "#define HostPlatform_NAME   " ++ show hostPlatform
-        , "#define TargetPlatform_NAME " ++ show targetPlatform
-        , ""
-        , "#define " ++ cppify buildPlatform  ++ "_BUILD 1"
-        , "#define " ++ cppify hostPlatform   ++ "_HOST 1"
-        , "#define " ++ cppify targetPlatform ++ "_TARGET 1"
-        , ""
-        , "#define " ++ buildArch  ++ "_BUILD_ARCH 1"
-        , "#define " ++ hostArch   ++ "_HOST_ARCH 1"
-        , "#define " ++ targetArch ++ "_TARGET_ARCH 1"
-        , "#define BUILD_ARCH "  ++ show buildArch
-        , "#define HOST_ARCH "   ++ show hostArch
-        , "#define TARGET_ARCH " ++ show targetArch
-        , ""
-        , "#define " ++ buildOs  ++ "_BUILD_OS 1"
-        , "#define " ++ hostOs   ++ "_HOST_OS 1"
-        , "#define " ++ targetOs ++ "_TARGET_OS 1"
-        , "#define BUILD_OS "  ++ show buildOs
-        , "#define HOST_OS "   ++ show hostOs
-        , "#define TARGET_OS " ++ show targetOs
-        , ""
-        , "#define " ++ buildVendor  ++ "_BUILD_VENDOR 1"
-        , "#define " ++ hostVendor   ++ "_HOST_VENDOR 1"
-        , "#define " ++ targetVendor ++ "_TARGET_VENDOR  1"
-        , "#define BUILD_VENDOR "  ++ show buildVendor
-        , "#define HOST_VENDOR "   ++ show hostVendor
-        , "#define TARGET_VENDOR " ++ show targetVendor
-        , ""
-        , "#endif /* __PLATFORM_H__ */" ]
diff --git a/src/Rules/Generators/GhcPlatformH.hs b/src/Rules/Generators/GhcPlatformH.hs
deleted file mode 100644 (file)
index 6e788d7..0000000
+++ /dev/null
@@ -1,56 +0,0 @@
-module Rules.Generators.GhcPlatformH (generateGhcPlatformH) where
-
-import Expression
-import Oracles.Config.Flag
-import Oracles.Config.Setting
-import Rules.Generators.Common
-
-generateGhcPlatformH :: Expr String
-generateGhcPlatformH = do
-    trackSource "Rules/Generators/GhcPlatformH.hs"
-    hostPlatform   <- getSetting HostPlatform
-    hostArch       <- getSetting HostArch
-    hostOs         <- getSetting HostOs
-    hostVendor     <- getSetting HostVendor
-    targetPlatform <- getSetting TargetPlatform
-    targetArch     <- getSetting TargetArch
-    targetOs       <- getSetting TargetOs
-    targetVendor   <- getSetting TargetVendor
-    ghcUnreg       <- getFlag GhcUnregisterised
-    return . unlines $
-        [ "#ifndef __GHCPLATFORM_H__"
-        , "#define __GHCPLATFORM_H__"
-        , ""
-        , "#define BuildPlatform_TYPE  " ++ cppify hostPlatform
-        , "#define HostPlatform_TYPE   " ++ cppify targetPlatform
-        , ""
-        , "#define " ++ cppify hostPlatform   ++ "_BUILD 1"
-        , "#define " ++ cppify targetPlatform ++ "_HOST 1"
-        , ""
-        , "#define " ++ hostArch   ++ "_BUILD_ARCH 1"
-        , "#define " ++ targetArch ++ "_HOST_ARCH 1"
-        , "#define BUILD_ARCH " ++ show hostArch
-        , "#define HOST_ARCH "  ++ show targetArch
-        , ""
-        , "#define " ++ hostOs   ++ "_BUILD_OS 1"
-        , "#define " ++ targetOs ++ "_HOST_OS 1"
-        , "#define BUILD_OS " ++ show hostOs
-        , "#define HOST_OS "  ++ show targetOs
-        , ""
-        , "#define " ++ hostVendor   ++ "_BUILD_VENDOR 1"
-        , "#define " ++ targetVendor ++ "_HOST_VENDOR 1"
-        , "#define BUILD_VENDOR " ++ show hostVendor
-        , "#define HOST_VENDOR "  ++ show targetVendor
-        , ""
-        , "/* These TARGET macros are for backwards compatibility... DO NOT USE! */"
-        , "#define TargetPlatform_TYPE " ++ cppify targetPlatform
-        , "#define " ++ cppify targetPlatform ++ "_TARGET 1"
-        , "#define " ++ targetArch ++ "_TARGET_ARCH 1"
-        , "#define TARGET_ARCH " ++ show targetArch
-        , "#define " ++ targetOs ++ "_TARGET_OS 1"
-        , "#define TARGET_OS " ++ show targetOs
-        , "#define " ++ targetVendor ++ "_TARGET_VENDOR 1" ]
-        ++
-        [ "#define UnregisterisedCompiler 1" | ghcUnreg ]
-        ++
-        [ "\n#endif /* __GHCPLATFORM_H__ */" ]
diff --git a/src/Rules/Generators/GhcSplit.hs b/src/Rules/Generators/GhcSplit.hs
deleted file mode 100644 (file)
index 08e3662..0000000
+++ /dev/null
@@ -1,27 +0,0 @@
-module Rules.Generators.GhcSplit (generateGhcSplit) where
-
-import Base
-import Expression
-import Oracles.Config.Setting
-import Rules.Generators.Common
-import Settings
-
-ghcSplitSource :: FilePath
-ghcSplitSource = "driver/split/ghc-split.pl"
-
--- | Generate the ghc-split Perl script
--- ref: rules/build-perl.mk
-generateGhcSplit :: Expr String
-generateGhcSplit = do
-    trackSource "Rules/Generators/GhcSplit.hs"
-    targetPlatform <- getSetting TargetPlatform
-    ghcEnableTNC   <- yesNo ghcEnableTablesNextToCode
-    perlPath       <- getBuilderPath Perl
-    contents       <- expr $ readFileLines ghcSplitSource
-    return . unlines $
-        [ "#!" ++ perlPath
-        , "my $TARGETPLATFORM = " ++ show targetPlatform ++ ";"
-        -- I don't see where the ghc-split tool uses TNC, but
-        -- it's in the build-perl macro.
-        , "my $TABLES_NEXT_TO_CODE = " ++ show ghcEnableTNC ++ ";"
-        ] ++ contents
diff --git a/src/Rules/Generators/GhcVersionH.hs b/src/Rules/Generators/GhcVersionH.hs
deleted file mode 100644 (file)
index b882dd2..0000000
+++ /dev/null
@@ -1,35 +0,0 @@
-module Rules.Generators.GhcVersionH (generateGhcVersionH) where
-
-import Expression
-import Oracles.Config.Setting
-import Rules.Generators.Common
-
-generateGhcVersionH :: Expr String
-generateGhcVersionH = do
-    trackSource "Rules/Generators/GhcVersionH.hs"
-    version     <- getSetting ProjectVersionInt
-    patchLevel1 <- getSetting ProjectPatchLevel1
-    patchLevel2 <- getSetting ProjectPatchLevel2
-    return . unlines $
-        [ "#ifndef __GHCVERSION_H__"
-        , "#define __GHCVERSION_H__"
-        , ""
-        , "#ifndef __GLASGOW_HASKELL__"
-        , "# define __GLASGOW_HASKELL__ " ++ version
-        , "#endif"
-        , ""]
-        ++
-        [ "#define __GLASGOW_HASKELL_PATCHLEVEL1__ " ++ patchLevel1 | patchLevel1 /= "" ]
-        ++
-        [ "#define __GLASGOW_HASKELL_PATCHLEVEL2__ " ++ patchLevel2 | patchLevel2 /= "" ]
-        ++
-        [ ""
-        , "#define MIN_VERSION_GLASGOW_HASKELL(ma,mi,pl1,pl2) (\\"
-        , "   ((ma)*100+(mi)) <  __GLASGOW_HASKELL__ || \\"
-        , "   ((ma)*100+(mi)) == __GLASGOW_HASKELL__    \\"
-        , "          && (pl1) <  __GLASGOW_HASKELL_PATCHLEVEL1__ || \\"
-        , "   ((ma)*100+(mi)) == __GLASGOW_HASKELL__    \\"
-        , "          && (pl1) == __GLASGOW_HASKELL_PATCHLEVEL1__ \\"
-        , "          && (pl2) <= __GLASGOW_HASKELL_PATCHLEVEL2__ )"
-        , ""
-        , "#endif /* __GHCVERSION_H__ */" ]
diff --git a/src/Rules/Generators/VersionHs.hs b/src/Rules/Generators/VersionHs.hs
deleted file mode 100644 (file)
index 49de289..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
-module Rules.Generators.VersionHs (generateVersionHs) where
-
-import Expression
-import Oracles.Config.Setting
-import Rules.Generators.Common
-
-generateVersionHs :: Expr String
-generateVersionHs = do
-    trackSource "Rules/Generators/VersionHs.hs"
-    projectVersion <- getSetting ProjectVersion
-    targetOs       <- getSetting TargetOs
-    targetArch     <- getSetting TargetArch
-    return $ unlines
-        [ "module Version where"
-        , "version, targetOS, targetARCH :: String"
-        , "version    = " ++ show projectVersion
-        , "targetOS   = " ++ show targetOs
-        , "targetARCH = " ++ show targetArch ]
index f1ab952..39fb53a 100644 (file)
@@ -1,12 +1,15 @@
 module Rules.Gmp (gmpRules) where
 
+import Hadrian.Utilities
+
 import Base
 import Builder
-import Expression
 import GHC
 import Oracles.Config.Setting
+import Package
 import Settings.Packages.IntegerGmp
 import Settings.Path
+import Stage
 import Target
 import UserSettings
 import Util
@@ -73,7 +76,7 @@ gmpRules = do
         -- gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents.
         -- That's because the doc/ directory contents are under the GFDL,
         -- which causes problems for Debian.
-        tarball <- unifyPath . getSingleton "Exactly one GMP tarball is expected"
+        tarball <- unifyPath . fromSingleton "Exactly one GMP tarball is expected"
                <$> getDirectoryFiles "" [gmpBase -/- "gmp-tarballs/gmp*.tar.bz2"]
 
         withTempDir $ \dir -> do
index 6eb4691..bd835af 100644 (file)
@@ -1,5 +1,7 @@
 module Rules.Libffi (libffiRules, libffiDependencies) where
 
+import Hadrian.Utilities
+
 import Settings.Builders.Common
 import Settings.Packages.Rts
 import Target
@@ -63,7 +65,7 @@ libffiRules = do
 
     libffiMakefile <.> "in" %> \mkIn -> do
         removeDirectory libffiBuildPath
-        tarball <- unifyPath . getSingleton "Exactly one LibFFI tarball is expected"
+        tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected"
                <$> getDirectoryFiles "" ["libffi-tarballs/libffi*.tar.gz"]
 
         need [tarball]
index 322befc..3dd4783 100644 (file)
@@ -3,6 +3,7 @@
 module Rules.Selftest (selftestRules) where
 
 import Development.Shake
+import Hadrian.Utilities
 import Test.QuickCheck
 
 import Base
index 88d3bf7..192eb0c 100644 (file)
@@ -1,5 +1,7 @@
 module Rules.Test (testRules) where
 
+import Hadrian.Utilities
+
 import Base
 import Builder
 import Expression
@@ -26,7 +28,6 @@ testRules = do
         build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
 
     "test" ~> do
-        let yesNo x = show $ if x then "YES" else "NO"
         pkgs     <- stagePackages Stage1
         tests    <- filterM doesDirectoryExist $ concat
                     [ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ]
@@ -47,7 +48,7 @@ testRules = do
             , "-e", "config.speed=2"
             , "-e", "ghc_compiler_always_flags=" ++ show "-fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user-package-db -rtsopts"
             , "-e", "ghc_with_native_codegen=" ++ show ghcWithNativeCodeGenInt
-            , "-e", "ghc_debugged=" ++ yesNo (ghcDebugged flavour)
+            , "-e", "ghc_debugged=" ++ show (yesNo $ ghcDebugged flavour)
             , "-e", "ghc_with_vanilla=1" -- TODO: do we always build vanilla?
             , "-e", "ghc_with_dynamic=0" -- TODO: support dynamic
             , "-e", "ghc_with_profiling=0" -- TODO: support profiling
index 4c6f862..adcbc97 100644 (file)
@@ -1,5 +1,7 @@
 module Settings.Builders.Haddock (haddockBuilderArgs) where
 
+import Hadrian.Utilities
+
 import Settings.Builders.Common
 import Settings.Builders.Ghc
 
index 15eef82..36eb16d 100644 (file)
@@ -1,5 +1,7 @@
 module Settings.Packages.Rts (rtsPackageArgs, rtsLibffiLibrary) where
 
+import Hadrian.Utilities
+
 import Base
 import GHC
 import Oracles.Config.Flag
@@ -25,7 +27,6 @@ rtsLibffiLibrary way = do
 
 rtsPackageArgs :: Args
 rtsPackageArgs = package rts ? do
-    let yesNo = expr . fmap (\x -> if x then "YES" else "NO")
     projectVersion <- getSetting ProjectVersion
     hostPlatform   <- getSetting HostPlatform
     hostArch       <- getSetting HostArch
@@ -39,8 +40,8 @@ rtsPackageArgs = package rts ? do
     targetArch     <- getSetting TargetArch
     targetOs       <- getSetting TargetOs
     targetVendor   <- getSetting TargetVendor
-    ghcUnreg       <- yesNo $ flag GhcUnregisterised
-    ghcEnableTNC   <- yesNo ghcEnableTablesNextToCode
+    ghcUnreg       <- expr $ yesNo <$> flag GhcUnregisterised
+    ghcEnableTNC   <- expr $ yesNo <$> ghcEnableTablesNextToCode
     way            <- getWay
     path           <- getBuildPath
     top            <- expr topDirectory
index fec0d47..a785b56 100644 (file)
@@ -4,7 +4,7 @@ module Settings.Path (
     gmpLibraryH, gmpBuildInfoPath, generatedPath, libffiContext, libffiBuildPath,
     rtsContext, rtsBuildPath, rtsConfIn, shakeFilesPath,inplacePackageDbDirectory,
     pkgConfFile, packageDbStamp, bootPackageConstraints, packageDependencies,
-    objectPath, inplaceBinPath, inplaceLibBinPath, inplaceLibPath,
+    objectPath, inplaceBinPath, inplaceLibBinPath, inplaceLibPath, configH,
     inplaceInstallPath, autogenPath, pkgInplaceConfig, ghcSplitPath, stripCmdPath,
     pkgSetupConfigFile, inplaceLibCopyTargets, templateHscPath, topDirectory
     ) where
@@ -45,6 +45,11 @@ 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"
index 33f89b4..71d3972 100644 (file)
@@ -11,8 +11,9 @@ module Way (
 
 import Data.IntSet (IntSet)
 import qualified Data.IntSet as Set
+import Hadrian.Utilities
 
-import Base hiding (unit)
+import Base
 import Oracles.Config.Setting
 
 -- Note: order of constructors is important for compatibility with the old build