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.hs81
-rw-r--r--hadrian/src/Rules/Configure.hs43
-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.hs113
-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, 0 insertions, 2240 deletions
diff --git a/hadrian/src/Rules/Clean.hs b/hadrian/src/Rules/Clean.hs
deleted file mode 100644
index d11cbf5e53..0000000000
--- a/hadrian/src/Rules/Clean.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-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
deleted file mode 100644
index b7f3bc8447..0000000000
--- a/hadrian/src/Rules/Compile.hs
+++ /dev/null
@@ -1,81 +0,0 @@
-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
- 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
deleted file mode 100644
index 9de31e2bbc..0000000000
--- a/hadrian/src/Rules/Configure.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-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 <- not <$> cmdConfigure
- if skip
- then unlessM (doesFileExist configFile) $
- error $ "Configuration file " ++ configFile ++ " is missing.\n"
- ++ "Run the configure script manually or let Hadrian run it "
- ++ "automatically by passing the flag --configure."
- 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 <- not <$> cmdConfigure
- if skip
- then unlessM (doesFileExist "configure") $
- error $ "The configure script is missing.\nRun the boot script "
- ++ "manually let Hadrian run it automatically by passing the "
- ++ "flag --configure."
- 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
deleted file mode 100644
index f9d17e93d8..0000000000
--- a/hadrian/src/Rules/Dependencies.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-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 writeFile' mk ""
- else buildWithResources rs $
- target context (Ghc FindHsDependencies stage) srcs [mk]
- removeFile $ mk <.> "bak"
- mkDeps <- liftIO $ 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
deleted file mode 100644
index 5a5698c995..0000000000
--- a/hadrian/src/Rules/Documentation.hs
+++ /dev/null
@@ -1,197 +0,0 @@
-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
deleted file mode 100644
index 8e2b65d183..0000000000
--- a/hadrian/src/Rules/Generate.hs
+++ /dev/null
@@ -1,482 +0,0 @@
-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
deleted file mode 100644
index 46fad8a32c..0000000000
--- a/hadrian/src/Rules/Gmp.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-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
deleted file mode 100644
index bcdbf33e34..0000000000
--- a/hadrian/src/Rules/Install.hs
+++ /dev/null
@@ -1,336 +0,0 @@
-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
deleted file mode 100644
index 73f481d88a..0000000000
--- a/hadrian/src/Rules/Libffi.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-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
deleted file mode 100644
index e6e5b167ff..0000000000
--- a/hadrian/src/Rules/Library.hs
+++ /dev/null
@@ -1,103 +0,0 @@
-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
deleted file mode 100644
index 2442b03de3..0000000000
--- a/hadrian/src/Rules/PackageData.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-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
deleted file mode 100644
index dca177f879..0000000000
--- a/hadrian/src/Rules/Program.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-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 ++ ")."
-
-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
- 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
deleted file mode 100644
index 7c0a3e00e8..0000000000
--- a/hadrian/src/Rules/Register.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-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
deleted file mode 100644
index d1ffaac1c3..0000000000
--- a/hadrian/src/Rules/Selftest.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-{-# 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
deleted file mode 100644
index 3143c4b153..0000000000
--- a/hadrian/src/Rules/SourceDist.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-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
deleted file mode 100644
index ae37343432..0000000000
--- a/hadrian/src/Rules/Test.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-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
deleted file mode 100644
index 20763a778e..0000000000
--- a/hadrian/src/Rules/Wrappers.hs
+++ /dev/null
@@ -1,162 +0,0 @@
-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