Commit 02351ac9 authored by Zhen Zhang's avatar Zhen Zhang Committed by Andrey Mokhov
Browse files

Fix implicit assumption about inplace installation etc. (#315)

parent 0589a9e4
......@@ -64,9 +64,7 @@ executable hadrian
, Rules.Selftest
, Rules.SourceDist
, Rules.Test
, Rules.Wrappers.Ghc
, Rules.Wrappers.GhcPkg
, Rules.Wrappers.RunGhc
, Rules.Wrappers
, Settings
, Settings.Builders.Alex
, Settings.Builders.Ar
......@@ -102,6 +100,7 @@ executable hadrian
, Settings.Packages.Rts
, Settings.Packages.RunGhc
, Settings.Path
, Settings.Install
, Stage
, Target
, UserSettings
......
......@@ -4,11 +4,10 @@ module GHC (
array, base, binary, bytestring, cabal, checkApiAnnotations, compareSizes,
compiler, containers, deepseq, deriveConstants, directory, dllSplit, filepath,
genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghci,
ghcPkg, ghcPrim, ghcTags, ghcSplit, haddock, haskeline, hsc2hs, hoopl, hp2ps,
ghcPkg, ghcPrim, ghcTags, haddock, haskeline, hsc2hs, hoopl, hp2ps,
hpc, hpcBin, integerGmp, integerSimple, iservBin, libffi, mkUserGuidePart,
parallel, pretty, primitive, process, rts, runGhc, stm, templateHaskell,
terminfo, time, touchy, transformers, unlit, unix, win32, xhtml,
defaultKnownPackages, builderProvenance, programName, nonCabalContext,
nonHsMainPackage
) where
......@@ -89,11 +88,6 @@ unix = library "unix"
win32 = library "Win32"
xhtml = library "xhtml"
-- | @ghc-split@ is a Perl script used by GHC with @-split-objs@ flag. It is
-- generated in "Rules.Generators.GhcSplit".
ghcSplit :: FilePath
ghcSplit = "inplace/lib/bin/ghc-split"
-- | Some builders are built by this very build system, in which case
-- 'builderProvenance' returns the corresponding build 'Context' (which includes
-- 'Stage' and GHC 'Package').
......
......@@ -27,7 +27,7 @@ allStages = [minBound ..]
-- | This rule 'need' all top-level build targets.
topLevelTargets :: Rules ()
topLevelTargets = do
want $ Rules.Generate.installTargets
want $ Rules.Generate.inplaceLibCopyTargets
forM_ allStages $ \stage ->
forM_ (knownPackages \\ [rts, libffi]) $ \pkg -> action $ do
......
......@@ -5,7 +5,6 @@ import Distribution.PackageDescription
import Distribution.PackageDescription.Parse
import Distribution.Text
import Distribution.Types.CondTree
import Distribution.Types.Dependency
import Distribution.Verbosity
import Base
......
......@@ -11,8 +11,8 @@ cleanRules = do
"clean" ~> do
forM_ [Stage0 ..] $ removeDirectory . (buildRootPath -/-) . stageString
removeDirectory generatedPath
removeDirectory programInplacePath
removeDirectory "inplace/lib"
removeDirectory inplaceBinPath
removeDirectory inplaceLibPath
removeDirectory "sdistprep"
putBuild $ "| Remove Hadrian files..."
removeFilesAfter buildRootPath ["//*"]
......
module Rules.Generate (
isGeneratedCFile, isGeneratedCmmFile, generatePackageCode, generateRules,
installTargets, copyRules, includesDependencies, generatedDependencies
inplaceLibCopyTargets, copyRules, includesDependencies, generatedDependencies
) where
import Base
......@@ -24,12 +24,17 @@ import Target
import UserSettings
import Util
installTargets :: [FilePath]
installTargets = [ "inplace/lib/ghc-usage.txt"
, "inplace/lib/ghci-usage.txt"
, "inplace/lib/platformConstants"
, "inplace/lib/settings"
, "inplace/lib/template-hsc.h" ]
-- | Files that need to be copied over to inplace/lib
-- ref: ghc/ghc.mk:142
-- ref: driver/ghc.mk
-- ref: utils/hsc2hs/ghc.mk:35
inplaceLibCopyTargets :: [FilePath]
inplaceLibCopyTargets = map (inplaceLibPath -/-)
[ "ghc-usage.txt"
, "ghci-usage.txt"
, "platformConstants"
, "settings"
, "template-hsc.h" ]
primopsSource :: FilePath
primopsSource = "compiler/prelude/primops.txt.pp"
......@@ -59,7 +64,7 @@ ghcPrimDependencies = do
return [path -/- "GHC/Prim.hs", path -/- "GHC/PrimopWrappers.hs"]
derivedConstantsDependencies :: [FilePath]
derivedConstantsDependencies = installTargets ++ fmap (generatedPath -/-)
derivedConstantsDependencies = inplaceLibCopyTargets ++ fmap (generatedPath -/-)
[ "DerivedConstants.h"
, "GHCConstantsHaskellExports.hs"
, "GHCConstantsHaskellType.hs"
......@@ -145,11 +150,11 @@ generatePackageCode context@(Context stage pkg _) =
copyRules :: Rules ()
copyRules = do
"inplace/lib/ghc-usage.txt" <~ "driver"
"inplace/lib/ghci-usage.txt" <~ "driver"
"inplace/lib/platformConstants" <~ generatedPath
"inplace/lib/settings" <~ "."
"inplace/lib/template-hsc.h" <~ pkgPath hsc2hs
(inplaceLibPath -/- "ghc-usage.txt") <~ "driver"
(inplaceLibPath -/- "ghci-usage.txt" ) <~ "driver"
(inplaceLibPath -/- "platformConstants") <~ generatedPath
(inplaceLibPath -/- "settings") <~ "."
(inplaceLibPath -/- "template-hsc.h") <~ pkgPath hsc2hs
rtsBuildPath -/- "c/sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c")
rtsBuildPath -/- "c/sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c")
where
......@@ -161,9 +166,9 @@ generateRules = do
(generatedPath -/- "ghcplatform.h") <~ generateGhcPlatformH
(generatedPath -/- "ghcversion.h") <~ generateGhcVersionH
ghcSplit %> \_ -> do
generate ghcSplit emptyTarget generateGhcSplit
makeExecutable ghcSplit
ghcSplitPath %> \_ -> do
generate ghcSplitPath emptyTarget generateGhcSplit
makeExecutable ghcSplitPath
-- TODO: simplify, get rid of fake rts context
generatedPath ++ "//*" %> \file -> do
......
......@@ -7,8 +7,10 @@ import Rules.Generators.Common
import Settings
ghcSplitSource :: FilePath
ghcSplitSource = "driver/split/ghc-split.prl"
ghcSplitSource = "driver/split/ghc-split.pl"
-- | Generate the ghc-split Perl script
-- ref: rules/build-perl.mk
generateGhcSplit :: Expr String
generateGhcSplit = do
trackSource "Rules/Generators/GhcSplit.hs"
......@@ -18,8 +20,8 @@ generateGhcSplit = do
contents <- lift $ readFileLines ghcSplitSource
return . unlines $
[ "#!" ++ perlPath
, "$TARGETPLATFORM = " ++ show targetPlatform ++ ";"
, "my $TARGETPLATFORM = " ++ show targetPlatform ++ ";"
-- I don't see where the ghc-split tool uses TNC, but
-- it's in the build-perl macro.
, "$TABLES_NEXT_TO_CODE = " ++ show ghcEnableTNC ++ ";"
, "my $TABLES_NEXT_TO_CODE = " ++ show ghcEnableTNC ++ ";"
] ++ contents
......@@ -10,24 +10,22 @@ import Oracles.Config.Setting
import Oracles.Dependencies
import Oracles.ModuleFiles
import Oracles.PackageData
import Rules.Wrappers.Ghc
import Rules.Wrappers.GhcPkg
import Rules.Wrappers.RunGhc
import Oracles.Path (topDirectory)
import Rules.Wrappers (WrappedBinary(..), Wrapper,
ghcWrapper, runGhcWrapper, inplaceGhcPkgWrapper)
import Settings
import Settings.Path
import Settings.Path (buildPath, inplaceLibBinPath, rtsContext, objectPath,
inplaceLibPath, inplaceBinPath)
import Target
import UserSettings
import Util
-- | Wrapper is an expression depending on the 'FilePath' to the wrapped binary.
type Wrapper = FilePath -> Expr String
-- | List of wrappers we build.
wrappers :: [(Context, Wrapper)]
wrappers = [ (vanillaContext Stage0 ghc , ghcWrapper )
, (vanillaContext Stage1 ghc , ghcWrapper )
, (vanillaContext Stage1 runGhc, runGhcWrapper)
, (vanillaContext Stage0 ghcPkg, ghcPkgWrapper) ]
, (vanillaContext Stage0 ghcPkg, inplaceGhcPkgWrapper) ]
buildProgram :: [(Resource, Int)] -> Context -> Rules ()
buildProgram rs context@Context {..} = when (isProgram package) $ do
......@@ -40,12 +38,12 @@ buildProgram rs context@Context {..} = when (isProgram package) $ do
-- Rules for programs built in install directories
when (stage == Stage0 || package == ghc) $ do
-- Some binaries in programInplacePath are wrapped
programInplacePath -/- programName context <.> exe %> \bin -> do
-- Some binaries in inplace/bin are wrapped
inplaceBinPath -/- programName context <.> exe %> \bin -> do
binStage <- installStage
buildBinaryAndWrapper rs (context { stage = binStage }) bin
-- We build only unwrapped binaries in programInplaceLibPath
programInplaceLibPath -/- programName context <.> exe %> \bin -> do
-- We build only unwrapped binaries in inplace/lib/bin
inplaceLibBinPath -/- programName context <.> exe %> \bin -> do
binStage <- installStage
buildBinary rs (context { stage = binStage }) bin
......@@ -57,13 +55,15 @@ buildBinaryAndWrapper rs context bin = do
else case lookup context wrappers of
Nothing -> buildBinary rs context bin -- No wrapper found
Just wrapper -> do
let wrappedBin = programInplaceLibPath -/- takeFileName bin
top <- topDirectory
let libdir = top -/- inplaceLibPath
let wrappedBin = inplaceLibBinPath -/- takeFileName bin
need [wrappedBin]
buildWrapper context wrapper bin wrappedBin
buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName bin))
buildWrapper :: Context -> Wrapper -> FilePath -> FilePath -> Action ()
buildWrapper context@Context {..} wrapper wrapperPath binPath = do
contents <- interpretInContext context $ wrapper binPath
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 " ++
......
......@@ -14,7 +14,7 @@ import Util
registerPackage :: [(Resource, Int)] -> Context -> Rules ()
registerPackage rs context@Context {..} = when (stage <= Stage1) $ do
let confIn = pkgInplaceConfig context
dir = packageDbDirectory stage
dir = inplacePackageDbDirectory stage
matchVersionedFilePath (dir -/- pkgNameString package) "conf" ?> \conf -> do
need [confIn]
......
module Rules.Wrappers (
WrappedBinary(..), Wrapper, ghcWrapper, runGhcWrapper,
inplaceGhcPkgWrapper, installGhcPkgWrapper
) where
import Base
import Expression (Expr, getStage)
import Settings.Install (installPackageDbDirectory)
import Settings.Path (inplacePackageDbDirectory)
import Oracles.Path (getTopDirectory)
-- | Wrapper is an expression depending on the 'FilePath' to the
-- | library path and name of the wrapped binary.
data WrappedBinary = WrappedBinary {
binaryLibPath :: FilePath,
binaryName :: String
}
type Wrapper = WrappedBinary -> Expr String
ghcWrapper :: WrappedBinary -> Expr String
ghcWrapper WrappedBinary{..} = do
lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
return $ unlines
[ "#!/bin/bash"
, "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
runGhcWrapper :: WrappedBinary -> Expr String
runGhcWrapper WrappedBinary{..} = do
lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
return $ unlines
[ "#!/bin/bash"
, "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
++ " -f" ++ (binaryLibPath -/- "bin/ghc-stage2") -- HACK
++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
inplaceGhcPkgWrapper :: WrappedBinary -> Expr String
inplaceGhcPkgWrapper WrappedBinary{..} = do
lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
stage <- getStage
top <- getTopDirectory
-- Use the package configuration for the next stage in the wrapper.
-- The wrapper is generated in StageN, but used in StageN+1.
let packageDb = top -/- inplacePackageDbDirectory (succ stage)
return $ unlines
[ "#!/bin/bash"
, "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
++ " --global-package-db " ++ packageDb ++ " ${1+\"$@\"}" ]
installGhcPkgWrapper :: WrappedBinary -> Expr String
installGhcPkgWrapper WrappedBinary{..} = do
lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
stage <- getStage
top <- getTopDirectory
-- Use the package configuration for the next stage in the wrapper.
-- The wrapper is generated in StageN, but used in StageN+1.
let packageDb = installPackageDbDirectory binaryLibPath top (succ stage)
return $ unlines
[ "#!/bin/bash"
, "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
++ " --global-package-db " ++ packageDb ++ " ${1+\"$@\"}" ]
module Rules.Wrappers.Ghc (ghcWrapper) where
import Base
import Expression
import Oracles.Path
ghcWrapper :: FilePath -> Expr String
ghcWrapper program = do
lift $ need [sourcePath -/- "Rules/Wrappers/Ghc.hs"]
top <- getTopDirectory
return $ unlines
[ "#!/bin/bash"
, "exec " ++ (top -/- program)
++ " -B" ++ (top -/- "inplace/lib") ++ " ${1+\"$@\"}" ]
module Rules.Wrappers.GhcPkg (ghcPkgWrapper) where
import Base
import Expression
import Oracles.Path
import Settings.Path
ghcPkgWrapper :: FilePath -> Expr String
ghcPkgWrapper program = do
lift $ need [sourcePath -/- "Rules/Wrappers/GhcPkg.hs"]
top <- getTopDirectory
stage <- getStage
-- Use the package configuration for the next stage in the wrapper.
-- The wrapper is generated in StageN, but used in StageN+1.
let packageDb = top -/- packageDbDirectory (succ stage)
return $ unlines
[ "#!/bin/bash"
, "exec " ++ (top -/- program)
++ " --global-package-db " ++ packageDb ++ " ${1+\"$@\"}" ]
module Rules.Wrappers.RunGhc (runGhcWrapper) where
import Base
import Expression
import Oracles.Path
runGhcWrapper :: FilePath -> Expr String
runGhcWrapper program = do
lift $ need [sourcePath -/- "Rules/Wrappers/RunGhc.hs"]
top <- getTopDirectory
return $ unlines
[ "#!/bin/bash"
, "exec " ++ (top -/- program)
++ " -f" ++ (top -/- "inplace/lib/bin/ghc-stage2") -- HACK
++ " -B" ++ (top -/- "inplace/lib") ++ " ${1+\"$@\"}" ]
......@@ -75,4 +75,4 @@ bootPackageDatabaseArgs = do
stage0 ? do
path <- getTopDirectory
prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=")
arg $ prefix ++ path -/- packageDbDirectory Stage0
arg $ prefix ++ path -/- inplacePackageDbDirectory Stage0
......@@ -2,6 +2,7 @@ module Settings.Builders.Ghc (ghcBuilderArgs, ghcMBuilderArgs, haddockGhcArgs) w
import Flavour
import GHC
import Settings.Path (ghcSplitPath)
import Settings.Builders.Common
ghcBuilderArgs :: Args
......@@ -40,7 +41,7 @@ needTouchy = notStage0 ? do
splitObjectsArgs :: Args
splitObjectsArgs = splitObjects flavour ? do
lift $ need [ghcSplit]
lift $ need [ghcSplitPath]
arg "-split-objs"
ghcMBuilderArgs :: Args
......
module Settings.Install (
installPackageDbDirectory
) where
import Base
import Expression (Stage(..))
import UserSettings (buildRootPath)
-- | In the final installation path specified by "DEST", there is another package.conf.d,
-- different from packageDbDirectory in Settings.Path.
-- It is used by installGhcPkgWrapper
installPackageDbDirectory :: FilePath -> FilePath -> Stage -> FilePath
installPackageDbDirectory _ top Stage0 = top -/- buildRootPath -/- "stage0/bootstrapping.conf"
installPackageDbDirectory libdir _ _ = libdir -/- "package.conf.d"
......@@ -2,10 +2,10 @@ module Settings.Path (
stageDirectory, buildPath, pkgDataFile, pkgHaddockFile, pkgLibraryFile,
pkgLibraryFile0, pkgGhciLibraryFile, gmpContext, gmpBuildPath, gmpObjects,
gmpLibraryH, gmpBuildInfoPath, generatedPath, libffiContext, libffiBuildPath,
rtsContext, rtsBuildPath, rtsConfIn, shakeFilesPath,packageDbDirectory,
rtsContext, rtsBuildPath, rtsConfIn, shakeFilesPath,inplacePackageDbDirectory,
pkgConfFile, packageDbStamp, bootPackageConstraints, packageDependencies,
objectPath, programInplacePath, programInplaceLibPath, installPath,
autogenPath, pkgInplaceConfig
objectPath, inplaceBinPath, inplaceLibBinPath, inplaceLibPath,
installPath, autogenPath, pkgInplaceConfig, ghcSplitPath
) where
import Base
......@@ -38,12 +38,16 @@ stageDirectory :: Stage -> FilePath
stageDirectory = stageString
-- | Directory for binaries that are built "in place".
programInplacePath :: FilePath
programInplacePath = "inplace/bin"
inplaceBinPath :: FilePath
inplaceBinPath = "inplace/bin"
-- | Directory for libraries that are built "in place".
inplaceLibPath :: FilePath
inplaceLibPath = "inplace/lib"
-- | Directory for binary wrappers, and auxiliary binaries such as @touchy@.
programInplaceLibPath :: FilePath
programInplaceLibPath = "inplace/lib/bin"
inplaceLibBinPath :: FilePath
inplaceLibBinPath = "inplace/lib/bin"
-- | Path to the directory containing build artefacts of a given 'Context'.
buildPath :: Context -> FilePath
......@@ -142,19 +146,19 @@ libffiBuildPath = buildPath libffiContext
-- | Path to package database directory of a given 'Stage'. Note: StageN, N > 0,
-- share the same packageDbDirectory.
packageDbDirectory :: Stage -> FilePath
packageDbDirectory Stage0 = buildRootPath -/- "stage0/bootstrapping.conf"
packageDbDirectory _ = "inplace/lib/package.conf.d"
inplacePackageDbDirectory :: Stage -> FilePath
inplacePackageDbDirectory Stage0 = buildRootPath -/- "stage0/bootstrapping.conf"
inplacePackageDbDirectory _ = "inplace/lib/package.conf.d"
-- | We use a stamp file to track the existence of a package database.
packageDbStamp :: Stage -> FilePath
packageDbStamp stage = packageDbDirectory stage -/- ".stamp"
packageDbStamp stage = inplacePackageDbDirectory stage -/- ".stamp"
-- | Path to the configuration file of a given 'Context'.
pkgConfFile :: Context -> Action FilePath
pkgConfFile context@Context {..} = do
componentId <- pkgData . ComponentId $ buildPath context
return $ packageDbDirectory stage -/- componentId <.> "conf"
return $ inplacePackageDbDirectory stage -/- componentId <.> "conf"
-- | Given a 'FilePath' to a source file, return 'True' if it is generated.
-- The current implementation simply assumes that a file is generated if it
......@@ -180,6 +184,11 @@ objectPath context@Context {..} src
-- installed. Most programs are installed in 'programInplacePath'.
installPath :: Package -> FilePath
installPath pkg
| pkg == touchy = programInplaceLibPath
| pkg == unlit = programInplaceLibPath
| otherwise = programInplacePath
| pkg == touchy = inplaceLibBinPath
| pkg == unlit = inplaceLibBinPath
| otherwise = inplaceBinPath
-- | @ghc-split@ is a Perl script used by GHC with @-split-objs@ flag. It is
-- generated in "Rules.Generators.GhcSplit".
ghcSplitPath :: FilePath
ghcSplitPath = inplaceLibBinPath -/- "ghc-split"
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment