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