summaryrefslogtreecommitdiff
path: root/hadrian/src/Rules
diff options
context:
space:
mode:
Diffstat (limited to 'hadrian/src/Rules')
-rw-r--r--hadrian/src/Rules/Clean.hs23
-rw-r--r--hadrian/src/Rules/Compile.hs83
-rw-r--r--hadrian/src/Rules/Configure.hs42
-rw-r--r--hadrian/src/Rules/Dependencies.hs33
-rw-r--r--hadrian/src/Rules/Documentation.hs197
-rw-r--r--hadrian/src/Rules/Generate.hs482
-rw-r--r--hadrian/src/Rules/Gmp.hs119
-rw-r--r--hadrian/src/Rules/Install.hs336
-rw-r--r--hadrian/src/Rules/Libffi.hs108
-rw-r--r--hadrian/src/Rules/Library.hs103
-rw-r--r--hadrian/src/Rules/PackageData.hs119
-rw-r--r--hadrian/src/Rules/Program.hs116
-rw-r--r--hadrian/src/Rules/Register.hs44
-rw-r--r--hadrian/src/Rules/Selftest.hs92
-rw-r--r--hadrian/src/Rules/SourceDist.hs113
-rw-r--r--hadrian/src/Rules/Test.hs72
-rw-r--r--hadrian/src/Rules/Wrappers.hs162
17 files changed, 2244 insertions, 0 deletions
diff --git a/hadrian/src/Rules/Clean.hs b/hadrian/src/Rules/Clean.hs
new file mode 100644
index 0000000000..d11cbf5e53
--- /dev/null
+++ b/hadrian/src/Rules/Clean.hs
@@ -0,0 +1,23 @@
+module Rules.Clean (clean, cleanSourceTree, cleanRules) where
+
+import Base
+
+clean :: Action ()
+clean = do
+ cleanSourceTree
+ putBuild "| Remove Hadrian files..."
+ path <- buildRoot
+ removeDirectory $ path -/- generatedDir
+ removeFilesAfter path ["//*"]
+ putSuccess "| Done. "
+
+cleanSourceTree :: Action ()
+cleanSourceTree = do
+ path <- buildRoot
+ forM_ [Stage0 ..] $ removeDirectory . (path -/-) . stageString
+ removeDirectory inplaceBinPath
+ removeDirectory inplaceLibPath
+ removeDirectory "sdistprep"
+
+cleanRules :: Rules ()
+cleanRules = "clean" ~> clean
diff --git a/hadrian/src/Rules/Compile.hs b/hadrian/src/Rules/Compile.hs
new file mode 100644
index 0000000000..a4b1278660
--- /dev/null
+++ b/hadrian/src/Rules/Compile.hs
@@ -0,0 +1,83 @@
+module Rules.Compile (compilePackage) where
+
+import Hadrian.Oracles.TextFile
+
+import Base
+import Context
+import Expression
+import Rules.Generate
+import Target
+import Utilities
+
+compilePackage :: [(Resource, Int)] -> Context -> Rules ()
+compilePackage rs context@Context {..} = do
+ let dir = "//" ++ contextDir context
+ nonHs extension = dir -/- extension <//> "*" <.> osuf way
+ compile compiler obj2src obj = do
+ src <- obj2src context obj
+ need [src]
+ needDependencies context src $ obj <.> "d"
+ buildWithResources rs $ target context (compiler stage) [src] [obj]
+ compileHs = \[obj, _hi] -> do
+ path <- buildPath context
+ (src, deps) <- lookupDependencies (path -/- ".dependencies") obj
+ need $ src : deps
+ when (isLibrary package) $ need =<< return <$> pkgConfFile context
+ needLibrary =<< contextDependencies context
+ buildWithResources rs $ target context (Ghc CompileHs stage) [src] [obj]
+
+ priority 2.0 $ do
+ nonHs "c" %> compile (Ghc CompileCWithGhc) (obj2src "c" isGeneratedCFile )
+ nonHs "cmm" %> compile (Ghc CompileHs) (obj2src "cmm" isGeneratedCmmFile)
+ nonHs "s" %> compile (Ghc CompileHs) (obj2src "S" $ const False )
+
+ -- TODO: Add dependencies for #include of .h and .hs-incl files (gcc -MM?).
+ [ dir <//> "*" <.> suf way | suf <- [ osuf, hisuf] ] &%> compileHs
+ [ dir <//> "*" <.> suf way | suf <- [obootsuf, hibootsuf] ] &%> compileHs
+
+-- | Discover dependencies of a given source file by iteratively calling @gcc@
+-- in the @-MM -MG@ mode and building generated dependencies if they are missing
+-- until reaching a fixed point.
+needDependencies :: Context -> FilePath -> FilePath -> Action ()
+needDependencies context@Context {..} src depFile = discover
+ where
+ discover = do
+ build $ target context (Cc FindCDependencies stage) [src] [depFile]
+ deps <- parseFile depFile
+ -- Generated dependencies, if not yet built, will not be found and hence
+ -- will be referred to simply by their file names.
+ let notFound = filter (\file -> file == takeFileName file) deps
+ -- We find the full paths to generated dependencies, so we can request
+ -- to build them by calling 'need'.
+ todo <- catMaybes <$> mapM (fullPathIfGenerated context) notFound
+
+ if null todo
+ then need deps -- The list of dependencies is final, need all
+ else do
+ need todo -- Build newly discovered generated dependencies
+ discover -- Continue the discovery process
+
+ parseFile :: FilePath -> Action [String]
+ parseFile file = do
+ input <- liftIO $ readFile file
+ case parseMakefile input of
+ [(_file, deps)] -> return deps
+ _ -> return []
+
+-- | Find a given 'FilePath' in the list of generated files in the given
+-- 'Context' and return its full path.
+fullPathIfGenerated :: Context -> FilePath -> Action (Maybe FilePath)
+fullPathIfGenerated context file = interpretInContext context $ do
+ generated <- generatedDependencies
+ return $ find ((== file) . takeFileName) generated
+
+obj2src :: String -> (FilePath -> Bool) -> Context -> FilePath -> Action FilePath
+obj2src extension isGenerated context@Context {..} obj
+ | isGenerated src = return src
+ | otherwise = (pkgPath package ++) <$> suffix
+ where
+ src = obj -<.> extension
+ suffix = do
+ path <- buildPath context
+ return $ fromMaybe ("Cannot determine source for " ++ obj)
+ $ stripPrefix (path -/- extension) src
diff --git a/hadrian/src/Rules/Configure.hs b/hadrian/src/Rules/Configure.hs
new file mode 100644
index 0000000000..dd016c149f
--- /dev/null
+++ b/hadrian/src/Rules/Configure.hs
@@ -0,0 +1,42 @@
+module Rules.Configure (configureRules) where
+
+import qualified System.Info.Extra as System
+
+import Base
+import Builder
+import CommandLine
+import Context
+import GHC
+import Target
+import Utilities
+
+configureRules :: Rules ()
+configureRules = do
+ [configFile, "settings", configH] &%> \outs -> do
+ skip <- cmdSkipConfigure
+ if skip
+ then unlessM (doesFileExist configFile) $
+ error $ "Configuration file " ++ configFile ++ " is missing."
+ ++ "\nRun the configure script manually or do not use the "
+ ++ "--skip-configure flag."
+ else do
+ -- We cannot use windowsHost here due to a cyclic dependency.
+ when System.isWindows $ do
+ putBuild "| Checking for Windows tarballs..."
+ quietly $ cmd ["bash", "mk/get-win32-tarballs.sh", "download", System.arch]
+ let srcs = map (<.> "in") outs
+ context = vanillaContext Stage0 compiler
+ need srcs
+ build $ target context (Configure ".") srcs outs
+
+ ["configure", configH <.> "in"] &%> \_ -> do
+ skip <- cmdSkipConfigure
+ if skip
+ then unlessM (doesFileExist "configure") $
+ error $ "The configure script is missing.\nRun the boot script"
+ ++ " manually or do not use the --skip-configure flag."
+ else do
+ need ["configure.ac"]
+ putBuild "| Running boot..."
+ verbosity <- getVerbosity
+ quietly $ cmd [EchoStdout (verbosity >= Loud)] "python3 boot"
diff --git a/hadrian/src/Rules/Dependencies.hs b/hadrian/src/Rules/Dependencies.hs
new file mode 100644
index 0000000000..f27ef0d912
--- /dev/null
+++ b/hadrian/src/Rules/Dependencies.hs
@@ -0,0 +1,33 @@
+module Rules.Dependencies (buildPackageDependencies) where
+
+import Data.Bifunctor
+import Data.Function
+
+import Base
+import Context
+import Expression
+import Oracles.ModuleFiles
+import Rules.Generate
+import Target
+import Utilities
+
+buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules ()
+buildPackageDependencies rs context@Context {..} =
+ "//" ++ contextDir context -/- ".dependencies" %> \deps -> do
+ srcs <- hsSources context
+ need srcs
+ orderOnly =<< interpretInContext context generatedDependencies
+ let mk = deps <.> "mk"
+ if null srcs
+ then writeFileChanged mk ""
+ else buildWithResources rs $
+ target context (Ghc FindHsDependencies stage) srcs [mk]
+ removeFile $ mk <.> "bak"
+ mkDeps <- readFile' mk
+ writeFileChanged deps . unlines
+ . map (\(src, deps) -> unwords $ src : deps)
+ . map (bimap unifyPath (map unifyPath))
+ . map (bimap head concat . unzip)
+ . groupBy ((==) `on` fst)
+ . sortBy (compare `on` fst)
+ $ parseMakefile mkDeps
diff --git a/hadrian/src/Rules/Documentation.hs b/hadrian/src/Rules/Documentation.hs
new file mode 100644
index 0000000000..5a5698c995
--- /dev/null
+++ b/hadrian/src/Rules/Documentation.hs
@@ -0,0 +1,197 @@
+module Rules.Documentation (
+ -- * Rules
+ buildPackageDocumentation, documentationRules,
+
+ -- * Utilities
+ haddockDependencies
+ ) where
+
+import Base
+import Context
+import Flavour
+import GHC
+import Oracles.ModuleFiles
+import Oracles.PackageData
+import Settings
+import Target
+import Utilities
+
+-- | Build all documentation
+documentationRules :: Rules ()
+documentationRules = do
+ buildHtmlDocumentation
+ buildPdfDocumentation
+ buildDocumentationArchives
+ buildManPage
+ "//docs//gen_contents_index" %> copyFile "libraries/gen_contents_index"
+ "//docs//prologue.txt" %> copyFile "libraries/prologue.txt"
+ "docs" ~> do
+ root <- buildRoot
+ let html = htmlRoot -/- "index.html"
+ archives = map pathArchive docPaths
+ pdfs = map pathPdf $ docPaths \\ [ "libraries" ]
+ need $ map (root -/-) $ [html] ++ archives ++ pdfs
+ need [ root -/- htmlRoot -/- "libraries" -/- "gen_contents_index" ]
+ need [ root -/- htmlRoot -/- "libraries" -/- "prologue.txt" ]
+ need [manPagePath]
+
+manPagePath :: FilePath
+manPagePath = "_build/docs/users_guide/build-man/ghc.1"
+
+-- TODO: Add support for Documentation Packages so we can
+-- run the builders without this hack.
+docPackage :: Package
+docPackage = hsLibrary "Documentation" "docs"
+
+docPaths :: [FilePath]
+docPaths = [ "libraries", "users_guide", "Haddock" ]
+
+docRoot :: FilePath
+docRoot = "docs"
+
+htmlRoot :: FilePath
+htmlRoot = docRoot -/- "html"
+
+pdfRoot :: FilePath
+pdfRoot = docRoot -/- "pdfs"
+
+archiveRoot :: FilePath
+archiveRoot = docRoot -/- "archives"
+
+pathPdf :: FilePath -> FilePath
+pathPdf path = pdfRoot -/- path <.> ".pdf"
+
+pathIndex :: FilePath -> FilePath
+pathIndex path = htmlRoot -/- path -/- "index.html"
+
+pathArchive :: FilePath -> FilePath
+pathArchive path = archiveRoot -/- path <.> "html.tar.xz"
+
+-- TODO: Replace this with pkgPath when support is added
+-- for Documentation Packages.
+pathPath :: FilePath -> FilePath
+pathPath "users_guide" = "docs/users_guide"
+pathPath "Haddock" = "utils/haddock/doc"
+pathPath _ = ""
+
+----------------------------------------------------------------------
+-- HTML
+
+-- | Build all HTML documentation
+buildHtmlDocumentation :: Rules ()
+buildHtmlDocumentation = do
+ mapM_ buildSphinxHtml $ docPaths \\ [ "libraries" ]
+ buildLibraryDocumentation
+ "//" ++ htmlRoot -/- "index.html" %> \file -> do
+ root <- buildRoot
+ need $ map ((root -/-) . pathIndex) docPaths
+ copyFileUntracked "docs/index.html" file
+
+-----------------------------
+-- Sphinx
+
+-- | Compile a Sphinx ReStructured Text package to HTML
+buildSphinxHtml :: FilePath -> Rules ()
+buildSphinxHtml path = do
+ "//" ++ htmlRoot -/- path -/- "index.html" %> \file -> do
+ let dest = takeDirectory file
+ context = vanillaContext Stage0 docPackage
+ build $ target context (Sphinx Html) [pathPath path] [dest]
+
+-----------------------------
+-- Haddock
+
+-- | Build the haddocks for GHC's libraries
+buildLibraryDocumentation :: Rules ()
+buildLibraryDocumentation = do
+ "//" ++ htmlRoot -/- "libraries/index.html" %> \file -> do
+ haddocks <- allHaddocks
+ need haddocks
+ let libDocs = filter (\x -> takeFileName x /= "ghc.haddock") haddocks
+ context = vanillaContext Stage2 docPackage
+ build $ target context (Haddock BuildIndex) libDocs [file]
+
+allHaddocks :: Action [FilePath]
+allHaddocks = do
+ pkgs <- stagePackages Stage1
+ sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg
+ | pkg <- pkgs, isLibrary pkg, isHsPackage pkg ]
+
+haddockHtmlLib :: FilePath
+haddockHtmlLib = "inplace/lib/html/haddock-util.js"
+
+-- | Find the haddock files for the dependencies of the current library
+haddockDependencies :: Context -> Action [FilePath]
+haddockDependencies context = do
+ path <- buildPath context
+ depNames <- pkgDataList $ DepNames path
+ sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg
+ | Just depPkg <- map findPackageByName depNames, depPkg /= rts ]
+
+-- Note: this build rule creates plenty of files, not just the .haddock one.
+-- All of them go into the 'doc' subdirectory. Pedantically tracking all built
+-- files in the Shake database seems fragile and unnecessary.
+buildPackageDocumentation :: Context -> Rules ()
+buildPackageDocumentation context@Context {..} = when (stage == Stage1) $ do
+
+ -- Js and Css files for haddock output
+ when (package == haddock) $ haddockHtmlLib %> \_ -> do
+ let dir = takeDirectory haddockHtmlLib
+ liftIO $ removeFiles dir ["//*"]
+ copyDirectory "utils/haddock/haddock-api/resources/html" dir
+
+ -- Per-package haddocks
+ "//" ++ pkgName package <.> "haddock" %> \file -> do
+ haddocks <- haddockDependencies context
+ srcs <- hsSources context
+ need $ srcs ++ haddocks ++ [haddockHtmlLib]
+
+ -- Build Haddock documentation
+ -- TODO: pass the correct way from Rules via Context
+ dynamicPrograms <- dynamicGhcPrograms <$> flavour
+ let haddockWay = if dynamicPrograms then dynamic else vanilla
+ build $ target (context {way = haddockWay}) (Haddock BuildPackage)
+ srcs [file]
+
+----------------------------------------------------------------------
+-- PDF
+
+-- | Build all PDF documentation
+buildPdfDocumentation :: Rules ()
+buildPdfDocumentation = mapM_ buildSphinxPdf docPaths
+
+-- | Compile a Sphinx ReStructured Text package to LaTeX
+buildSphinxPdf :: FilePath -> Rules ()
+buildSphinxPdf path = do
+ "//" ++ path <.> "pdf" %> \file -> do
+ let context = vanillaContext Stage0 docPackage
+ withTempDir $ \dir -> do
+ build $ target context (Sphinx Latex) [pathPath path] [dir]
+ build $ target context Xelatex [path <.> "tex"] [dir]
+ copyFileUntracked (dir -/- path <.> "pdf") file
+
+----------------------------------------------------------------------
+-- Archive
+
+-- | Build archives of documentation
+buildDocumentationArchives :: Rules ()
+buildDocumentationArchives = mapM_ buildArchive docPaths
+
+buildArchive :: FilePath -> Rules ()
+buildArchive path = do
+ "//" ++ pathArchive path %> \file -> do
+ root <- buildRoot
+ let context = vanillaContext Stage0 docPackage
+ src = root -/- pathIndex path
+ need [src]
+ build $ target context (Tar Create) [takeDirectory src] [file]
+
+-- | build man page
+buildManPage :: Rules ()
+buildManPage = do
+ manPagePath %> \file -> do
+ need ["docs/users_guide/ghc.rst"]
+ let context = vanillaContext Stage0 docPackage
+ withTempDir $ \dir -> do
+ build $ target context (Sphinx Man) ["docs/users_guide"] [dir]
+ copyFileUntracked (dir -/- "ghc.1") file
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
new file mode 100644
index 0000000000..8e2b65d183
--- /dev/null
+++ b/hadrian/src/Rules/Generate.hs
@@ -0,0 +1,482 @@
+module Rules.Generate (
+ isGeneratedCFile, isGeneratedCmmFile, generatePackageCode, generateRules,
+ copyRules, includesDependencies, generatedDependencies
+ ) where
+
+import Base
+import Expression
+import Flavour
+import Oracles.Flag
+import Oracles.ModuleFiles
+import Oracles.Setting
+import Rules.Gmp
+import Rules.Libffi
+import Target
+import Settings
+import Settings.Packages.Rts
+import Utilities
+
+-- | 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"
+
+primopsTxt :: Stage -> FilePath
+primopsTxt stage = contextDir (vanillaContext stage compiler) -/- "primops.txt"
+
+platformH :: Stage -> FilePath
+platformH stage = contextDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h"
+
+isGeneratedCFile :: FilePath -> Bool
+isGeneratedCFile file = takeBaseName file `elem` ["Evac_thr", "Scav_thr"]
+
+isGeneratedCmmFile :: FilePath -> Bool
+isGeneratedCmmFile file = takeBaseName file == "AutoApply"
+
+includesDependencies :: [FilePath]
+includesDependencies = fmap (generatedDir -/-)
+ [ "ghcautoconf.h"
+ , "ghcplatform.h"
+ , "ghcversion.h" ]
+
+ghcPrimDependencies :: Expr [FilePath]
+ghcPrimDependencies = do
+ stage <- getStage
+ path <- expr $ buildPath (vanillaContext stage ghcPrim)
+ return [path -/- "GHC/Prim.hs", path -/- "GHC/PrimopWrappers.hs"]
+
+derivedConstantsDependencies :: [FilePath]
+derivedConstantsDependencies = fmap (generatedDir -/-)
+ [ "DerivedConstants.h"
+ , "GHCConstantsHaskellExports.hs"
+ , "GHCConstantsHaskellType.hs"
+ , "GHCConstantsHaskellWrappers.hs" ]
+
+compilerDependencies :: Expr [FilePath]
+compilerDependencies = do
+ root <- getBuildRoot
+ stage <- getStage
+ isGmp <- (== integerGmp) <$> getIntegerPackage
+ ghcPath <- expr $ buildPath (vanillaContext stage compiler)
+ gmpPath <- expr gmpBuildPath
+ rtsPath <- expr rtsBuildPath
+ mconcat [ return [root -/- platformH stage]
+ , return ((root -/-) <$> includesDependencies)
+ , return ((root -/-) <$> derivedConstantsDependencies)
+ , notStage0 ? isGmp ? return [gmpPath -/- gmpLibraryH]
+ , notStage0 ? return ((rtsPath -/-) <$> libffiDependencies)
+ , return $ fmap (ghcPath -/-)
+ [ "primop-can-fail.hs-incl"
+ , "primop-code-size.hs-incl"
+ , "primop-commutable.hs-incl"
+ , "primop-data-decl.hs-incl"
+ , "primop-fixity.hs-incl"
+ , "primop-has-side-effects.hs-incl"
+ , "primop-list.hs-incl"
+ , "primop-out-of-line.hs-incl"
+ , "primop-primop-info.hs-incl"
+ , "primop-strictness.hs-incl"
+ , "primop-tag.hs-incl"
+ , "primop-vector-tycons.hs-incl"
+ , "primop-vector-tys-exports.hs-incl"
+ , "primop-vector-tys.hs-incl"
+ , "primop-vector-uniques.hs-incl" ] ]
+
+generatedDependencies :: Expr [FilePath]
+generatedDependencies = do
+ root <- getBuildRoot
+ rtsPath <- expr rtsBuildPath
+ mconcat [ package compiler ? compilerDependencies
+ , package ghcPrim ? ghcPrimDependencies
+ , package rts ? return (fmap (rtsPath -/-) libffiDependencies
+ ++ fmap (root -/-) includesDependencies
+ ++ fmap (root -/-) derivedConstantsDependencies)
+ , stage0 ? return (fmap (root -/-) includesDependencies) ]
+
+generate :: FilePath -> Context -> Expr String -> Action ()
+generate file context expr = do
+ contents <- interpretInContext context expr
+ writeFileChanged file contents
+ putSuccess $ "| Successfully generated " ++ file ++ "."
+
+generatePackageCode :: Context -> Rules ()
+generatePackageCode context@(Context stage pkg _) =
+ let dir = contextDir context
+ generated f = ("//" ++ dir ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
+ go gen file = generate file context gen
+ in do
+ generated ?> \file -> do
+ let unpack = fromMaybe . error $ "No generator for " ++ file ++ "."
+ (src, builder) <- unpack <$> findGenerator context file
+ need [src]
+ build $ target context builder [src] [file]
+ let boot = src -<.> "hs-boot"
+ whenM (doesFileExist boot) . copyFile boot $ file -<.> "hs-boot"
+
+ priority 2.0 $ do
+ when (pkg == compiler) $ "//" -/- dir -/- "Config.hs" %> go generateConfigHs
+ when (pkg == ghcPkg) $ "//" -/- dir -/- "Version.hs" %> go generateVersionHs
+
+ -- TODO: needing platformH is ugly and fragile
+ when (pkg == compiler) $ do
+ "//" ++ primopsTxt stage %> \file -> do
+ root <- buildRoot
+ need $ [root -/- platformH stage, primopsSource]
+ ++ fmap (root -/-) includesDependencies
+ build $ target context HsCpp [primopsSource] [file]
+
+ "//" ++ platformH stage %> go generateGhcBootPlatformH
+
+ -- TODO: why different folders for generated files?
+ priority 2.0 $ fmap (("//" ++ dir) -/-)
+ [ "GHC/Prim.hs"
+ , "GHC/PrimopWrappers.hs"
+ , "*.hs-incl" ] |%> \file -> do
+ root <- buildRoot
+ need [root -/- primopsTxt stage]
+ build $ target context GenPrimopCode [root -/- primopsTxt stage] [file]
+
+ when (pkg == rts) $ "//" ++ dir -/- "cmm/AutoApply.cmm" %> \file ->
+ build $ target context GenApply [] [file]
+
+copyRules :: Rules ()
+copyRules = do
+ (inplaceLibPath -/- "ghc-usage.txt") <~ return "driver"
+ (inplaceLibPath -/- "ghci-usage.txt" ) <~ return "driver"
+ (inplaceLibPath -/- "llvm-targets") <~ return "."
+ (inplaceLibPath -/- "platformConstants") <~ (buildRoot <&> (-/- generatedDir))
+ (inplaceLibPath -/- "settings") <~ return "."
+ (inplaceLibPath -/- "template-hsc.h") <~ return (pkgPath hsc2hs)
+ "//c/sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c")
+ "//c/sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c")
+ where
+ pattern <~ mdir = pattern %> \file -> do
+ dir <- mdir
+ copyFile (dir -/- takeFileName file) file
+
+generateRules :: Rules ()
+generateRules = do
+ priority 2.0 $ ("//" ++ generatedDir -/- "ghcautoconf.h") <~ generateGhcAutoconfH
+ priority 2.0 $ ("//" ++ generatedDir -/- "ghcplatform.h") <~ generateGhcPlatformH
+ priority 2.0 $ ("//" ++ generatedDir -/- "ghcversion.h") <~ generateGhcVersionH
+
+ ghcSplitPath %> \_ -> do
+ generate ghcSplitPath emptyTarget generateGhcSplit
+ makeExecutable ghcSplitPath
+
+ -- TODO: simplify, get rid of fake rts context
+ "//" ++ generatedDir ++ "//*" %> \file -> do
+ withTempDir $ \dir -> build $
+ target rtsContext DeriveConstants [] [file, dir]
+ where
+ file <~ gen = file %> \out -> generate out emptyTarget gen
+
+-- TODO: Use the Types, Luke! (drop partial function)
+-- We sometimes need to evaluate expressions that do not require knowing all
+-- information about the context. In this case, we don't want to know anything.
+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 <- expr $ flag 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
+ intLib <- getIntegerPackage
+ debugged <- ghcDebugged <$> expr flavour
+ let cIntegerLibraryType
+ | intLib == integerGmp = "IntegerGMP"
+ | intLib == integerSimple = "IntegerSimple"
+ | otherwise = error $ "Unknown integer library: " ++ pkgName intLib
+ 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 <- expr $ flag WithLibdw
+ let cGhcRTSWays = unwords $ map show rtsWays
+ return $ unlines
+ [ "{-# LANGUAGE CPP #-}"
+ , "module Config where"
+ , ""
+ , "import GhcPrelude"
+ , ""
+ , "#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 (pkgName intLib)
+ , "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 debugged
+ , "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 <- expr $ flag 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
+ llvmTarget <- getSetting LlvmTarget
+ 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 LLVM_TARGET " ++ show llvmTarget
+ , ""
+ , "#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/hadrian/src/Rules/Gmp.hs b/hadrian/src/Rules/Gmp.hs
new file mode 100644
index 0000000000..46fad8a32c
--- /dev/null
+++ b/hadrian/src/Rules/Gmp.hs
@@ -0,0 +1,119 @@
+module Rules.Gmp (
+ gmpRules, gmpBuildPath, gmpObjectsDir, gmpLibraryH, gmpBuildInfoPath
+ ) where
+
+import Base
+import Context
+import GHC
+import Oracles.Setting
+import Target
+import Utilities
+
+gmpBase :: FilePath
+gmpBase = pkgPath integerGmp -/- "gmp"
+
+gmpLibraryInTreeH :: FilePath
+gmpLibraryInTreeH = "include/gmp.h"
+
+gmpLibrary :: FilePath
+gmpLibrary = ".libs/libgmp.a"
+
+-- | GMP is considered a Stage1 package. This determines GMP build directory.
+gmpContext :: Context
+gmpContext = vanillaContext Stage1 integerGmp
+
+-- | Build directory for in-tree GMP library.
+gmpBuildPath :: Action FilePath
+gmpBuildPath = buildRoot <&> (-/- stageString (stage gmpContext) -/- "gmp")
+
+-- | GMP library header, relative to 'gmpBuildPath'.
+gmpLibraryH :: FilePath
+gmpLibraryH = "include/ghc-gmp.h"
+
+-- | Directory for GMP library object files, relative to 'gmpBuildPath'.
+gmpObjectsDir :: FilePath
+gmpObjectsDir = "objs"
+
+-- | Path to the GMP library buildinfo file.
+gmpBuildInfoPath :: FilePath
+gmpBuildInfoPath = pkgPath integerGmp -/- "integer-gmp.buildinfo"
+
+configureEnvironment :: Action [CmdOption]
+configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
+ , builderEnvironment "AR" (Ar Unpack Stage1)
+ , builderEnvironment "NM" Nm ]
+
+gmpRules :: Rules ()
+gmpRules = do
+ -- Copy appropriate GMP header and object files
+ "//" ++ gmpLibraryH %> \header -> do
+ windows <- windowsHost
+ configMk <- readFile' $ gmpBase -/- "config.mk"
+ if not windows && -- TODO: We don't use system GMP on Windows. Fix?
+ any (`isInfixOf` configMk) [ "HaveFrameworkGMP = YES", "HaveLibGmp = YES" ]
+ then do
+ putBuild "| GMP library/framework detected and will be used"
+ copyFile (gmpBase -/- "ghc-gmp.h") header
+ else do
+ putBuild "| No GMP library/framework detected; in tree GMP will be built"
+ gmpPath <- gmpBuildPath
+ need [gmpPath -/- gmpLibrary]
+ createDirectory (gmpPath -/- gmpObjectsDir)
+ top <- topDirectory
+ build $ target gmpContext (Ar Unpack Stage1)
+ [top -/- gmpPath -/- gmpLibrary] [gmpPath -/- gmpObjectsDir]
+ copyFile (gmpPath -/- "gmp.h") header
+ copyFile (gmpPath -/- "gmp.h") (gmpPath -/- gmpLibraryInTreeH)
+
+ -- Build in-tree GMP library
+ "//" ++ gmpLibrary %> \lib -> do
+ gmpPath <- gmpBuildPath
+ build $ target gmpContext (Make gmpPath) [gmpPath -/- "Makefile"] [lib]
+ putSuccess "| Successfully built custom library 'gmp'"
+
+ -- In-tree GMP header is built by the gmpLibraryH rule
+ "//" ++ gmpLibraryInTreeH %> \_ -> do
+ gmpPath <- gmpBuildPath
+ need [gmpPath -/- gmpLibraryH]
+
+ -- This causes integerGmp package to be configured, hence creating the files
+ [gmpBase -/- "config.mk", gmpBuildInfoPath] &%> \_ -> do
+ dataFile <- pkgDataFile gmpContext
+ need [dataFile]
+
+ -- Run GMP's configure script
+ -- TODO: Get rid of hard-coded @gmp@.
+ "//gmp/Makefile" %> \mk -> do
+ env <- configureEnvironment
+ gmpPath <- gmpBuildPath
+ need [mk <.> "in"]
+ buildWithCmdOptions env $
+ target gmpContext (Configure gmpPath) [mk <.> "in"] [mk]
+
+ -- Extract in-tree GMP sources and apply patches
+ "//gmp/Makefile.in" %> \_ -> do
+ gmpPath <- gmpBuildPath
+ removeDirectory gmpPath
+ -- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is
+ -- 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 . fromSingleton "Exactly one GMP tarball is expected"
+ <$> getDirectoryFiles "" [gmpBase -/- "gmp-tarballs/gmp*.tar.bz2"]
+
+ withTempDir $ \dir -> do
+ let tmp = unifyPath dir
+ need [tarball]
+ build $ target gmpContext (Tar Extract) [tarball] [tmp]
+
+ let patch = gmpBase -/- "gmpsrc.patch"
+ patchName = takeFileName patch
+ copyFile patch $ tmp -/- patchName
+ applyPatch tmp patchName
+
+ let name = dropExtension . dropExtension $ takeFileName tarball
+ unpack = fromMaybe . error $ "gmpRules: expected suffix "
+ ++ "-nodoc (found: " ++ name ++ ")."
+ libName = unpack $ stripSuffix "-nodoc" name
+
+ moveDirectory (tmp -/- libName) gmpPath
diff --git a/hadrian/src/Rules/Install.hs b/hadrian/src/Rules/Install.hs
new file mode 100644
index 0000000000..bcdbf33e34
--- /dev/null
+++ b/hadrian/src/Rules/Install.hs
@@ -0,0 +1,336 @@
+module Rules.Install (installRules) where
+
+import Hadrian.Oracles.DirectoryContents
+import qualified System.Directory as IO
+
+import Base
+import Expression
+import Oracles.Setting
+import Rules
+import Rules.Generate
+import Rules.Libffi
+import Rules.Wrappers
+import Settings
+import Settings.Packages.Rts
+import Target
+import Utilities
+
+{- | Install the built binaries etc. to the @destDir ++ prefix@.
+
+The installation prefix is usually @/usr/local@ on a Unix system.
+The resulting tree structure is organized under @destDir ++ prefix@ as follows:
+
+* @bin@: executable wrapper scripts, installed by 'installBins', e.g. @ghc@.
+
+* @lib/ghc-<version>/bin@: executable binaries/scripts,
+ installed by 'installLibExecs' and 'installLibExecScripts'.
+
+* @lib/ghc-<version>/include@: headers etc., installed by 'installIncludes'.
+
+* @lib/ghc-<version>/<pkg-name>@: built packages, e.g. @base@, installed
+ by 'installPackages'.
+
+* @lib/ghc-<version>/settings@ etc.: other files in @lib@ directory,
+ installed by 'installCommonLibs'.
+
+XXX (izgzhen): Do we need @INSTALL_OPTS@ in the make scripts?
+-}
+installRules :: Rules ()
+installRules =
+ "install" ~> do
+ installIncludes
+ installPackageConf
+ installCommonLibs
+ installLibExecs
+ installLibExecScripts
+ installBins
+ installPackages
+ installDocs
+
+-- TODO: Get rid of hard-coded list.
+-- | Binaries to install.
+installBinPkgs :: [Package]
+installBinPkgs = [ghc, ghcPkg, ghcSplit, hp2ps, hpc, hsc2hs, runGhc, unlit]
+
+getLibExecDir :: Action FilePath
+getLibExecDir = (-/- "bin") <$> installGhcLibDir
+
+-- ref: ghc.mk
+-- | Install executable scripts to @prefix/lib/bin@.
+installLibExecScripts :: Action ()
+installLibExecScripts = do
+ libExecDir <- getLibExecDir
+ destDir <- getDestDir
+ installDirectory (destDir ++ libExecDir)
+ forM_ libExecScripts $ \script -> installScript script (destDir ++ libExecDir)
+ where
+ libExecScripts :: [FilePath]
+ libExecScripts = [ghcSplitPath]
+
+-- ref: ghc.mk
+-- | Install executable binaries to @prefix/lib/bin@.
+installLibExecs :: Action ()
+installLibExecs = do
+ libExecDir <- getLibExecDir
+ destDir <- getDestDir
+ installDirectory (destDir ++ libExecDir)
+ forM_ installBinPkgs $ \pkg ->
+ withInstallStage pkg $ \stage -> do
+ context <- programContext stage pkg
+ let bin = inplaceLibBinPath -/- programName context <.> exe
+ installProgram bin (destDir ++ libExecDir)
+ when (pkg == ghc) $
+ moveFile (destDir ++ libExecDir -/- programName context <.> exe)
+ (destDir ++ libExecDir -/- "ghc" <.> exe)
+
+-- ref: ghc.mk
+-- | Install executable wrapper scripts to @prefix/bin@.
+installBins :: Action ()
+installBins = do
+ binDir <- setting InstallBinDir
+ libDir <- installGhcLibDir
+ destDir <- getDestDir
+ installDirectory (destDir ++ binDir)
+ win <- windowsHost
+ when win $
+ copyDirectoryContents matchAll (destDir ++ libDir -/- "bin") (destDir ++ binDir)
+ unless win $ forM_ installBinPkgs $ \pkg ->
+ withInstallStage pkg $ \stage -> do
+ context <- programContext stage pkg
+ version <- setting ProjectVersion
+ -- Name of the binary file
+ let binName | pkg == ghc = "ghc-" ++ version <.> exe
+ | otherwise = programName context ++ "-" ++ version <.> exe
+ -- Name of the symbolic link
+ let symName | pkg == ghc = "ghc" <.> exe
+ | otherwise = programName context <.> exe
+ case lookup context installWrappers of
+ Nothing -> return ()
+ Just wrapper -> do
+ contents <- interpretInContext context $
+ wrapper (WrappedBinary (destDir ++ libDir) symName)
+ let wrapperPath = destDir ++ binDir -/- binName
+ writeFileChanged wrapperPath contents
+ makeExecutable wrapperPath
+ unlessM windowsHost $
+ linkSymbolic (destDir ++ binDir -/- binName)
+ (destDir ++ binDir -/- symName)
+
+-- | Perform an action depending on the install stage or do nothing if the
+-- package is not installed.
+withInstallStage :: Package -> (Stage -> Action ()) -> Action ()
+withInstallStage pkg m = do
+ maybeStage <- installStage pkg
+ case maybeStage of { Just stage -> m stage; Nothing -> return () }
+
+pkgConfInstallPath :: Action FilePath
+pkgConfInstallPath = buildPath (vanillaContext Stage0 rts) <&> (-/- "package.conf.install")
+
+-- ref: rules/manual-package-conf.mk
+-- TODO: Should we use a temporary file instead of pkgConfInstallPath?
+-- | Install @package.conf.install@ for each package. Note that it will be
+-- recreated each time.
+installPackageConf :: Action ()
+installPackageConf = do
+ let context = vanillaContext Stage0 rts
+ confPath <- pkgConfInstallPath
+ liftIO $ IO.createDirectoryIfMissing True (takeDirectory confPath)
+ build $ target context HsCpp [ pkgPath rts -/- "package.conf.in" ]
+ [ confPath <.> "raw" ]
+ Stdout content <- cmd "grep" [ "-v", "^#pragma GCC"
+ , confPath <.> "raw" ]
+ withTempFile $ \tmp -> do
+ liftIO $ writeFile tmp content
+ Stdout result <- cmd "sed" [ "-e", "s/\"\"//g", "-e", "s/:[ ]*,/: /g", tmp ]
+ liftIO $ writeFile confPath result
+
+-- ref: ghc.mk
+-- | Install packages to @prefix/lib@.
+installPackages :: Action ()
+installPackages = do
+ confPath <- pkgConfInstallPath
+ need [confPath]
+
+ ghcLibDir <- installGhcLibDir
+ binDir <- setting InstallBinDir
+ destDir <- getDestDir
+
+ -- Install package.conf
+ let installedPackageConf = destDir ++ ghcLibDir -/- "package.conf.d"
+ installDirectory (destDir ++ ghcLibDir)
+ removeDirectory installedPackageConf
+ installDirectory installedPackageConf
+
+ -- Install RTS
+ let rtsDir = destDir ++ ghcLibDir -/- "rts"
+ installDirectory rtsDir
+ ways <- interpretInContext (vanillaContext Stage1 rts) getRtsWays
+ rtsLibs <- mapM (pkgLibraryFile . Context Stage1 rts) ways
+ ffiLibs <- mapM rtsLibffiLibrary ways
+
+ -- TODO: Add dynamic libraries.
+ forM_ (rtsLibs ++ ffiLibs) $ \lib -> installData [lib] rtsDir
+
+ -- TODO: Remove this hack required for @ghc-cabal copy@.
+ -- See https://github.com/snowleopard/hadrian/issues/327.
+ ghcBootPlatformHeader <-
+ buildPath (vanillaContext Stage1 compiler) <&> (-/- "ghc_boot_platform.h")
+ copyFile ghcBootPlatformHeader (pkgPath compiler -/- "ghc_boot_platform.h")
+
+ installPackages <- filterM ((isJust <$>) . installStage)
+ (knownPackages \\ [rts, libffi])
+
+ installLibPkgs <- topsortPackages (filter isLibrary installPackages)
+
+ -- TODO: Figure out what is the root cause of the missing ghc-gmp.h error.
+ copyFile (pkgPath integerGmp -/- "gmp/ghc-gmp.h") (pkgPath integerGmp -/- "ghc-gmp.h")
+
+ forM_ installLibPkgs $ \pkg ->
+ case pkgCabalFile pkg of
+ Nothing -> error $ "Non-Haskell project in installLibPkgs" ++ show pkg
+ Just cabalFile -> withInstallStage pkg $ \stage -> do
+ let context = vanillaContext stage pkg
+ top <- topDirectory
+ installDistDir <- buildPath context
+ let absInstallDistDir = top -/- installDistDir
+
+ need =<< packageTargets True stage pkg
+ docDir <- installDocDir
+ ghclibDir <- installGhcLibDir
+
+ -- Copy over packages
+ strip <- stripCmdPath
+ ways <- interpretInContext context getLibraryWays
+ -- TODO: Remove hard-coded @ghc-cabal@ path.
+ let ghcCabalInplace = inplaceBinPath -/- "ghc-cabal" <.> exe
+ need [ghcCabalInplace]
+
+ pkgConf <- pkgConfFile context
+ need [cabalFile, pkgConf] -- TODO: Check if we need 'pkgConf'.
+
+ -- TODO: Drop redundant copies required by @ghc-cabal@.
+ -- See https://github.com/snowleopard/hadrian/issues/318.
+ quietly $ copyDirectoryContentsUntracked (Not excluded)
+ installDistDir (installDistDir -/- "build")
+
+ pref <- setting InstallPrefix
+ unit $ cmd ghcCabalInplace [ "copy"
+ , pkgPath pkg
+ , absInstallDistDir
+ , strip
+ , destDir
+ , pref
+ , ghclibDir
+ , docDir -/- "html/libraries"
+ , unwords (map show ways) ]
+
+ -- Register packages
+ let installedGhcPkgReal = destDir ++ binDir -/- "ghc-pkg" <.> exe
+ installedGhcReal = destDir ++ binDir -/- "ghc" <.> exe
+ -- TODO: Extend GhcPkg builder args to support --global-package-db
+ unit $ cmd installedGhcPkgReal [ "--force", "--global-package-db"
+ , installedPackageConf, "update"
+ , confPath ]
+
+ forM_ installLibPkgs $ \pkg ->
+ withInstallStage pkg $ \stage -> do
+ let context = vanillaContext stage pkg
+ top <- topDirectory
+ installDistDir <- (top -/-) <$> buildPath context
+ -- TODO: better reference to the built inplace binary path
+ let ghcCabalInplace = inplaceBinPath -/- "ghc-cabal"
+ pref <- setting InstallPrefix
+ docDir <- installDocDir
+ r <- relocatableBuild
+ unit $ cmd ghcCabalInplace
+ [ "register"
+ , pkgPath pkg
+ , installDistDir
+ , installedGhcReal
+ , installedGhcPkgReal
+ , destDir ++ ghcLibDir
+ , destDir
+ , destDir ++ pref
+ , destDir ++ ghcLibDir
+ , destDir ++ docDir -/- "html/libraries"
+ , if r then "YES" else "NO" ]
+
+ confs <- getDirectoryContents installedPackageConf
+ forM_ confs (\f -> createData $ installedPackageConf -/- f)
+ unit $ cmd installedGhcPkgReal [ "--force", "--global-package-db"
+ , installedPackageConf, "recache" ]
+ where
+ createData f = unit $ cmd "chmod" [ "644", f ]
+ excluded = Or [ Test "//haddock-prologue.txt"
+ , Test "//package-data.mk"
+ , Test "//setup-config"
+ , Test "//inplace-pkg-config"
+ , Test "//build" ]
+
+-- ref: ghc.mk
+-- | Install settings etc. files to @prefix/lib@.
+installCommonLibs :: Action ()
+installCommonLibs = do
+ ghcLibDir <- installGhcLibDir
+ destDir <- getDestDir
+ installLibsTo inplaceLibCopyTargets (destDir ++ ghcLibDir)
+
+-- ref: ghc.mk
+-- | Install library files to some path.
+installLibsTo :: [FilePath] -> FilePath -> Action ()
+installLibsTo libs dir = do
+ installDirectory dir
+ forM_ libs $ \lib -> case takeExtension lib of
+ ".a" -> do
+ let out = dir -/- takeFileName lib
+ installData [out] dir
+ runBuilder Ranlib [out] [out] [out]
+ _ -> installData [lib] dir
+
+-- ref: includes/ghc.mk
+-- | All header files are in includes/{one of these subdirectories}.
+includeHSubdirs :: [FilePath]
+includeHSubdirs = [".", "rts", "rts/prof", "rts/storage", "stg"]
+
+-- ref: includes/ghc.mk
+-- | Install header files to @prefix/lib/ghc-<version>/include@.
+installIncludes :: Action ()
+installIncludes = do
+ ghclibDir <- installGhcLibDir
+ destDir <- getDestDir
+ let ghcheaderDir = ghclibDir -/- "include"
+ installDirectory (destDir ++ ghcheaderDir)
+ forM_ includeHSubdirs $ \dir -> do
+ installDirectory (destDir ++ ghcheaderDir -/- dir)
+ headers <- getDirectoryFiles ("includes" -/- dir) ["*.h"]
+ installHeader (map (("includes" -/- dir) -/-) headers)
+ (destDir ++ ghcheaderDir -/- dir ++ "/")
+ root <- buildRoot
+ rtsPath <- rtsBuildPath
+ installHeader (fmap (root -/-) includesDependencies ++
+ [root -/- generatedDir -/- "DerivedConstants.h"] ++
+ fmap (rtsPath -/-) libffiDependencies)
+ (destDir ++ ghcheaderDir ++ "/")
+ where
+ installHeader = installData -- they share same arguments
+
+-- ref: ghc.mk
+-- | Install documentation to @prefix/share/doc/ghc-<version>@.
+installDocs :: Action ()
+installDocs = do
+ destDir <- getDestDir
+ docDir <- installDocDir
+ root <- buildRoot
+ installDirectory (destDir ++ docDir)
+
+ let usersGuide = root -/- "docs/pdfs/users_guide.pdf"
+ whenM (doesFileExist usersGuide) $
+ installData [usersGuide] (destDir ++ docDir)
+
+ let htmlDocDir = destDir ++ docDir -/- "html"
+ installDirectory htmlDocDir
+ installData ["docs/index.html"] htmlDocDir
+
+ forM_ ["Haddock", "libraries", "users_guide"] $ \dirname -> do
+ let dir = root -/- "docs/html" -/- dirname
+ whenM (doesDirectoryExist dir) $ copyDirectory dir htmlDocDir
diff --git a/hadrian/src/Rules/Libffi.hs b/hadrian/src/Rules/Libffi.hs
new file mode 100644
index 0000000000..73f481d88a
--- /dev/null
+++ b/hadrian/src/Rules/Libffi.hs
@@ -0,0 +1,108 @@
+module Rules.Libffi (libffiRules, libffiBuildPath, libffiDependencies) where
+
+import Hadrian.Utilities
+
+import Settings.Builders.Common
+import Settings.Packages.Rts
+import Target
+import Utilities
+
+-- | Libffi is considered a Stage1 package. This determines its build directory.
+libffiContext :: Context
+libffiContext = vanillaContext Stage1 libffi
+
+-- | Build directory for in-tree Libffi library.
+libffiBuildPath :: Action FilePath
+libffiBuildPath = buildPath libffiContext
+
+libffiDependencies :: [FilePath]
+libffiDependencies = ["ffi.h", "ffitarget.h"]
+
+libffiLibrary :: FilePath
+libffiLibrary = "inst/lib/libffi.a"
+
+fixLibffiMakefile :: FilePath -> String -> String
+fixLibffiMakefile top =
+ replace "-MD" "-MMD"
+ . replace "@toolexeclibdir@" "$(libdir)"
+ . replace "@INSTALL@" ("$(subst ../install-sh," ++ top ++ "/install-sh,@INSTALL@)")
+
+-- TODO: remove code duplication (see Settings/Builders/GhcCabal.hs)
+-- TODO: check code duplication w.r.t. ConfCcArgs
+configureEnvironment :: Action [CmdOption]
+configureEnvironment = do
+ cFlags <- interpretInContext libffiContext $ mconcat
+ [ cArgs
+ , getStagedSettingList ConfCcArgs ]
+ ldFlags <- interpretInContext libffiContext ldArgs
+ sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
+ , builderEnvironment "CXX" $ Cc CompileC Stage1
+ , builderEnvironment "LD" Ld
+ , builderEnvironment "AR" (Ar Unpack Stage1)
+ , builderEnvironment "NM" Nm
+ , builderEnvironment "RANLIB" Ranlib
+ , return . AddEnv "CFLAGS" $ unwords cFlags ++ " -w"
+ , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ]
+
+libffiRules :: Rules ()
+libffiRules = do
+ fmap ("//rts" -/-) libffiDependencies &%> \_ -> do
+ libffiPath <- libffiBuildPath
+ need [libffiPath -/- libffiLibrary]
+
+ "//" ++ libffiLibrary %> \_ -> do
+ useSystemFfi <- flag UseSystemFfi
+ rtsPath <- rtsBuildPath
+ if useSystemFfi
+ then do
+ ffiIncludeDir <- setting FfiIncludeDir
+ putBuild "| System supplied FFI library will be used"
+ forM_ ["ffi.h", "ffitarget.h"] $ \file ->
+ copyFile (ffiIncludeDir -/- file) (rtsPath -/- file)
+ putSuccess "| Successfully copied system FFI library header files"
+ else do
+ libffiPath <- libffiBuildPath
+ build $ target libffiContext (Make libffiPath) [] []
+
+ hs <- getDirectoryFiles "" [libffiPath -/- "inst/include/*"]
+ forM_ hs $ \header ->
+ copyFile header (rtsPath -/- takeFileName header)
+
+ ways <- interpretInContext libffiContext (getLibraryWays <> getRtsWays)
+ forM_ (nubOrd ways) $ \way -> do
+ rtsLib <- rtsLibffiLibrary way
+ copyFileUntracked (libffiPath -/- libffiLibrary) rtsLib
+
+ putSuccess "| Successfully built custom library 'libffi'"
+
+ "//libffi/Makefile.in" %> \mkIn -> do
+ libffiPath <- libffiBuildPath
+ removeDirectory libffiPath
+ tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected"
+ <$> getDirectoryFiles "" ["libffi-tarballs/libffi*.tar.gz"]
+
+ need [tarball]
+ -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999'
+ let libname = takeWhile (/= '+') $ takeFileName tarball
+
+ root <- buildRoot
+ removeDirectory (root -/- libname)
+ -- TODO: Simplify.
+ actionFinally (do
+ build $ target libffiContext (Tar Extract) [tarball] [root]
+ moveDirectory (root -/- libname) libffiPath) $
+ removeFiles root [libname <//> "*"]
+
+ top <- topDirectory
+ fixFile mkIn (fixLibffiMakefile top)
+
+ -- TODO: Get rid of hard-coded @libffi@.
+ "//libffi/Makefile" %> \mk -> do
+ need [mk <.> "in"]
+ libffiPath <- libffiBuildPath
+ forM_ ["config.guess", "config.sub"] $ \file ->
+ copyFile file (libffiPath -/- file)
+
+ env <- configureEnvironment
+ buildWithCmdOptions env $
+ target libffiContext (Configure libffiPath) [mk <.> "in"] [mk]
diff --git a/hadrian/src/Rules/Library.hs b/hadrian/src/Rules/Library.hs
new file mode 100644
index 0000000000..e6e5b167ff
--- /dev/null
+++ b/hadrian/src/Rules/Library.hs
@@ -0,0 +1,103 @@
+module Rules.Library (
+ buildPackageLibrary, buildPackageGhciLibrary, buildDynamicLib
+ ) where
+
+import Hadrian.Haskell.Cabal
+import qualified System.Directory as IO
+
+import Base
+import Context
+import Expression hiding (way, package)
+import Flavour
+import Oracles.ModuleFiles
+import Oracles.PackageData
+import Oracles.Setting
+import Rules.Gmp
+import Settings
+import Target
+import Utilities
+
+libraryObjects :: Context -> Action [FilePath]
+libraryObjects context@Context{..} = do
+ hsObjs <- hsObjects context
+ noHsObjs <- nonHsObjects context
+
+ -- This will create split objects if required (we don't track them
+ -- explicitly as this would needlessly bloat the Shake database).
+ need $ noHsObjs ++ hsObjs
+
+ split <- interpretInContext context =<< splitObjects <$> flavour
+ let getSplitObjs = concatForM hsObjs $ \obj -> do
+ let dir = dropExtension obj ++ "_" ++ osuf way ++ "_split"
+ contents <- liftIO $ IO.getDirectoryContents dir
+ return . map (dir -/-) $ filter (not . all (== '.')) contents
+
+ (noHsObjs ++) <$> if split then getSplitObjs else return hsObjs
+
+buildDynamicLib :: Context -> Rules ()
+buildDynamicLib context@Context{..} = do
+ let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgName package
+ -- OS X
+ libPrefix ++ "*.dylib" %> buildDynamicLibUnix
+ -- Linux
+ libPrefix ++ "*.so" %> buildDynamicLibUnix
+ -- TODO: Windows
+ where
+ buildDynamicLibUnix lib = do
+ deps <- contextDependencies context
+ need =<< mapM pkgLibraryFile deps
+ objs <- libraryObjects context
+ build $ target context (Ghc LinkHs stage) objs [lib]
+
+buildPackageLibrary :: Context -> Rules ()
+buildPackageLibrary context@Context {..} = do
+ let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgName package
+ libPrefix ++ "*" ++ (waySuffix way <.> "a") %%> \a -> do
+ objs <- libraryObjects context
+ asuf <- libsuf way
+ let isLib0 = ("//*-0" ++ asuf) ?== a
+ removeFile a
+ if isLib0 then build $ target context (Ar Pack stage) [] [a] -- TODO: Scan for dlls
+ else build $ target context (Ar Pack stage) objs [a]
+
+ synopsis <- traverse pkgSynopsis (pkgCabalFile package)
+ unless isLib0 . putSuccess $ renderLibrary
+ (quote (pkgName package) ++ " (" ++ show stage ++ ", way "
+ ++ show way ++ ").") a synopsis
+
+buildPackageGhciLibrary :: Context -> Rules ()
+buildPackageGhciLibrary context@Context {..} = priority 2 $ do
+ let libPrefix = "//" ++ contextDir context -/- "HS" ++ pkgName package
+ libPrefix ++ "*" ++ (waySuffix way <.> "o") %> \obj -> do
+ objs <- allObjects context
+ need objs
+ build $ target context Ld objs [obj]
+
+allObjects :: Context -> Action [FilePath]
+allObjects context = (++) <$> nonHsObjects context <*> hsObjects context
+
+nonHsObjects :: Context -> Action [FilePath]
+nonHsObjects context = do
+ path <- buildPath context
+ cObjs <- cObjects context
+ cmmSrcs <- pkgDataList (CmmSrcs path)
+ cmmObjs <- mapM (objectPath context) cmmSrcs
+ eObjs <- extraObjects context
+ return $ cObjs ++ cmmObjs ++ eObjs
+
+cObjects :: Context -> Action [FilePath]
+cObjects context = do
+ path <- buildPath context
+ srcs <- pkgDataList (CSrcs path)
+ objs <- mapM (objectPath context) srcs
+ return $ if way context == threaded
+ then objs
+ else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs
+
+extraObjects :: Context -> Action [FilePath]
+extraObjects context
+ | package context == integerGmp = do
+ gmpPath <- gmpBuildPath
+ need [gmpPath -/- gmpLibraryH]
+ map unifyPath <$> getDirectoryFiles "" [gmpPath -/- gmpObjectsDir -/- "*.o"]
+ | otherwise = return []
diff --git a/hadrian/src/Rules/PackageData.hs b/hadrian/src/Rules/PackageData.hs
new file mode 100644
index 0000000000..2442b03de3
--- /dev/null
+++ b/hadrian/src/Rules/PackageData.hs
@@ -0,0 +1,119 @@
+module Rules.PackageData (buildPackageData) where
+
+import Base
+import Context
+import Expression
+import Oracles.Setting
+import Rules.Generate
+import Settings.Packages.Rts
+import Target
+import Utilities
+
+-- | Build @package-data.mk@ by using ghc-cabal utility to process .cabal files.
+buildPackageData :: Context -> Rules ()
+buildPackageData context@Context {..} = do
+ let dir = "//" ++ contextDir context
+ cabalFile = unsafePkgCabalFile package -- TODO: improve
+ configure = pkgPath package -/- "configure"
+ -- TODO: Get rid of hardcoded file paths.
+ [dir -/- "package-data.mk", dir -/- "setup-config"] &%> \[mk, setupConfig] -> do
+ -- Make sure all generated dependencies are in place before proceeding.
+ orderOnly =<< interpretInContext context generatedDependencies
+
+ -- GhcCabal may run the configure script, so we depend on it.
+ whenM (doesFileExist $ configure <.> "ac") $ need [configure]
+
+ -- Before we configure a package its dependencies need to be registered.
+ need =<< mapM pkgConfFile =<< contextDependencies context
+
+ need [cabalFile]
+ build $ target context GhcCabal [cabalFile] [mk, setupConfig]
+ postProcessPackageData context mk
+
+ -- TODO: Get rid of hardcoded file paths.
+ dir -/- "inplace-pkg-config" %> \conf -> do
+ path <- buildPath context
+ dataFile <- pkgDataFile context
+ need [dataFile] -- ghc-cabal builds inplace package configuration file
+ if package == rts
+ then do
+ genPath <- buildRoot <&> (-/- generatedDir)
+ rtsPath <- rtsBuildPath
+ need [rtsConfIn]
+ build $ target context HsCpp [rtsConfIn] [conf]
+ fixFile conf $ unlines
+ . map
+ ( replace "\"\"" ""
+ . replace "rts/dist/build" rtsPath
+ . replace "includes/dist-derivedconstants/header" genPath )
+ . lines
+ else
+ fixFile conf $ unlines . map (replace (path </> "build") path) . lines
+
+ priority 2.0 $ when (nonCabalContext context) $ dir -/- "package-data.mk" %>
+ generatePackageData context
+
+generatePackageData :: Context -> FilePath -> Action ()
+generatePackageData context@Context {..} file = do
+ orderOnly =<< interpretInContext context generatedDependencies
+ asmSrcs <- packageAsmSources package
+ cSrcs <- packageCSources package
+ cmmSrcs <- packageCmmSources package
+ genPath <- buildRoot <&> (-/- generatedDir)
+ writeFileChanged file . unlines $
+ [ "S_SRCS = " ++ unwords asmSrcs ] ++
+ [ "C_SRCS = " ++ unwords cSrcs ] ++
+ [ "CMM_SRCS = " ++ unwords cmmSrcs ] ++
+ [ "DEP_EXTRA_LIBS = m" | package == hp2ps ] ++
+ [ "CC_OPTS = -I" ++ genPath | package `elem` [hp2ps, rts]] ++
+ [ "MODULES = Main" | package == ghcCabal ] ++
+ [ "HS_SRC_DIRS = ." | package == ghcCabal ]
+ putSuccess $ "| Successfully generated " ++ file
+
+packageCSources :: Package -> Action [FilePath]
+packageCSources pkg
+ | pkg /= rts = getDirectoryFiles (pkgPath pkg) ["*.c"]
+ | otherwise = do
+ windows <- windowsHost
+ rtsPath <- rtsBuildPath
+ sources <- fmap (map unifyPath) . getDirectoryFiles (pkgPath pkg) .
+ map (-/- "*.c") $ [ ".", "hooks", "sm", "eventlog", "linker" ] ++
+ [ if windows then "win32" else "posix" ]
+ return $ sources ++ [ rtsPath -/- "c/sm/Evac_thr.c" ]
+ ++ [ rtsPath -/- "c/sm/Scav_thr.c" ]
+
+packageAsmSources :: Package -> Action [FilePath]
+packageAsmSources pkg
+ | pkg /= rts = return []
+ | otherwise = do
+ buildAdjustor <- anyTargetArch ["i386", "powerpc", "powerpc64"]
+ buildStgCRunAsm <- anyTargetArch ["powerpc64le"]
+ return $ [ "AdjustorAsm.S" | buildAdjustor ]
+ ++ [ "StgCRunAsm.S" | buildStgCRunAsm ]
+
+packageCmmSources :: Package -> Action [FilePath]
+packageCmmSources pkg
+ | pkg /= rts = return []
+ | otherwise = do
+ rtsPath <- rtsBuildPath
+ sources <- getDirectoryFiles (pkgPath pkg) ["*.cmm"]
+ return $ sources ++ [ rtsPath -/- "cmm/AutoApply.cmm" ]
+
+-- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile:
+-- 1) Drop lines containing '$'. For example, get rid of
+-- @libraries/Win32_dist-install_CMM_SRCS := $(addprefix cbits/,$(notdir ...@
+-- and replace it with a tracked call to getDirectoryFiles.
+-- 2) Drop path prefixes to individual settings.
+-- For example, @libraries/deepseq/dist-install_VERSION = 1.4.0.0@
+-- is replaced by @VERSION = 1.4.0.0@.
+-- Reason: Shake's built-in makefile parser doesn't recognise slashes
+-- TODO (izgzhen): should fix DEP_LIB_REL_DIRS_SEARCHPATH
+postProcessPackageData :: Context -> FilePath -> Action ()
+postProcessPackageData context@Context {..} file = do
+ top <- topDirectory
+ cmmSrcs <- getDirectoryFiles (pkgPath package) ["cbits/*.cmm"]
+ path <- buildPath context
+ let len = length (pkgPath package) + length (top -/- path) + 2
+ fixFile file $ unlines
+ . (++ ["CMM_SRCS = " ++ unwords (map unifyPath cmmSrcs) ])
+ . map (drop len) . filter ('$' `notElem`) . lines
diff --git a/hadrian/src/Rules/Program.hs b/hadrian/src/Rules/Program.hs
new file mode 100644
index 0000000000..ba4dab0442
--- /dev/null
+++ b/hadrian/src/Rules/Program.hs
@@ -0,0 +1,116 @@
+module Rules.Program (buildProgram) where
+
+import Hadrian.Haskell.Cabal
+
+import Base
+import Context
+import Expression hiding (stage, way)
+import Oracles.ModuleFiles
+import Oracles.PackageData
+import Oracles.Setting
+import Rules.Wrappers
+import Settings
+import Settings.Packages.Rts
+import Target
+import Utilities
+
+-- | TODO: Drop code duplication
+buildProgram :: [(Resource, Int)] -> Package -> Rules ()
+buildProgram rs package = do
+ forM_ [Stage0 ..] $ \stage -> do
+ let context = vanillaContext stage package
+
+ -- Rules for programs built in 'buildRoot'
+ "//" ++ contextDir context -/- programName context <.> exe %> \bin ->
+ buildBinaryAndWrapper rs bin =<< programContext stage package
+
+ -- Rules for the GHC package, which is built 'inplace'
+ when (package == ghc) $ do
+ inplaceBinPath -/- programName context <.> exe %> \bin ->
+ buildBinaryAndWrapper rs bin =<< programContext stage package
+
+ inplaceLibBinPath -/- programName context <.> exe %> \bin ->
+ buildBinary rs bin =<< programContext stage package
+
+ inplaceLibBinPath -/- programName context <.> "bin" %> \bin ->
+ buildBinary rs bin =<< programContext stage package
+
+ -- Rules for other programs built in inplace directories
+ when (package /= ghc) $ do
+ let context0 = vanillaContext Stage0 package -- TODO: get rid of context0
+ inplaceBinPath -/- programName context0 <.> exe %> \bin -> do
+ stage <- installStage package -- TODO: get rid of fromJust
+ buildBinaryAndWrapper rs bin =<< programContext (fromJust stage) package
+
+ inplaceLibBinPath -/- programName context0 <.> exe %> \bin -> do
+ stage <- installStage package -- TODO: get rid of fromJust
+ context <- programContext (fromJust stage) package
+ if package /= iservBin then
+ -- We *normally* build only unwrapped binaries in inplace/lib/bin
+ buildBinary rs bin context
+ else
+ -- Build both binary and wrapper in inplace/lib/bin for iservBin
+ buildBinaryAndWrapperLib rs bin context
+
+ inplaceLibBinPath -/- programName context0 <.> "bin" %> \bin -> do
+ stage <- installStage package -- TODO: get rid of fromJust
+ buildBinary rs bin =<< programContext (fromJust stage) package
+
+buildBinaryAndWrapperLib :: [(Resource, Int)] -> FilePath -> Context -> Action ()
+buildBinaryAndWrapperLib rs bin context = do
+ windows <- windowsHost
+ if windows
+ then buildBinary rs bin context -- We don't build wrappers on Windows
+ else case lookup context inplaceWrappers of
+ Nothing -> buildBinary rs bin context -- No wrapper found
+ Just wrapper -> do
+ top <- topDirectory
+ let libdir = top -/- inplaceLibPath
+ let wrappedBin = inplaceLibBinPath -/- programName context <.> "bin"
+ need [wrappedBin]
+ buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName wrappedBin))
+
+buildBinaryAndWrapper :: [(Resource, Int)] -> FilePath -> Context -> Action ()
+buildBinaryAndWrapper rs bin context = do
+ windows <- windowsHost
+ if windows
+ then buildBinary rs bin context -- We don't build wrappers on Windows
+ else case lookup context inplaceWrappers of
+ Nothing -> buildBinary rs bin context -- No wrapper found
+ Just wrapper -> do
+ top <- topDirectory
+ let libPath = top -/- inplaceLibPath
+ wrappedBin = inplaceLibBinPath -/- takeFileName bin
+ need [wrappedBin]
+ buildWrapper context wrapper bin (WrappedBinary libPath (takeFileName bin))
+
+buildWrapper :: Context -> Wrapper -> FilePath -> WrappedBinary -> Action ()
+buildWrapper context@Context {..} wrapper wrapperPath wrapped = do
+ contents <- interpretInContext context $ wrapper wrapped
+ writeFileChanged wrapperPath contents
+ makeExecutable wrapperPath
+ putSuccess $ "| Successfully created wrapper for " ++
+ quote (pkgName package) ++ " (" ++ show stage ++ ")."
+
+-- TODO: Get rid of the Paths_hsc2hs.o hack.
+buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action ()
+buildBinary rs bin context@Context {..} = do
+ binDeps <- if stage == Stage0 && package == ghcCabal
+ then hsSources context
+ else do
+ needLibrary =<< contextDependencies context
+ when (stage > Stage0) $ do
+ ways <- interpretInContext context (getLibraryWays <> getRtsWays)
+ needLibrary [ rtsContext { way = w } | w <- ways ]
+ path <- buildPath context
+ cSrcs <- pkgDataList (CSrcs path)
+ cObjs <- mapM (objectPath context) cSrcs
+ hsObjs <- hsObjects context
+ return $ cObjs ++ hsObjs
+ ++ [ path -/- "Paths_hsc2hs.o" | package == hsc2hs ]
+ ++ [ path -/- "Paths_haddock.o" | package == haddock ]
+ need binDeps
+ buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
+ synopsis <- traverse pkgSynopsis (pkgCabalFile package)
+ putSuccess $ renderProgram
+ (quote (pkgName package) ++ " (" ++ show stage ++ ").") bin synopsis
diff --git a/hadrian/src/Rules/Register.hs b/hadrian/src/Rules/Register.hs
new file mode 100644
index 0000000000..7c0a3e00e8
--- /dev/null
+++ b/hadrian/src/Rules/Register.hs
@@ -0,0 +1,44 @@
+module Rules.Register (registerPackage) where
+
+import Base
+import Context
+import GHC
+import Target
+import Utilities
+
+-- TODO: Simplify.
+-- | Build rules for registering packages and initialising package databases
+-- by running the @ghc-pkg@ utility.
+registerPackage :: [(Resource, Int)] -> Context -> Rules ()
+registerPackage rs context@Context {..} = do
+ when (stage == Stage0) $ do
+ -- Packages @ghc-boot@ and @ghc-boot-th@ both match the @ghc-boot*@
+ -- pattern, therefore we need to use priorities to match the right rule.
+ -- TODO: Get rid of this hack.
+ "//" ++ stage0PackageDbDir -/- pkgName package ++ "*.conf" %%>
+ buildConf rs context
+
+ when (package == ghc) $ "//" ++ stage0PackageDbDir -/- packageDbStamp %>
+ buildStamp rs context
+
+ when (stage == Stage1) $ do
+ inplacePackageDbPath -/- pkgName package ++ "*.conf" %%>
+ buildConf rs context
+
+ when (package == ghc) $ inplacePackageDbPath -/- packageDbStamp %>
+ buildStamp rs context
+
+buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
+buildConf rs context@Context {..} conf = do
+ confIn <- pkgInplaceConfig context
+ need [confIn]
+ buildWithResources rs $ target context (GhcPkg Update stage) [confIn] [conf]
+
+buildStamp :: [(Resource, Int)] -> Context -> FilePath -> Action ()
+buildStamp rs Context {..} stamp = do
+ let path = takeDirectory stamp
+ removeDirectory path
+ buildWithResources rs $
+ target (vanillaContext stage ghc) (GhcPkg Init stage) [] [path]
+ writeFileLines stamp []
+ putSuccess $ "| Successfully initialised " ++ path
diff --git a/hadrian/src/Rules/Selftest.hs b/hadrian/src/Rules/Selftest.hs
new file mode 100644
index 0000000000..d1ffaac1c3
--- /dev/null
+++ b/hadrian/src/Rules/Selftest.hs
@@ -0,0 +1,92 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Rules.Selftest (selftestRules) where
+
+import Test.QuickCheck
+
+import Base
+import GHC
+import Oracles.ModuleFiles
+import Oracles.Setting
+import Settings
+import Target
+
+instance Arbitrary Way where
+ arbitrary = wayFromUnits <$> arbitrary
+
+instance Arbitrary WayUnit where
+ arbitrary = arbitraryBoundedEnum
+
+test :: Testable a => a -> Action ()
+test = liftIO . quickCheck
+
+selftestRules :: Rules ()
+selftestRules =
+ "selftest" ~> do
+ testBuilder
+ testChunksOfSize
+ testLookupAll
+ testModuleName
+ testPackages
+ testWay
+
+testBuilder :: Action ()
+testBuilder = do
+ putBuild "==== trackArgument"
+ let make = target undefined (Make undefined) undefined undefined
+ test $ forAll (elements ["-j", "MAKEFLAGS=-j", "THREADS="])
+ $ \prefix (NonNegative n) ->
+ not (trackArgument make prefix) &&
+ not (trackArgument make ("-j" ++ show (n :: Int)))
+
+testChunksOfSize :: Action ()
+testChunksOfSize = do
+ putBuild "==== chunksOfSize"
+ test $ chunksOfSize 3 [ "a", "b", "c" , "defg" , "hi" , "jk" ]
+ == [ ["a", "b", "c"], ["defg"], ["hi"], ["jk"] ]
+ test $ \n xs ->
+ let res = chunksOfSize n xs
+ in concat res == xs && all (\r -> length r == 1 || length (concat r) <= n) res
+
+testLookupAll :: Action ()
+testLookupAll = do
+ putBuild "==== lookupAll"
+ test $ lookupAll ["b" , "c" ] [("a", 1), ("c", 3), ("d", 4)]
+ == [Nothing, Just (3 :: Int)]
+ test $ forAll dicts $ \dict -> forAll extras $ \extra ->
+ let items = sort $ map fst dict ++ extra
+ in lookupAll items (sort dict) == map (`lookup` dict) items
+ where
+ dicts :: Gen [(Int, Int)]
+ dicts = nubBy (\x y -> fst x == fst y) <$> vector 20
+ extras :: Gen [Int]
+ extras = vector 20
+
+testModuleName :: Action ()
+testModuleName = do
+ putBuild "==== Encode/decode module name"
+ test $ encodeModule "Data/Functor" "Identity.hs" == "Data.Functor.Identity"
+ test $ encodeModule "" "Prelude" == "Prelude"
+
+ test $ decodeModule "Data.Functor.Identity" == ("Data/Functor", "Identity")
+ test $ decodeModule "Prelude" == ("", "Prelude")
+
+ test $ forAll names $ \n -> uncurry encodeModule (decodeModule n) == n
+ where
+ names = intercalate "." <$> listOf1 (listOf1 $ elements "abcABC123_'")
+
+testPackages :: Action ()
+testPackages = do
+ putBuild "==== Check system configuration"
+ win <- windowsHost -- This depends on the @boot@ and @configure@ scripts.
+ putBuild "==== Packages, interpretInContext, configuration flags"
+ forM_ [Stage0 ..] $ \stage -> do
+ pkgs <- stagePackages stage
+ when (win32 `elem` pkgs) . test $ win
+ when (unix `elem` pkgs) . test $ not win
+ test $ pkgs == nubOrd pkgs
+
+testWay :: Action ()
+testWay = do
+ putBuild "==== Read Way, Show Way"
+ test $ \(x :: Way) -> read (show x) == x
+
diff --git a/hadrian/src/Rules/SourceDist.hs b/hadrian/src/Rules/SourceDist.hs
new file mode 100644
index 0000000000..3143c4b153
--- /dev/null
+++ b/hadrian/src/Rules/SourceDist.hs
@@ -0,0 +1,113 @@
+module Rules.SourceDist (sourceDistRules) where
+
+import Hadrian.Oracles.DirectoryContents
+
+import Base
+import Builder
+import Oracles.Setting
+import Rules.Clean
+
+sourceDistRules :: Rules ()
+sourceDistRules = do
+ "sdist-ghc" ~> do
+ -- We clean the source tree first.
+ -- See https://github.com/snowleopard/hadrian/issues/384.
+ cleanSourceTree
+ version <- setting ProjectVersion
+ need ["sdistprep/ghc-" ++ version ++ "-src.tar.xz"]
+ putSuccess "| Done"
+ "sdistprep/ghc-*-src.tar.xz" %> \fname -> do
+ let tarName = takeFileName fname
+ dropTarXz = dropExtension . dropExtension
+ treePath = "sdistprep/ghc" -/- dropTarXz tarName
+ prepareTree treePath
+ runBuilderWithCmdOptions [Cwd "sdistprep/ghc"] (Tar Create)
+ ["cJf", ".." -/- tarName, dropTarXz tarName]
+ ["cJf", ".." -/- tarName] [dropTarXz tarName]
+ "GIT_COMMIT_ID" %> \fname ->
+ writeFileChanged fname =<< setting ProjectGitCommitId
+ "VERSION" %> \fname ->
+ writeFileChanged fname =<< setting ProjectVersion
+
+prepareTree :: FilePath -> Action ()
+prepareTree dest = do
+ mapM_ cpDir srcDirs
+ mapM_ cpFile srcFiles
+ where
+ cpFile a = copyFile a (dest -/- a)
+ cpDir a = copyDirectoryContents (Not excluded) a (dest -/- a)
+ excluded = Or
+ [ Test "//.*"
+ , Test "//#*"
+ , Test "//*-SAVE"
+ , Test "//*.orig"
+ , Test "//*.rej"
+ , Test "//*~"
+ , Test "//autom4te*"
+ , Test "//dist"
+ , Test "//dist-install"
+ , Test "//log"
+ , Test "//stage0"
+ , Test "//stage1"
+ , Test "//stage2"
+ , Test "//stage3"
+ , Test "hadrian/.cabal-sandbox"
+ , Test "hadrian/.stack-work"
+ , Test "hadrian/UserSettings.hs"
+ , Test "hadrian/cabal.sandbox.config"
+ , Test "hadrian/cfg/system.config"
+ , Test "hadrian/bin"
+ , Test "hadrian/dist"
+ , Test "hadrian/dist-newstyle"
+ , Test "libraries//*.buildinfo"
+ , Test "libraries//GNUmakefile"
+ , Test "libraries//config.log"
+ , Test "libraries//config.status"
+ , Test "libraries//configure"
+ , Test "libraries//ghc.mk"
+ , Test "libraries//include/Hs*Config.h"
+ , Test "libraries/dph"
+ , Test "libraries/parallel"
+ , Test "libraries/primitive"
+ , Test "libraries/random"
+ , Test "libraries/stm"
+ , Test "libraries/vector"
+ , Test "mk/build.mk" ]
+ srcDirs =
+ [ "bindisttest"
+ , "compiler"
+ , "distrib"
+ , "docs"
+ , "docs"
+ , "driver"
+ , "ghc"
+ , "hadrian"
+ , "includes"
+ , "iserv"
+ , "libffi"
+ , "libffi-tarballs"
+ , "libraries"
+ , "mk"
+ , "rts"
+ , "rules"
+ , "utils" ]
+ srcFiles =
+ [ "ANNOUNCE"
+ , "GIT_COMMIT_ID"
+ , "HACKING.md"
+ , "INSTALL.md"
+ , "LICENSE"
+ , "MAKEHELP.md"
+ , "Makefile"
+ , "README.md"
+ , "VERSION"
+ , "aclocal.m4"
+ , "boot"
+ , "config.guess"
+ , "config.sub"
+ , "configure"
+ , "configure.ac"
+ , "ghc.mk"
+ , "install-sh"
+ , "packages"
+ , "settings.in" ]
diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs
new file mode 100644
index 0000000000..ae37343432
--- /dev/null
+++ b/hadrian/src/Rules/Test.hs
@@ -0,0 +1,72 @@
+module Rules.Test (testRules) where
+
+import Base
+import Expression
+import Flavour
+import Oracles.Flag
+import Oracles.Setting
+import Settings
+import Target
+import Utilities
+
+-- TODO: clean up after testing
+testRules :: Rules ()
+testRules = do
+ "validate" ~> do
+ need inplaceLibCopyTargets
+ needBuilder $ Ghc CompileHs Stage2
+ needBuilder $ GhcPkg Update Stage1
+ needBuilder Hpc
+ -- TODO: Figure out why @needBuilder Hsc2Hs@ doesn't work.
+ -- TODO: Eliminate explicit filepaths.
+ -- See https://github.com/snowleopard/hadrian/issues/376.
+ need ["inplace/bin/hp2ps", "inplace/bin/hsc2hs"]
+ build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
+
+ "test" ~> do
+ pkgs <- stagePackages Stage1
+ tests <- filterM doesDirectoryExist $ concat
+ [ [ pkgPath pkg -/- "tests", pkgPath pkg -/- "tests-ghc" ]
+ | pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ]
+ windows <- windowsHost
+ top <- topDirectory
+ compiler <- builderPath $ Ghc CompileHs Stage2
+ ghcPkg <- builderPath $ GhcPkg Update Stage1
+ haddock <- builderPath (Haddock BuildPackage)
+ threads <- shakeThreads <$> getShakeOptions
+ debugged <- ghcDebugged <$> flavour
+ ghcWithNativeCodeGenInt <- fromEnum <$> ghcWithNativeCodeGen
+ ghcWithInterpreterInt <- fromEnum <$> ghcWithInterpreter
+ ghcUnregisterisedInt <- fromEnum <$> flag GhcUnregisterised
+ quietly . cmd "python2" $
+ [ "testsuite/driver/runtests.py" ]
+ ++ map ("--rootdir="++) tests ++
+ [ "-e", "windows=" ++ show windows
+ , "-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=" ++ show (yesNo debugged)
+ , "-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
+ , "-e", "ghc_with_interpreter=" ++ show ghcWithInterpreterInt
+ , "-e", "ghc_unregisterised=" ++ show ghcUnregisterisedInt
+ , "-e", "ghc_with_threaded_rts=0" -- TODO: support threaded
+ , "-e", "ghc_with_dynamic_rts=0" -- TODO: support dynamic
+ , "-e", "ghc_dynamic_by_default=False" -- TODO: support dynamic
+ , "-e", "ghc_dynamic=0" -- TODO: support dynamic
+ , "-e", "ghc_with_llvm=0" -- TODO: support LLVM
+ , "-e", "in_tree_compiler=True" -- TODO: when is it equal to False?
+ , "-e", "clean_only=False" -- TODO: do we need to support True?
+ , "--configfile=testsuite/config/ghc"
+ , "--config", "compiler=" ++ show (top -/- compiler)
+ , "--config", "ghc_pkg=" ++ show (top -/- ghcPkg)
+ , "--config", "haddock=" ++ show (top -/- haddock)
+ , "--summary-file", "testsuite_summary.txt"
+ , "--threads=" ++ show threads
+ ]
+
+ -- , "--config", "hp2ps=" ++ quote ("hp2ps")
+ -- , "--config", "hpc=" ++ quote ("hpc")
+ -- , "--config", "gs=$(call quote_path,$(GS))"
+ -- , "--config", "timeout_prog=$(call quote_path,$(TIMEOUT_PROGRAM))"
diff --git a/hadrian/src/Rules/Wrappers.hs b/hadrian/src/Rules/Wrappers.hs
new file mode 100644
index 0000000000..20763a778e
--- /dev/null
+++ b/hadrian/src/Rules/Wrappers.hs
@@ -0,0 +1,162 @@
+module Rules.Wrappers (
+ WrappedBinary(..), Wrapper, inplaceWrappers, installWrappers
+ ) where
+
+import Hadrian.Oracles.Path
+
+import Base
+import Expression
+import Oracles.Setting
+import Settings
+
+-- | Wrapper is an expression depending on (i) the 'FilePath' to the library and
+-- (ii) the name of the wrapped binary.
+data WrappedBinary = WrappedBinary
+ { binaryLibPath :: FilePath
+ , binaryName :: String }
+
+type Wrapper = WrappedBinary -> Expr String
+
+ghcWrapper :: WrappedBinary -> Expr String
+ghcWrapper WrappedBinary{..} = do
+ expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+ bash <- expr bashPath
+ return $ unlines
+ [ "#!"++bash
+ , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
+ ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
+
+inplaceRunGhcWrapper :: WrappedBinary -> Expr String
+inplaceRunGhcWrapper WrappedBinary{..} = do
+ expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+ bash <- expr bashPath
+ return $ unlines
+ [ "#!"++bash
+ , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
+ ++ " -f" ++ (binaryLibPath -/- "bin/ghc-stage2") -- TODO: use ProgramName
+ ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
+
+installRunGhcWrapper :: WrappedBinary -> Expr String
+installRunGhcWrapper WrappedBinary{..} = do
+ expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+ bash <- expr bashPath
+ return $ unlines
+ [ "#!"++bash
+ , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
+ ++ " -f" ++ (binaryLibPath -/- "bin/ghc") -- TODO: use ProgramName
+ ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
+
+inplaceGhcPkgWrapper :: WrappedBinary -> Expr String
+inplaceGhcPkgWrapper WrappedBinary{..} = do
+ expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+ top <- expr topDirectory
+ -- The wrapper is generated in StageN, but used in StageN+1. Therefore, we
+ -- always use the inplace package database, located at 'inplacePackageDbPath',
+ -- which is used in Stage1 and later.
+ bash <- expr bashPath
+ return $ unlines
+ [ "#!" ++ bash
+ , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++
+ " --global-package-db " ++ top -/- inplacePackageDbPath ++ " ${1+\"$@\"}" ]
+
+installGhcPkgWrapper :: WrappedBinary -> Expr String
+installGhcPkgWrapper WrappedBinary{..} = do
+ expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+ stage <- getStage
+ top <- expr topDirectory
+ -- Use the package configuration for the next stage in the wrapper.
+ -- The wrapper is generated in StageN, but used in StageN+1.
+ packageDb <- expr $ installPackageDbPath binaryLibPath top (succ stage)
+ bash <- expr bashPath
+ return $ unlines
+ [ "#!"++bash
+ , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
+ ++ " --global-package-db " ++ packageDb ++ " ${1+\"$@\"}" ]
+
+hp2psWrapper :: WrappedBinary -> Expr String
+hp2psWrapper WrappedBinary{..} = do
+ expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+ bash <- expr bashPath
+ return $ unlines
+ [ "#!"++bash
+ , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
+
+hpcWrapper :: WrappedBinary -> Expr String
+hpcWrapper WrappedBinary{..} = do
+ expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+ bash <- expr bashPath
+ return $ unlines
+ [ "#!"++bash
+ , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
+
+hsc2hsWrapper :: WrappedBinary -> Expr String
+hsc2hsWrapper WrappedBinary{..} = do
+ top <- expr topDirectory
+ expr $ need [ sourcePath -/- "Rules/Wrappers.hs" ]
+ contents <- expr $ readFile' $ top -/- "utils/hsc2hs/hsc2hs.wrapper"
+ let executableName = binaryLibPath -/- "bin" -/- binaryName
+ confCcArgs <- expr $ settingList (ConfCcArgs Stage1)
+ confGccLinkerArgs <- expr $ settingList (ConfGccLinkerArgs Stage1)
+ let hsc2hsExtra = unwords (map ("-cflags=" ++) confCcArgs) ++ " " ++
+ unwords (map ("-lflags=" ++) confGccLinkerArgs)
+ bash <- expr bashPath
+ return $ unlines
+ [ "#!"++bash
+ , "executablename=\"" ++ executableName ++ "\""
+ , "HSC2HS_EXTRA=\"" ++ hsc2hsExtra ++ "\""
+ , contents ]
+
+haddockWrapper :: WrappedBinary -> Expr String
+haddockWrapper WrappedBinary{..} = do
+ expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+ return $ unlines
+ [ "#!/bin/bash"
+ , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
+ ++ " -B" ++ binaryLibPath ++ " -l" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
+
+iservBinWrapper :: WrappedBinary -> Expr String
+iservBinWrapper WrappedBinary{..} = do
+ expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
+ stage <- getStage
+ stageLibraries <- expr $ filter isLibrary <$> stagePackages stage
+ -- TODO: Figure our the reason of this hardcoded exclusion
+ let pkgs = stageLibraries \\ [ cabal, process, haskeline
+ , terminfo, ghcCompact, hpc, compiler ]
+ contexts <- expr $ concatForM pkgs $ \p -> do
+ maybeStage <- installStage p
+ return [ vanillaContext s p | s <- maybeToList maybeStage ]
+ buildPaths <- expr $ mapM buildPath contexts
+ return $ unlines
+ [ "#!/bin/bash"
+ , "export DYLD_LIBRARY_PATH=\"" ++ intercalate ":" buildPaths ++
+ "${DYLD_LIBRARY_PATH:+:$DYLD_LIBRARY_PATH}\""
+ , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
+
+wrappersCommon :: [(Context, Wrapper)]
+wrappersCommon = [ (vanillaContext Stage0 ghc , ghcWrapper)
+ , (vanillaContext Stage1 ghc , ghcWrapper)
+ , (vanillaContext Stage1 hp2ps , hp2psWrapper)
+ , (vanillaContext Stage1 hpc , hpcWrapper)
+ , (vanillaContext Stage1 hsc2hs, hsc2hsWrapper)
+ , (vanillaContext Stage2 haddock, haddockWrapper)
+ , (vanillaContext Stage1 iservBin, iservBinWrapper) ]
+
+-- | List of wrappers for inplace artefacts
+inplaceWrappers :: [(Context, Wrapper)]
+inplaceWrappers = wrappersCommon ++
+ [ (vanillaContext Stage0 ghcPkg, inplaceGhcPkgWrapper)
+ , (vanillaContext Stage1 runGhc, inplaceRunGhcWrapper) ]
+
+-- | List of wrappers for installation
+installWrappers :: [(Context, Wrapper)]
+installWrappers = wrappersCommon ++
+ [ (vanillaContext Stage0 ghcPkg, installGhcPkgWrapper)
+ , (vanillaContext Stage1 runGhc, installRunGhcWrapper) ]
+
+-- | In the final installation path specified by @DEST@, there is another
+-- @package.conf.d@ different from 'inplacePackageDbPath' defined in "Base".
+installPackageDbPath :: FilePath -> FilePath -> Stage -> Action FilePath
+installPackageDbPath _ top Stage0 = do
+ path <- buildRoot
+ return $ top -/- path -/- "stage0/bootstrapping.conf"
+installPackageDbPath libdir _ _ = return $ libdir -/- "package.conf.d"
View Lorry Controller Status