diff options
Diffstat (limited to 'hadrian/src/Rules')
-rw-r--r-- | hadrian/src/Rules/Clean.hs | 23 | ||||
-rw-r--r-- | hadrian/src/Rules/Compile.hs | 81 | ||||
-rw-r--r-- | hadrian/src/Rules/Configure.hs | 43 | ||||
-rw-r--r-- | hadrian/src/Rules/Dependencies.hs | 33 | ||||
-rw-r--r-- | hadrian/src/Rules/Documentation.hs | 197 | ||||
-rw-r--r-- | hadrian/src/Rules/Generate.hs | 482 | ||||
-rw-r--r-- | hadrian/src/Rules/Gmp.hs | 119 | ||||
-rw-r--r-- | hadrian/src/Rules/Install.hs | 336 | ||||
-rw-r--r-- | hadrian/src/Rules/Libffi.hs | 108 | ||||
-rw-r--r-- | hadrian/src/Rules/Library.hs | 103 | ||||
-rw-r--r-- | hadrian/src/Rules/PackageData.hs | 119 | ||||
-rw-r--r-- | hadrian/src/Rules/Program.hs | 113 | ||||
-rw-r--r-- | hadrian/src/Rules/Register.hs | 44 | ||||
-rw-r--r-- | hadrian/src/Rules/Selftest.hs | 92 | ||||
-rw-r--r-- | hadrian/src/Rules/SourceDist.hs | 113 | ||||
-rw-r--r-- | hadrian/src/Rules/Test.hs | 72 | ||||
-rw-r--r-- | hadrian/src/Rules/Wrappers.hs | 162 |
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" |