Commit 8e3c2d7f authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Take advantage of unique section naming to simplify some paths.


Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent d4906182
......@@ -549,7 +549,7 @@ initialBuildSteps _distPref pkg_descr lbi clbi verbosity = do
die $ "No libraries, executables, tests, or benchmarks "
++ "are enabled for package " ++ name ++ "."
createDirectoryIfMissingVerbose verbosity True (buildDir lbi)
createDirectoryIfMissingVerbose verbosity True (componentBuildDir lbi clbi)
writeAutogenFiles verbosity pkg_descr lbi clbi
......
......@@ -57,7 +57,7 @@ haddockPref distPref pkg_descr
-- |The directory in which we put auto-generated modules
autogenModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenModulesDir lbi clbi = libBuildDir lbi clbi </> "autogen"
autogenModulesDir lbi clbi = componentBuildDir lbi clbi </> "autogen"
-- NB: Look at 'checkForeignDeps' for where a simplified version of this
-- has been copy-pasted.
......
......@@ -1448,17 +1448,9 @@ computeComponentId mb_explicit pid cname dep_ipids flagAssignment = do
Flag cid0 -> explicit_base cid0
NoFlag -> generated_base
ComponentId $ actual_base
++ (case cname of
-- TODO: these could result in non-parseable IPIDs
-- since the component name format is very flexible
CLibName s
| s == display (pkgName pid) -> ""
-- NB: libraries are BY FAR the most common,
-- so they are deified without a suffix
| otherwise -> "-" ++ s
CExeName s -> "-" ++ s ++ ".exe"
CTestName s -> "-" ++ s ++ ".test"
CBenchName s -> "-" ++ s ++ ".bench")
++ (case componentNameString (pkgName pid) cname of
Nothing -> ""
Just s -> "-" ++ s)
hashToBase62 :: String -> String
hashToBase62 s = showFingerprint $ fingerprintString s
......@@ -1499,25 +1491,17 @@ hashToBase62 s = showFingerprint $ fingerprintString s
--
computeCompatPackageName :: PackageName -> ComponentName -> PackageName
computeCompatPackageName pkg_name cname
| cname == CLibName (display pkg_name)
= pkg_name
| otherwise
= PackageName $ "z-" ++ zdashcode (display pkg_name)
++ cname_str
where
zdashcode s = go s (Nothing :: Maybe Int) []
| Just cname_str <- componentNameString pkg_name cname
= let zdashcode s = go s (Nothing :: Maybe Int) []
where go [] _ r = reverse r
go ('-':z) (Just n) r | n > 0 = go z (Just 0) ('-':'z':r)
go ('-':z) _ r = go z (Just 0) ('-':r)
go ('z':z) (Just n) r = go z (Just (n+1)) ('z':r)
go (c:z) _ r = go z Nothing (c:r)
cname_str = case cname of
CLibName n -> "-z-" ++ zdashcode n
-- These are for completeness, but they
-- shouldn't really be used.
CTestName n -> "-z-" ++ zdashcode n ++ "-z-test"
CBenchName n -> "-z-" ++ zdashcode n ++ "-z-bench"
CExeName n -> "-z-" ++ zdashcode n ++ "-z-exe"
in PackageName $ "z-" ++ zdashcode (display pkg_name)
++ "-z-" ++ zdashcode cname_str
| otherwise
= pkg_name
-- | In GHC 8.0, the string we pass to GHC to use for symbol
-- names for a package can be an arbitrary, IPID-compatible string.
......
......@@ -475,7 +475,7 @@ buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> Library -> ComponentLocalBuildInfo -> IO ()
buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
let uid = componentUnitId clbi
libTargetDir = libBuildDir lbi clbi
libTargetDir = componentBuildDir lbi clbi
whenVanillaLib forceVanilla =
when (forceVanilla || withVanillaLib lbi)
whenProfLib = when (withProfLib lbi)
......@@ -789,8 +789,8 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
then exeExtension
else "")
let targetDir = buildDir lbi </> exeName'
let exeDir = targetDir </> (exeName' ++ "-tmp")
let targetDir = componentBuildDir lbi clbi
exeDir = targetDir </> (exeName' ++ "-tmp")
createDirectoryIfMissingVerbose verbosity True targetDir
createDirectoryIfMissingVerbose verbosity True exeDir
-- TODO: do we need to put hs-boot files into place for mutually recursive
......@@ -1038,7 +1038,7 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do
comp = compiler lbi
platform = hostPlatform lbi
vanillaArgs =
(componentGhcOptions verbosity lbi libBi clbi (libBuildDir lbi clbi))
(componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
`mappend` mempty {
ghcOptMode = toFlag GhcModeAbiHash,
ghcOptInputModules = toNubListR $ exposedModules lib
......@@ -1137,7 +1137,7 @@ installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do
whenShared $ installShared builtDir dynlibTargetDir sharedLibName
where
builtDir = libBuildDir lbi clbi
builtDir = componentBuildDir lbi clbi
install isShared srcDir dstDir name = do
let src = srcDir </> name
......
......@@ -122,7 +122,7 @@ install pkg_descr lbi flags = do
libdir = libPref,
includedir = incPref
} = absoluteComponentInstallDirs pkg_descr lbi (componentUnitId clbi) copydest
buildPref = libBuildDir lbi clbi
buildPref = componentBuildDir lbi clbi
-- TODO: decide if we need the user to be able to control the libdir
-- for shared libs independently of the one for static libs. If so
-- it should also have a flag in the command line UI
......
......@@ -290,7 +290,7 @@ buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity pkg_descr lbi lib clbi = do
let lib_name = componentUnitId clbi
pref = libBuildDir lbi clbi
pref = componentBuildDir lbi clbi
pkgid = packageId pkg_descr
runGhcProg = rawSystemProgramConf verbosity lhcProgram (withPrograms lbi)
ifVanillaLib forceVanilla = when (forceVanilla || withVanillaLib lbi)
......
......@@ -30,10 +30,11 @@ module Distribution.Simple.LocalBuildInfo (
ComponentName(..),
defaultLibName,
showComponentName,
componentNameString,
ComponentLocalBuildInfo(..),
getLocalComponent,
libBuildDir,
componentComponentId,
componentBuildDir,
foldComponent,
componentName,
componentBuildInfo,
......@@ -218,6 +219,17 @@ defaultLibName pid = CLibName (display (pkgName pid))
instance Binary ComponentName
-- | This gets the 'String' component name. In fact, it is
-- guaranteed to uniquely identify a component, returning
-- @Nothing@ if the 'ComponentName' was for the public
-- library (which CAN conflict with an executable name.)
componentNameString :: PackageName -> ComponentName -> Maybe String
componentNameString (PackageName pkg_name) (CLibName n) | pkg_name == n = Nothing
componentNameString _ (CLibName n) = Just n
componentNameString _ (CExeName n) = Just n
componentNameString _ (CTestName n) = Just n
componentNameString _ (CBenchName n) = Just n
showComponentName :: ComponentName -> String
showComponentName (CLibName name) = "library '" ++ name ++ "'"
showComponentName (CExeName name) = "executable '" ++ name ++ "'"
......@@ -352,18 +364,24 @@ instance Binary ComponentLocalBuildInfo
getLocalComponent :: PackageDescription -> ComponentLocalBuildInfo -> Component
getLocalComponent pkg_descr clbi = getComponent pkg_descr (componentLocalName clbi)
libBuildDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
libBuildDir lbi clbi
| LibComponentLocalBuildInfo{ componentIsPublic = True } <- clbi
= buildDir lbi
| otherwise = buildDir lbi </> display (componentUnitId clbi)
componentComponentId :: ComponentLocalBuildInfo -> ComponentId
componentComponentId clbi = case componentUnitId clbi of
SimpleUnitId cid -> cid
getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName
-> ComponentLocalBuildInfo
componentBuildDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
componentBuildDir lbi LibComponentLocalBuildInfo{ componentIsPublic = True }
= buildDir lbi
-- For now, we assume that libraries/executables/test-suites/benchmarks
-- are only ever built once. With Backpack, we need a special case for
-- libraries so that we can handle building them multiple times.
componentBuildDir lbi clbi
= buildDir lbi </> case componentLocalName clbi of
CLibName s -> s
CExeName s -> s
CTestName s -> s
CBenchName s -> s
getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName -> ComponentLocalBuildInfo
getComponentLocalBuildInfo lbi cname =
case maybeGetComponentLocalBuildInfo lbi cname of
Just clbi -> clbi
......@@ -530,7 +548,7 @@ depLibraryPaths inplace relative lbi clbi = do
| sub_clbi <- componentsInBuildOrder'
lbi internalDeps ]
getLibDir sub_clbi
| inplace = libBuildDir lbi sub_clbi
| inplace = componentBuildDir lbi sub_clbi
| otherwise = libdir (absoluteComponentInstallDirs pkgDescr lbi (componentUnitId sub_clbi) NoCopyDest)
let ipkgs = allPackages (installedPkgs lbi)
......
......@@ -383,7 +383,7 @@ inplaceInstalledPackageInfo inplaceDir distPref pkg abi_hash lib lbi clbi =
pkg abi_hash lib lbi clbi installDirs
where
adjustRelativeIncludeDirs = map (inplaceDir </>)
libTargetDir = libBuildDir lbi clbi
libTargetDir = componentBuildDir lbi clbi
installDirs =
(absoluteComponentInstallDirs pkg lbi (componentUnitId clbi) NoCopyDest) {
libdir = inplaceDir </> libTargetDir,
......
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