Commit 36dbbf72 authored by Edward Z. Yang's avatar Edward Z. Yang Committed by GitHub
Browse files

Merge pull request #3944 from ezyang/backpack

Pass -this-component-id to GHC when necessary.
parents 6dea5762 f281a9c9
......@@ -13,7 +13,6 @@
module Distribution.Backpack (
-- * OpenUnitId
OpenUnitId(..),
openUnitIdComponentId,
openUnitIdFreeHoles,
mkOpenUnitId,
......@@ -117,11 +116,6 @@ instance Text OpenUnitId where
parseOpenModuleSubst
return (IndefFullUnitId cid insts)
-- | Get the 'ComponentId' of an 'OpenUnitId'.
openUnitIdComponentId :: OpenUnitId -> ComponentId
openUnitIdComponentId (IndefFullUnitId cid _) = cid
openUnitIdComponentId (DefiniteUnitId def_uid) = unitIdComponentId (unDefUnitId def_uid)
-- | Get the set of holes ('ModuleVar') embedded in a 'UnitId'.
openUnitIdFreeHoles :: OpenUnitId -> Set ModuleName
openUnitIdFreeHoles (IndefFullUnitId _ insts) = openModuleSubstFreeHoles insts
......@@ -129,11 +123,11 @@ openUnitIdFreeHoles _ = Set.empty
-- | Safe constructor from a UnitId. The only way to do this safely
-- is if the instantiation is provided.
mkOpenUnitId :: UnitId -> OpenModuleSubst -> OpenUnitId
mkOpenUnitId uid insts =
mkOpenUnitId :: UnitId -> ComponentId -> OpenModuleSubst -> OpenUnitId
mkOpenUnitId uid cid insts =
if Set.null (openModuleSubstFreeHoles insts)
then DefiniteUnitId (unsafeMkDefUnitId uid) -- invariant holds!
else IndefFullUnitId (unitIdComponentId uid) insts
else IndefFullUnitId cid insts
-----------------------------------------------------------------------
-- DefUnitId
......@@ -142,7 +136,9 @@ mkOpenUnitId uid insts =
-- with no holes.
mkDefUnitId :: ComponentId -> Map ModuleName Module -> DefUnitId
mkDefUnitId cid insts =
unsafeMkDefUnitId (UnitId cid (hashModuleSubst insts)) -- impose invariant!
unsafeMkDefUnitId (mkUnitId
(unComponentId cid ++ maybe "" ("+"++) (hashModuleSubst insts)))
-- impose invariant!
-----------------------------------------------------------------------
-- OpenModule
......
......@@ -107,14 +107,12 @@ configureComponentLocalBuildInfos
(vcat (map dispLinkedComponent graph2))
let pid_map = Map.fromList $
[ (pc_cid pkg, pc_pkgid pkg)
[ (pc_uid pkg, pc_pkgid pkg)
| pkg <- prePkgDeps] ++
[ (Installed.installedComponentId pkg, Installed.sourcePackageId pkg)
[ (Installed.installedUnitId pkg, Installed.sourcePackageId pkg)
| (_, Module uid _) <- instantiate_with
, Just pkg <- [PackageIndex.lookupUnitId
installedPackageSet (unDefUnitId uid)] ] ++
[ (lc_cid lc, lc_pkgid lc)
| lc <- graph2 ]
installedPackageSet (unDefUnitId uid)] ]
subst = Map.fromList instantiate_with
graph3 = toReadyComponents pid_map subst graph2
graph4 = Graph.revTopSort (Graph.fromList graph3)
......@@ -251,10 +249,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
= Installed.ExposedModule modname'
(Just (OpenModule (DefiniteUnitId uid) modname))
convOpenModuleExport (modname', modu@(OpenModule uid modname))
-- TODO: This isn't a good enough test if we have mutual
-- recursion (but maybe we'll get saved by the module name
-- check regardless.)
| openUnitIdComponentId uid == this_cid
| uid == this_open_uid
, modname' == modname
= Installed.ExposedModule modname' Nothing
| otherwise
......@@ -276,6 +271,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
in LibComponentLocalBuildInfo {
componentPackageDeps = cpds,
componentUnitId = this_uid,
componentComponentId = this_cid,
componentInstantiatedWith = insts,
componentIsIndefinite_ = is_indefinite,
componentLocalName = cname,
......@@ -290,6 +286,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
CExe _ ->
ExeComponentLocalBuildInfo {
componentUnitId = this_uid,
componentComponentId = this_cid,
componentLocalName = cname,
componentPackageDeps = cpds,
componentExeDeps = map unDefUnitId $ rc_internal_build_tools rc,
......@@ -299,6 +296,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
CTest _ ->
TestComponentLocalBuildInfo {
componentUnitId = this_uid,
componentComponentId = this_cid,
componentLocalName = cname,
componentPackageDeps = cpds,
componentExeDeps = map unDefUnitId $ rc_internal_build_tools rc,
......@@ -308,6 +306,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
CBench _ ->
BenchComponentLocalBuildInfo {
componentUnitId = this_uid,
componentComponentId = this_cid,
componentLocalName = cname,
componentPackageDeps = cpds,
componentExeDeps = map unDefUnitId $ rc_internal_build_tools rc,
......@@ -315,8 +314,9 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
componentIncludes = includes
}
where
this_uid = rc_uid rc
this_cid = unitIdComponentId this_uid
this_uid = rc_uid rc
this_open_uid = rc_open_uid rc
this_cid = rc_cid rc
cname = componentName (rc_component rc)
cpds = rc_depends rc
is_indefinite =
......
......@@ -94,23 +94,16 @@ computeComponentId mb_ipid mb_cid pid cname mb_details =
-- When we have the public library, the compat-pkg-name is just the
-- package-name, no surprises there!
--
computeCompatPackageName :: PackageName -> ComponentName -> Maybe UnitId -> PackageName
computeCompatPackageName :: PackageName -> ComponentName -> PackageName
-- First handle the cases where we can just use the original 'PackageName'.
-- This is for the PRIMARY library, and it is non-Backpack, or the
-- indefinite package for us.
computeCompatPackageName pkg_name CLibName Nothing = pkg_name
computeCompatPackageName pkg_name CLibName (Just (UnitId _ Nothing))
= pkg_name
-- OK, we have to z-encode
computeCompatPackageName pkg_name cname mb_uid
computeCompatPackageName pkg_name CLibName = pkg_name
computeCompatPackageName pkg_name cname
= mkPackageName $ "z-" ++ zdashcode (display pkg_name)
++ (case componentNameString cname of
Just cname_str -> "-z-" ++ zdashcode cname_str
Nothing -> "")
++ (case mb_uid of
Just (UnitId _ (Just hash))
-> "-z-" ++ hash
_ -> "")
zdashcode :: String -> String
zdashcode s = go s (Nothing :: Maybe Int) []
......@@ -173,11 +166,11 @@ computeCompatPackageKey
-> Version
-> UnitId
-> String
computeCompatPackageKey comp pkg_name pkg_version (UnitId cid Nothing)
computeCompatPackageKey comp pkg_name pkg_version uid
| not (packageKeySupported comp) =
display pkg_name ++ "-" ++ display pkg_version
| not (unifiedIPIDRequired comp) =
let str = unComponentId cid
let str = unUnitId uid -- assume no Backpack support
mb_verbatim_key
= case simpleParse str :: Maybe PackageId of
-- Something like 'foo-0.1', use it verbatim.
......@@ -192,6 +185,4 @@ computeCompatPackageKey comp pkg_name pkg_version (UnitId cid Nothing)
else Nothing
rehashed_key = hashToBase62 str
in fromMaybe rehashed_key (mb_verbatim_key `mplus` mb_truncated_key)
| otherwise = unComponentId cid
computeCompatPackageKey _comp _pkg_name _pkg_version uid@UnitId{}
= display uid
| otherwise = display uid
......@@ -3,7 +3,6 @@
-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
module Distribution.Backpack.LinkedComponent (
LinkedComponent(..),
lc_cid,
toLinkedComponent,
toLinkedComponents,
dispLinkedComponent,
......@@ -47,6 +46,7 @@ import Text.PrettyPrint
data LinkedComponent
= LinkedComponent {
lc_uid :: OpenUnitId,
lc_cid :: ComponentId,
lc_pkgid :: PackageId,
lc_insts :: [(ModuleName, OpenModule)],
lc_component :: Component,
......@@ -60,9 +60,6 @@ data LinkedComponent
lc_depends :: [(OpenUnitId, PackageId)]
}
lc_cid :: LinkedComponent -> ComponentId
lc_cid = openUnitIdComponentId . lc_uid
dispLinkedComponent :: LinkedComponent -> Doc
dispLinkedComponent lc =
hang (text "unit" <+> disp (lc_uid lc)) 4 $
......@@ -238,6 +235,7 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
return $ LinkedComponent {
lc_uid = this_uid,
lc_cid = this_cid,
lc_insts = insts,
lc_pkgid = pkgid,
lc_component = component,
......
-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
module Distribution.Backpack.PreExistingComponent (
PreExistingComponent(..),
pc_cid,
ipiToPreExistingComponent,
) where
......@@ -27,14 +26,11 @@ data PreExistingComponent
pc_pkgname :: PackageName,
pc_pkgid :: PackageId,
pc_uid :: UnitId,
pc_cid :: ComponentId,
pc_open_uid :: OpenUnitId,
pc_shape :: ModuleShape
}
-- | The 'ComponentId' of a 'PreExistingComponent'.
pc_cid :: PreExistingComponent -> ComponentId
pc_cid pc = unitIdComponentId (pc_uid pc)
-- | Convert an 'InstalledPackageInfo' into a 'PreExistingComponent',
-- which was brought into scope under the 'PackageName' (important for
-- a package qualified reference.)
......@@ -44,6 +40,7 @@ ipiToPreExistingComponent (pn, ipi) =
pc_pkgname = pn,
pc_pkgid = Installed.sourcePackageId ipi,
pc_uid = Installed.installedUnitId ipi,
pc_cid = Installed.installedComponentId ipi,
pc_open_uid =
IndefFullUnitId (Installed.installedComponentId ipi)
(Map.fromList (Installed.instantiatedWith ipi)),
......
......@@ -35,6 +35,7 @@ import Control.Monad
import Text.PrettyPrint
import qualified Data.Map as Map
import Distribution.Version
import Distribution.Text
-- | An instantiated component is simply a linked component which
......@@ -62,6 +63,8 @@ data IndefiniteComponent
data ReadyComponent
= ReadyComponent {
rc_uid :: UnitId,
rc_open_uid :: OpenUnitId,
rc_cid :: ComponentId,
rc_pkgid :: PackageId,
rc_component :: Component,
-- build-tools don't participate in mix-in linking.
......@@ -85,18 +88,19 @@ instance IsNode ReadyComponent where
nodeKey = rc_uid
nodeNeighbors rc =
(case rc_i rc of
Right _ | UnitId cid (Just _)
<- rc_uid rc -> [newSimpleUnitId cid]
Right inst | [] <- instc_insts inst
-> []
| otherwise
-> [newSimpleUnitId (rc_cid rc)]
_ -> []) ++
ordNub (map fst (rc_depends rc))
rc_compat_name :: ReadyComponent -> PackageName
rc_compat_name ReadyComponent{
rc_pkgid = PackageIdentifier pkg_name _,
rc_component = component,
rc_uid = uid
rc_component = component
}
= computeCompatPackageName pkg_name (componentName component) (Just uid)
= computeCompatPackageName pkg_name (componentName component)
rc_compat_key :: ReadyComponent -> Compiler -> String
rc_compat_key rc@ReadyComponent {
......@@ -158,7 +162,7 @@ instance Monad InstM where
-- instantiated components are given 'HashedUnitId'.
--
toReadyComponents
:: Map ComponentId PackageId
:: Map UnitId PackageId
-> Map ModuleName Module -- subst for the public component
-> [LinkedComponent]
-> [ReadyComponent]
......@@ -198,12 +202,19 @@ toReadyComponents pid_map subst0 comps
x' <- substUnitId insts x
return (x', y)
build_tools <- mapM (substUnitId insts) (lc_internal_build_tools lc)
s <- InstM $ \s -> (s, s)
let getDep (Module dep_def_uid _)
| let dep_uid = unDefUnitId dep_def_uid
, Just pid <- Map.lookup (unitIdComponentId dep_uid) pid_map
-- Lose DefUnitId invariant for rc_depends
= [(dep_uid, pid)]
getDep _ = []
= [(dep_uid,
fromMaybe err_pid $
Map.lookup dep_uid pid_map A.<|>
fmap rc_pkgid (join (Map.lookup dep_uid s)))]
where
err_pid =
PackageIdentifier
(mkPackageName "nonexistent-package-this-is-a-cabal-bug")
(mkVersion [0])
instc = InstantiatedComponent {
instc_insts = Map.toList insts,
instc_provides = provides,
......@@ -211,6 +222,8 @@ toReadyComponents pid_map subst0 comps
}
return $ Just ReadyComponent {
rc_uid = uid,
rc_open_uid = DefiniteUnitId (unsafeMkDefUnitId uid),
rc_cid = lc_cid lc,
rc_pkgid = lc_pkgid lc,
rc_component = lc_component lc,
rc_internal_build_tools = build_tools,
......@@ -263,7 +276,9 @@ toReadyComponents pid_map subst0 comps
indefc_includes = lc_includes lc
}
return $ Just ReadyComponent {
rc_uid = uid,
rc_uid = uid,
rc_open_uid = lc_uid lc,
rc_cid = lc_cid lc,
rc_pkgid = lc_pkgid lc,
rc_component = lc_component lc,
rc_internal_build_tools = build_tools,
......
......@@ -443,7 +443,7 @@ convertInclude ((uid, ModuleShape provs reqs), pid, incl@(IncludeRenaming prov_r
let hides_set = Set.fromList hides
in let r = [ (k,v)
| (k,v) <- Map.toList provs
, k `Set.member` hides_set ]
, not (k `Set.member` hides_set) ]
-- GHC doesn't understand hiding, so expand it out!
in return (r, ModuleRenaming (map ((\x -> (x,x)).fst) r))
ModuleRenaming rns -> do
......
......@@ -29,8 +29,8 @@
module Distribution.InstalledPackageInfo (
InstalledPackageInfo(..),
installedComponentId,
installedPackageId,
installedComponentId,
requiredSignatures,
installedOpenUnitId,
ExposedModule(..),
......@@ -72,6 +72,7 @@ data InstalledPackageInfo
-- these parts are exactly the same as PackageDescription
sourcePackageId :: PackageId,
installedUnitId :: UnitId,
installedComponentId_ :: ComponentId,
-- INVARIANT: if this package is definite, OpenModule's
-- OpenUnitId directly records UnitId. If it is
-- indefinite, OpenModule is always an OpenModuleVar
......@@ -118,6 +119,12 @@ data InstalledPackageInfo
}
deriving (Eq, Generic, Read, Show)
installedComponentId :: InstalledPackageInfo -> ComponentId
installedComponentId ipi =
case unComponentId (installedComponentId_ ipi) of
"" -> mkComponentId (unUnitId (installedUnitId ipi))
_ -> installedComponentId_ ipi
-- | Get the indefinite unit identity representing this package.
-- This IS NOT guaranteed to give you a substitution; for
-- instantiated packages you will get @DefiniteUnitId (installedUnitId ipi)@.
......@@ -125,16 +132,13 @@ data InstalledPackageInfo
-- an @OpenUnitId@ with the appropriate 'OpenModuleSubst'.
installedOpenUnitId :: InstalledPackageInfo -> OpenUnitId
installedOpenUnitId ipi
= mkOpenUnitId (installedUnitId ipi) (Map.fromList (instantiatedWith ipi))
= mkOpenUnitId (installedUnitId ipi) (installedComponentId ipi) (Map.fromList (instantiatedWith ipi))
-- | Returns the set of module names which need to be filled for
-- an indefinite package, or the empty set if the package is definite.
requiredSignatures :: InstalledPackageInfo -> Set ModuleName
requiredSignatures ipi = openModuleSubstFreeHoles (Map.fromList (instantiatedWith ipi))
installedComponentId :: InstalledPackageInfo -> ComponentId
installedComponentId ipi = unitIdComponentId (installedUnitId ipi)
{-# DEPRECATED installedPackageId "Use installedUnitId instead" #-}
-- | Backwards compatibility with Cabal pre-1.24.
-- This type synonym is slightly awful because in cabal-install
......@@ -164,6 +168,7 @@ emptyInstalledPackageInfo
= InstalledPackageInfo {
sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion,
installedUnitId = mkUnitId "",
installedComponentId_ = mkComponentId "",
instantiatedWith = [],
compatPackageKey = "",
license = UnspecifiedLicense,
......
......@@ -24,11 +24,10 @@ module Distribution.Package (
-- * Package keys/installed package IDs (used for linker symbols)
ComponentId, unComponentId, mkComponentId,
UnitId(..),
UnitId, unUnitId, mkUnitId,
DefUnitId,
unsafeMkDefUnitId,
unDefUnitId,
mkUnitId,
newSimpleUnitId,
mkLegacyUnitId,
getHSLibraryName,
......@@ -248,28 +247,20 @@ getHSLibraryName uid = "HS" ++ display uid
-- "Distribution.Backpack.FullUnitId" for a mechanism for expanding an
-- instantiated 'UnitId' to retrieve its mapping.
--
data UnitId
= UnitId {
unitIdComponentId :: ComponentId,
unitIdHash :: Maybe String
}
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
newtype UnitId = UnitId String
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data, NFData)
instance Binary UnitId
instance NFData UnitId where
rnf (UnitId cid str) = rnf cid `seq` rnf str
instance Text UnitId where
disp (UnitId cid Nothing) = disp cid
disp (UnitId cid (Just hash)) = disp cid <<>> text "+" <<>> text hash
parse = parseUnitId <++ parseSimpleUnitId
where
parseUnitId = do cid <- parse
_ <- Parse.char '+'
hash <- Parse.munch1 isAlphaNum
return (UnitId cid (Just hash))
parseSimpleUnitId = fmap newSimpleUnitId parse
disp (UnitId str) = text str
parse = UnitId `fmap` Parse.munch1 (\c -> isAlphaNum c || c `elem` "-_.+")
unUnitId :: UnitId -> String
unUnitId (UnitId str) = str
mkUnitId :: String -> UnitId
mkUnitId str = UnitId str
-- | A 'UnitId' for a definite package. The 'DefUnitId' invariant says
-- that a 'UnitId' identified this way is definite; i.e., it has no
......@@ -285,15 +276,7 @@ unsafeMkDefUnitId = DefUnitId
-- | Create a unit identity with no associated hash directly
-- from a 'ComponentId'.
newSimpleUnitId :: ComponentId -> UnitId
newSimpleUnitId cid =
UnitId {
unitIdComponentId = cid,
unitIdHash = Nothing
}
-- | Makes a simple-style UnitId from a string.
mkUnitId :: String -> UnitId
mkUnitId = newSimpleUnitId . mkComponentId
newSimpleUnitId cid = UnitId (unComponentId cid)
-- | Make an old-style UnitId from a package identifier
mkLegacyUnitId :: PackageId -> UnitId
......
......@@ -424,7 +424,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
-- This is, like, the one place where we use a CTestName for a library.
-- Should NOT use library name, since that could conflict!
PackageIdentifier pkg_name pkg_ver = package pkg_descr
compat_name = computeCompatPackageName pkg_name (CTestName (testName test)) (Just (componentUnitId clbi))
compat_name = computeCompatPackageName pkg_name (CTestName (testName test))
compat_key = computeCompatPackageKey (compiler lbi) compat_name pkg_ver (componentUnitId clbi)
libClbi = LibComponentLocalBuildInfo
{ componentPackageDeps = componentPackageDeps clbi
......@@ -435,6 +435,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
, componentIsPublic = False
, componentIncludes = componentIncludes clbi
, componentUnitId = componentUnitId clbi
, componentComponentId = componentComponentId clbi
, componentInstantiatedWith = []
, componentCompatPackageName = compat_name
, componentCompatPackageKey = compat_key
......@@ -470,6 +471,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
-- TODO: this is a hack, but as long as this is unique
-- (doesn't clobber something) we won't run into trouble
componentUnitId = mkUnitId (stubName test),
componentComponentId = mkComponentId (stubName test),
componentInternalDeps = [componentUnitId clbi],
componentExeDeps = [],
componentLocalName = CExeName (stubName test),
......@@ -497,6 +499,7 @@ benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f }
}
exeClbi = ExeComponentLocalBuildInfo {
componentUnitId = componentUnitId clbi,
componentComponentId = componentComponentId clbi,
componentLocalName = CExeName (benchmarkName bm),
componentInternalDeps = componentInternalDeps clbi,
componentExeDeps = componentExeDeps clbi,
......
......@@ -59,6 +59,7 @@ module Distribution.Simple.Compiler (
unitIdSupported,
coverageSupported,
profilingSupported,
backpackSupported,
-- * Support for profiling detail levels
ProfDetailLevel(..),
......@@ -316,6 +317,10 @@ packageKeySupported = ghcSupported "Uses package keys"
unitIdSupported :: Compiler -> Bool
unitIdSupported = ghcSupported "Uses unit IDs"
-- | Does this compiler support Backpack?
backpackSupported :: Compiler -> Bool
backpackSupported = ghcSupported "Support Backpack"
-- | Does this compiler support Haskell program coverage?
coverageSupported :: Compiler -> Bool
coverageSupported comp =
......
......@@ -954,13 +954,18 @@ checkCompilerProblems comp pkg_descr enabled = do
all (all (isDefaultIncludeRenaming . snd) . backpackIncludes)
(enabledBuildInfos pkg_descr enabled)) $
die $ "Your compiler does not support thinning and renaming on "
++ "package flags. To use this feature you probably must use "
++ "package flags. To use this feature you must use "
++ "GHC 7.9 or later."
when (any (not.null.PD.reexportedModules) (PD.allLibraries pkg_descr)
&& not (reexportedModulesSupported comp)) $ do
die $ "Your compiler does not support module re-exports. To use "
++ "this feature you probably must use GHC 7.9 or later."
++ "this feature you must use GHC 7.9 or later."
when (any (not.null.PD.signatures) (PD.allLibraries pkg_descr)
&& not (backpackSupported comp)) $ do
die $ "Your compiler does not support Backpack. To use "
++ "this feature you must use GHC 8.1 or later."
-- | Select dependencies for the package.
configureDependencies
......@@ -1182,15 +1187,14 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap
[] -> Left $
case is_internal of
Just cname -> DependencyMissingInternal dep_pkgname
(computeCompatPackageName
(packageName pkgid) cname Nothing)
(computeCompatPackageName (packageName pkgid) cname)
Nothing -> DependencyNotExists dep_pkgname
pkgs -> Right $ ExternalDependency dep $
case last pkgs of
(_ver, pkginstances) -> head pkginstances
where
dep' | Just cname <- is_internal
= Dependency (computeCompatPackageName (packageName pkgid) cname Nothing) vr
= Dependency (computeCompatPackageName (packageName pkgid) cname) vr
| otherwise = dep
-- NB: here computeCompatPackageName we want to pick up the INDEFINITE ones
-- which is why we pass 'Nothing' as 'UnitId'
......
......@@ -736,6 +736,12 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
LibComponentLocalBuildInfo { componentCompatPackageKey = pk }
-> toFlag pk
_ -> mempty,
ghcOptThisComponentId = case clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith = insts } ->
if null insts
then mempty
else toFlag (componentComponentId clbi)
_ -> mempty,
ghcOptInstantiatedWith = case clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith = insts }
-> insts
......
......@@ -19,6 +19,7 @@ import Distribution.Compat.Prelude
import qualified Distribution.InstalledPackageInfo as Current
import qualified Distribution.Package as Current hiding (installedUnitId)
import Distribution.Simple.GHC.IPIConvert
import Distribution.Text
-- | This is the InstalledPackageInfo type used by ghc-6.4.2 and later.
--
......@@ -69,6 +70,7 @@ toCurrent ipi@InstalledPackageInfo{} =
in Current.InstalledPackageInfo {
Current.sourcePackageId = pid,
Current.installedUnitId = Current.mkLegacyUnitId pid,
Current.installedComponentId_ = Current.mkComponentId (display pid),
Current.instantiatedWith = [],
Current.compatPackageKey = "",
Current.abiHash = Current.mkAbiHash "", -- bogus but old GHCs don't care.
......
......@@ -289,6 +289,13 @@ componentGhcOptions verbosity lbi bi clbi odir =
LibComponentLocalBuildInfo { componentCompatPackageKey = pk }
-> toFlag pk
_ -> mempty,
ghcOptThisComponentId = case clbi of
LibComponentLocalBuildInfo { componentComponentId = cid
, componentInstantiatedWith = insts } ->
if null insts
then mempty
else toFlag cid
_ -> mempty,
ghcOptInstantiatedWith = case clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith = insts }
-> insts
......
......@@ -33,7 +33,6 @@ module Distribution.Simple.LocalBuildInfo (
showComponentName,
componentNameString,
ComponentLocalBuildInfo(..),
componentComponentId,
componentBuildDir,
foldComponent,
componentName,
......@@ -106,12 +105,14 @@ componentBuildDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
componentBuildDir lbi clbi
= buildDir lbi </>
case componentLocalName clbi of
CLibName -> case unitIdHash (componentUnitId clbi) of
Just hash -> hash
Nothing -> ""
CSubLibName s -> case unitIdHash (componentUnitId clbi) of
Just hash -> s ++ "-" ++ hash
Nothing -> s