Commit 28af355b authored by Edward Z. Yang's avatar Edward Z. Yang Committed by Edward Z. Yang
Browse files

Refactor Backpack data structures to be less flexible.



There were a number of fields in 'LinkedComponent' which
were "too" flexible, in that they were fully determined by
other fields in the structure.  This refactor deletes those
fields and replaces them with functions that refer to the
fields directly.

I also introduce a new type, ComponentInclude, to take
the place of tuples which were used to represent includes
(mixins) in Backpack.

There's also more documentation for lots of bits.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 3d88a3ec
...@@ -208,6 +208,7 @@ library ...@@ -208,6 +208,7 @@ library
Distribution.Types.BenchmarkType Distribution.Types.BenchmarkType
Distribution.Types.BuildInfo Distribution.Types.BuildInfo
Distribution.Types.BuildType Distribution.Types.BuildType
Distribution.Types.ComponentInclude
Distribution.Types.Dependency Distribution.Types.Dependency
Distribution.Types.LegacyExeDependency Distribution.Types.LegacyExeDependency
Distribution.Types.PkgconfigDependency Distribution.Types.PkgconfigDependency
......
...@@ -38,6 +38,7 @@ import Distribution.ModuleName ...@@ -38,6 +38,7 @@ import Distribution.ModuleName
import Distribution.Simple.Setup as Setup import Distribution.Simple.Setup as Setup
import Distribution.Simple.LocalBuildInfo import Distribution.Simple.LocalBuildInfo
import Distribution.Types.ComponentRequestedSpec import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.ComponentInclude
import Distribution.Verbosity import Distribution.Verbosity
import qualified Distribution.Compat.Graph as Graph import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Graph (Graph, IsNode(..)) import Distribution.Compat.Graph (Graph, IsNode(..))
...@@ -334,11 +335,13 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs ...@@ -334,11 +335,13 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
Left _ -> True Left _ -> True
Right _ -> False Right _ -> False
includes = includes =
case rc_i rc of map (\ci -> (ci_id ci, ci_renaming ci)) $
Left indefc -> case rc_i rc of
indefc_includes indefc Left indefc ->
Right instc -> indefc_includes indefc
map (\(x,y) -> (DefiniteUnitId x,y)) (instc_includes instc) Right instc ->
map (\ci -> ci { ci_id = DefiniteUnitId (ci_id ci) })
(instc_includes instc)
internal_deps = internal_deps =
filter isInternal (nodeNeighbors rc) filter isInternal (nodeNeighbors rc)
++ map unDefUnitId (rc_internal_build_tools rc) ++ map unDefUnitId (rc_internal_build_tools rc)
......
...@@ -23,6 +23,7 @@ import Distribution.Types.LegacyExeDependency ...@@ -23,6 +23,7 @@ import Distribution.Types.LegacyExeDependency
import Distribution.Types.IncludeRenaming import Distribution.Types.IncludeRenaming
import Distribution.Types.Mixin import Distribution.Types.Mixin
import Distribution.Types.UnqualComponentName import Distribution.Types.UnqualComponentName
import Distribution.Types.ComponentInclude
import Distribution.Package import Distribution.Package
import Distribution.PackageDescription as PD hiding (Flag) import Distribution.PackageDescription as PD hiding (Flag)
import Distribution.Simple.Setup as Setup import Distribution.Simple.Setup as Setup
...@@ -40,31 +41,42 @@ import Text.PrettyPrint ...@@ -40,31 +41,42 @@ import Text.PrettyPrint
-- and the 'ComponentId's of the things it depends on. -- and the 'ComponentId's of the things it depends on.
data ConfiguredComponent data ConfiguredComponent
= ConfiguredComponent { = ConfiguredComponent {
-- | Uniquely identifies a configured component.
cc_cid :: ComponentId, cc_cid :: ComponentId,
-- The package this component came from. -- | The package this component came from.
cc_pkgid :: PackageId, cc_pkgid :: PackageId,
-- | The fragment of syntax from the Cabal file describing this
-- component.
cc_component :: Component, cc_component :: Component,
cc_public :: Bool, -- | Is this the public library component of the package?
-- ^ Is this the public library component of the package? -- (If we invoke Setup with an instantiation, this is the
-- (THIS is what the hole instantiation applies to.) -- component the instantiation applies to.)
-- Note that in one-component configure mode, this is -- Note that in one-component configure mode, this is
-- always True, because any component is the "public" one.) -- always True, because any component is the "public" one.)
cc_public :: Bool,
-- | Dependencies on internal executables from @build-tools@.
cc_internal_build_tools :: [ComponentId], cc_internal_build_tools :: [ComponentId],
-- Not resolved yet; component configuration only looks at ComponentIds. -- | The mixins of this package, including both explicit (from
cc_includes :: [(ComponentId, PackageId, IncludeRenaming)] -- the @mixins@ field) and implicit (from @build-depends@). Not
-- mix-in linked yet; component configuration only looks at
-- 'ComponentId's.
cc_includes :: [ComponentInclude ComponentId IncludeRenaming]
} }
-- | The 'ComponentName' of a component; this uniquely identifies
-- a fragment of syntax within a specified Cabal file describing the
-- component.
cc_name :: ConfiguredComponent -> ComponentName cc_name :: ConfiguredComponent -> ComponentName
cc_name = componentName . cc_component cc_name = componentName . cc_component
-- | Pretty-print a 'ConfiguredComponent'.
dispConfiguredComponent :: ConfiguredComponent -> Doc dispConfiguredComponent :: ConfiguredComponent -> Doc
dispConfiguredComponent cc = dispConfiguredComponent cc =
hang (text "component" <+> disp (cc_cid cc)) 4 hang (text "component" <+> disp (cc_cid cc)) 4
(vcat [ hsep $ [ text "include", disp cid, disp incl_rn ] (vcat [ hsep $ [ text "include", disp (ci_id incl), disp (ci_renaming incl) ]
| (cid, _, incl_rn) <- cc_includes cc | incl <- cc_includes cc
]) ])
-- | Construct a 'ConfiguredComponent', given that the 'ComponentId' -- | Construct a 'ConfiguredComponent', given that the 'ComponentId'
-- and library/executable dependencies are known. The primary -- and library/executable dependencies are known. The primary
-- work this does is handling implicit @backpack-include@ fields. -- work this does is handling implicit @backpack-include@ fields.
...@@ -98,14 +110,23 @@ mkConfiguredComponent this_pid this_cid lib_deps exe_deps component = ...@@ -98,14 +110,23 @@ mkConfiguredComponent this_pid this_cid lib_deps exe_deps component =
error $ "Mix-in refers to non-existent package " ++ display name ++ error $ "Mix-in refers to non-existent package " ++ display name ++
" (did you forget to add the package to build-depends?)" " (did you forget to add the package to build-depends?)"
Just r -> r Just r -> r
in (cid, pid { pkgName = name }, rns) in ComponentInclude {
ci_id = cid,
-- TODO: Check what breaks if you remove this edit
ci_pkgid = pid { pkgName = name },
ci_renaming = rns
}
| Mixin name rns <- mixins bi ] | Mixin name rns <- mixins bi ]
-- Any @build-depends@ which is not explicitly mentioned in -- Any @build-depends@ which is not explicitly mentioned in
-- @backpack-include@ is converted into an "implicit" include. -- @backpack-include@ is converted into an "implicit" include.
used_explicitly = Set.fromList (map (\(cid,_,_) -> cid) explicit_includes) used_explicitly = Set.fromList (map ci_id explicit_includes)
implicit_includes implicit_includes
= map (\(cid, pid) -> (cid, pid, defaultIncludeRenaming)) = map (\(cid, pid) -> ComponentInclude {
ci_id = cid,
ci_pkgid = pid,
ci_renaming = defaultIncludeRenaming
})
$ filter (flip Set.notMember used_explicitly . fst) deps $ filter (flip Set.notMember used_explicitly . fst) deps
is_public = componentName component == CLibName is_public = componentName component == CLibName
......
...@@ -3,6 +3,8 @@ ...@@ -3,6 +3,8 @@
-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst> -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
module Distribution.Backpack.LinkedComponent ( module Distribution.Backpack.LinkedComponent (
LinkedComponent(..), LinkedComponent(..),
lc_insts,
lc_uid,
toLinkedComponent, toLinkedComponent,
toLinkedComponents, toLinkedComponents,
dispLinkedComponent, dispLinkedComponent,
...@@ -16,7 +18,6 @@ import Distribution.Compat.Prelude hiding ((<>)) ...@@ -16,7 +18,6 @@ import Distribution.Compat.Prelude hiding ((<>))
import Distribution.Backpack import Distribution.Backpack
import Distribution.Backpack.FullUnitId import Distribution.Backpack.FullUnitId
import Distribution.Backpack.ConfiguredComponent import Distribution.Backpack.ConfiguredComponent
import Distribution.Backpack.ModSubst
import Distribution.Backpack.ModuleShape import Distribution.Backpack.ModuleShape
import Distribution.Backpack.ModuleScope import Distribution.Backpack.ModuleScope
import Distribution.Backpack.UnifyM import Distribution.Backpack.UnifyM
...@@ -25,6 +26,7 @@ import Distribution.Utils.MapAccum ...@@ -25,6 +26,7 @@ import Distribution.Utils.MapAccum
import Distribution.Types.ModuleRenaming import Distribution.Types.ModuleRenaming
import Distribution.Types.IncludeRenaming import Distribution.Types.IncludeRenaming
import Distribution.Types.ComponentInclude
import Distribution.Package import Distribution.Package
import Distribution.PackageDescription as PD hiding (Flag) import Distribution.PackageDescription as PD hiding (Flag)
import Distribution.ModuleName import Distribution.ModuleName
...@@ -41,59 +43,57 @@ import Distribution.Text ...@@ -41,59 +43,57 @@ import Distribution.Text
( Text(disp) ) ( Text(disp) )
import Text.PrettyPrint import Text.PrettyPrint
-- | A linked component, we know how it is instantiated and thus how we are -- | A linked component is a component that has been mix-in linked, at
-- going to build it. -- which point we have determined how all the dependencies of the
-- component are explicitly instantiated (in the form of an OpenUnitId).
-- 'ConfiguredComponent' is mix-in linked into 'LinkedComponent', which
-- is then instantiated into 'ReadyComponent'.
data LinkedComponent data LinkedComponent
= LinkedComponent { = LinkedComponent {
lc_uid :: OpenUnitId, -- | Uniquely identifies a 'LinkedComponent'. Corresponds to
-- 'cc_cid'.
lc_cid :: ComponentId, lc_cid :: ComponentId,
-- | Corresponds to 'cc_pkgid'.
lc_pkgid :: PackageId, lc_pkgid :: PackageId,
lc_insts :: [(ModuleName, OpenModule)], -- | Corresponds to 'cc_component'.
lc_component :: Component, lc_component :: Component,
lc_shape :: ModuleShape, -- | Local @build-tools@ dependencies on executables from the
-- | Local buildTools dependencies -- same executable. Corresponds to 'cc_internal_build_tools'.
lc_internal_build_tools :: [OpenUnitId], lc_internal_build_tools :: [OpenUnitId],
-- | Is this the public library of a package? Corresponds to
-- 'cc_public'.
lc_public :: Bool, lc_public :: Bool,
lc_includes :: [(OpenUnitId, ModuleRenaming)], -- | Corresponds to 'cc_includes', but the 'ModuleRenaming' for
-- PackageId here is a bit dodgy, but its just for -- requirements (stored in 'IncludeRenaming') has been removed,
-- BC so it shouldn't matter. -- as it is reflected in 'OpenUnitId'.)
lc_depends :: [(OpenUnitId, PackageId)] lc_includes :: [ComponentInclude OpenUnitId ModuleRenaming],
-- | The module shape computed by mix-in linking. This is
-- newly computed from 'ConfiguredComponent'
lc_shape :: ModuleShape
} }
-- | The 'OpenUnitId' of this component in the "default" instantiation.
-- See also 'lc_insts'. 'LinkedComponent's cannot be instantiated
-- (e.g., there is no 'ModSubst' instance for them).
lc_uid :: LinkedComponent -> OpenUnitId
lc_uid lc = IndefFullUnitId (lc_cid lc) . Map.fromList $ lc_insts lc
-- | The instantiation of 'lc_uid'; this always has the invariant
-- that it is a mapping from a module name @A@ to @<A>@ (the hole A).
lc_insts :: LinkedComponent -> [(ModuleName, OpenModule)]
lc_insts lc = [ (req, OpenModuleVar req)
| req <- Set.toList (modShapeRequires (lc_shape lc)) ]
dispLinkedComponent :: LinkedComponent -> Doc dispLinkedComponent :: LinkedComponent -> Doc
dispLinkedComponent lc = dispLinkedComponent lc =
hang (text "unit" <+> disp (lc_uid lc)) 4 $ hang (text "unit" <+> disp (lc_uid lc)) 4 $
vcat [ text "include" <+> disp uid <+> disp prov_rn vcat [ text "include" <+> disp (ci_id incl) <+> disp (ci_renaming incl)
| (uid, prov_rn) <- lc_includes lc ] | incl <- lc_includes lc ]
-- YARRR $+$ dispModSubst (modShapeProvides (lc_shape lc)) $+$ dispOpenModuleSubst (modShapeProvides (lc_shape lc))
instance Package LinkedComponent where instance Package LinkedComponent where
packageId = lc_pkgid packageId = lc_pkgid
instance ModSubst LinkedComponent where
modSubst subst lc
= lc {
lc_uid = modSubst subst (lc_uid lc),
lc_insts = modSubst subst (lc_insts lc),
lc_shape = modSubst subst (lc_shape lc),
lc_includes = map (\(uid, rns) -> (modSubst subst uid, rns)) (lc_includes lc),
lc_depends = map (\(uid, pkgid) -> (modSubst subst uid, pkgid)) (lc_depends lc)
}
{-
instance IsNode LinkedComponent where
type Key LinkedComponent = UnitId
nodeKey = lc_uid
nodeNeighbors n =
if Set.null (openUnitIdFreeHoles (lc_uid n))
then map fst (lc_depends n)
else ordNub (map (generalizeUnitId . fst) (lc_depends n))
-}
-- We can't cache these values because they need to be changed
-- when we substitute over a 'LinkedComponent'. By varying
-- these over 'UnitId', we can support old GHCs. Nice!
toLinkedComponent toLinkedComponent
:: Verbosity :: Verbosity
-> FullDb -> FullDb
...@@ -125,9 +125,9 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent { ...@@ -125,9 +125,9 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
-- Take each included ComponentId and resolve it into an -- Take each included ComponentId and resolve it into an
-- *unlinked* unit identity. We will use unification (relying -- *unlinked* unit identity. We will use unification (relying
-- on the ModuleShape) to resolve these into linked identities. -- on the ModuleShape) to resolve these into linked identities.
unlinked_includes :: [((OpenUnitId, ModuleShape), PackageId, IncludeRenaming)] unlinked_includes :: [ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming]
unlinked_includes = [ (lookupUid cid, pid, rns) unlinked_includes = [ ComponentInclude (lookupUid cid) pid rns
| (cid, pid, rns) <- cid_includes ] | ComponentInclude cid pid rns <- cid_includes ]
lookupUid :: ComponentId -> (OpenUnitId, ModuleShape) lookupUid :: ComponentId -> (OpenUnitId, ModuleShape)
lookupUid cid = fromMaybe (error "linkComponent: lookupUid") lookupUid cid = fromMaybe (error "linkComponent: lookupUid")
...@@ -140,8 +140,8 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent { ...@@ -140,8 +140,8 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
-- TODO: the unification monad might return errors, in which -- TODO: the unification monad might return errors, in which
-- case we have to deal. Use monadic bind for now. -- case we have to deal. Use monadic bind for now.
(linked_shape0 :: ModuleScope, (linked_shape0 :: ModuleScope,
linked_deps :: [(OpenUnitId, PackageId)], linked_includes :: [ComponentInclude OpenUnitId ModuleRenaming])
linked_includes :: [(OpenUnitId, ModuleRenaming)]) <- orErr $ runUnifyM verbosity db $ do <- orErr $ runUnifyM verbosity db $ do
-- The unification monad is implemented using mutable -- The unification monad is implemented using mutable
-- references. Thus, we must convert our *pure* data -- references. Thus, we must convert our *pure* data
-- structures into mutable ones to perform unification. -- structures into mutable ones to perform unification.
...@@ -159,13 +159,16 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent { ...@@ -159,13 +159,16 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
shape_u <- foldM mixLink emptyModuleScopeU (shapes_u ++ src_reqs_u) shape_u <- foldM mixLink emptyModuleScopeU (shapes_u ++ src_reqs_u)
-- Read out all the final results by converting back -- Read out all the final results by converting back
-- into a pure representation. -- into a pure representation.
let convertIncludeU (uid_u, pid, rns) = do let convertIncludeU (ComponentInclude uid_u pid rns) = do
uid <- convertUnitIdU uid_u uid <- convertUnitIdU uid_u
return ((uid, rns), (uid, pid)) return (ComponentInclude {
ci_id = uid,
ci_pkgid = pid,
ci_renaming = rns
})
shape <- convertModuleScopeU shape_u shape <- convertModuleScopeU shape_u
includes_deps <- mapM convertIncludeU includes_u incls <- mapM convertIncludeU includes_u
let (incls, deps) = unzip includes_deps return (shape, incls)
return (shape, deps, incls)
-- linked_shape0 is almost complete, but it doesn't contain -- linked_shape0 is almost complete, but it doesn't contain
-- the actual modules we export ourselves. Add them! -- the actual modules we export ourselves. Add them!
...@@ -242,17 +245,14 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent { ...@@ -242,17 +245,14 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
let final_linked_shape = ModuleShape provs (modScopeRequires linked_shape) let final_linked_shape = ModuleShape provs (modScopeRequires linked_shape)
return $ LinkedComponent { return $ LinkedComponent {
lc_uid = this_uid,
lc_cid = this_cid, lc_cid = this_cid,
lc_insts = insts,
lc_pkgid = pkgid, lc_pkgid = pkgid,
lc_component = component, lc_component = component,
lc_public = is_public, lc_public = is_public,
-- These must be executables -- These must be executables
lc_internal_build_tools = map (\cid -> IndefFullUnitId cid Map.empty) btools, lc_internal_build_tools = map (\cid -> IndefFullUnitId cid Map.empty) btools,
lc_shape = final_linked_shape, lc_shape = final_linked_shape,
lc_includes = linked_includes, lc_includes = linked_includes
lc_depends = linked_deps
} }
-- Handle mix-in linking for components. In the absence of Backpack, -- Handle mix-in linking for components. In the absence of Backpack,
......
...@@ -7,6 +7,7 @@ module Distribution.Backpack.ReadyComponent ( ...@@ -7,6 +7,7 @@ module Distribution.Backpack.ReadyComponent (
IndefiniteComponent(..), IndefiniteComponent(..),
rc_compat_name, rc_compat_name,
rc_compat_key, rc_compat_key,
rc_depends,
dispReadyComponent, dispReadyComponent,
toReadyComponents, toReadyComponents,
) where ) where
...@@ -21,6 +22,7 @@ import Distribution.Backpack.ModuleShape ...@@ -21,6 +22,7 @@ import Distribution.Backpack.ModuleShape
import Distribution.Types.ModuleRenaming import Distribution.Types.ModuleRenaming
import Distribution.Types.Component import Distribution.Types.Component
import Distribution.Types.ComponentInclude
import Distribution.Compat.Graph (IsNode(..)) import Distribution.Compat.Graph (IsNode(..))
import Distribution.ModuleName import Distribution.ModuleName
...@@ -38,44 +40,87 @@ import qualified Data.Map as Map ...@@ -38,44 +40,87 @@ import qualified Data.Map as Map
import Distribution.Version import Distribution.Version
import Distribution.Text import Distribution.Text
-- | An instantiated component is simply a linked component which -- | A 'ReadyComponent' is one that we can actually generate build
-- may have a fully instantiated 'UnitId'. When we do mix-in linking, -- products for. We have a ready component for the typecheck-only
-- we only do each component in its most general form; instantiation -- products of every indefinite package, as well as a ready component
-- then takes all of the fully instantiated components and recursively -- for every way these packages can be fully instantiated.
-- discovers what other instantiated components we need to build
-- before we can build them.
-- --
data ReadyComponent
= ReadyComponent {
-- | The final, string 'UnitId' that will uniquely identify
-- the compilation products of this component.
rc_uid :: UnitId,
-- | The 'OpenUnitId' for this package. At the moment, this
-- is used in only one case, which is to determine if an
-- export is of a module from this library (indefinite
-- libraries record these exports as 'OpenModule');
-- 'rc_open_uid' can be conveniently used to test for
-- equality, whereas 'UnitId' cannot always be used in this
-- case.
rc_open_uid :: OpenUnitId,
-- | Corresponds to 'lc_cid'. Invariant: if 'rc_open_uid'
-- records a 'ComponentId', it coincides with this one.
rc_cid :: ComponentId,
-- | Corresponds to 'lc_pkgid'.
rc_pkgid :: PackageId,
-- | Corresponds to 'lc_component'.
rc_component :: Component,
-- | Corresponds to 'lc_internal_build_tools'.
-- Build-tools don't participate in mix-in linking.
-- (but what if they could?)
rc_internal_build_tools :: [DefUnitId],
-- | Corresponds to 'lc_public'.
rc_public :: Bool,
-- | Extra metadata depending on whether or not this is an
-- indefinite library (typechecked only) or an instantiated
-- component (can be compiled).
rc_i :: Either IndefiniteComponent InstantiatedComponent
}
-- | An 'InstantiatedComponent' is a library which is fully instantiated
-- (or, possibly, has no requirements at all.)
data InstantiatedComponent data InstantiatedComponent
= InstantiatedComponent { = InstantiatedComponent {
-- | How this library was instantiated.
instc_insts :: [(ModuleName, Module)], instc_insts :: [(ModuleName, Module)],
-- | Dependencies induced by 'instc_insts'. These are recorded
-- here because there isn't a convenient way otherwise to get
-- the 'PackageId' we need to fill 'componentPackageDeps' as needed.
instc_insts_deps :: [(UnitId, PackageId)],
-- | The modules exported/reexported by this library.
instc_provides :: Map ModuleName Module, instc_provides :: Map ModuleName Module,
instc_includes :: [(DefUnitId, ModuleRenaming)] -- | The dependencies which need to be passed to the compiler
-- to bring modules into scope. These always refer to installed
-- fully instantiated libraries.
instc_includes :: [ComponentInclude DefUnitId ModuleRenaming]
} }
-- | An 'IndefiniteComponent' is a library with requirements
-- which we will typecheck only.
data IndefiniteComponent data IndefiniteComponent
= IndefiniteComponent { = IndefiniteComponent {
-- | The requirements of the library.
indefc_requires :: [ModuleName], indefc_requires :: [ModuleName],
-- | The modules exported/reexported by this library.
indefc_provides :: Map ModuleName OpenModule, indefc_provides :: Map ModuleName OpenModule,
indefc_includes :: [(OpenUnitId, ModuleRenaming)] -- | The dependencies which need to be passed to the compiler
-- to bring modules into scope. These are 'OpenUnitId' because
-- these may refer to partially instantiated libraries.
indefc_includes :: [ComponentInclude OpenUnitId ModuleRenaming]
} }
data ReadyComponent -- | Compute the dependencies of a 'ReadyComponent' that should
= ReadyComponent { -- be recorded in the @depends@ field of 'InstalledPackageInfo'.
rc_uid :: UnitId, rc_depends :: ReadyComponent -> [(UnitId, PackageId)]
rc_open_uid :: OpenUnitId, rc_depends rc = ordNub $
rc_cid :: ComponentId, case rc_i rc of
rc_pkgid :: PackageId, Left indefc ->
rc_component :: Component, map (\ci -> (abstractUnitId (ci_id ci), ci_pkgid ci))
-- build-tools don't participate in mix-in linking. (indefc_includes indefc)
-- (but what if they cold?) Right instc ->
rc_internal_build_tools :: [DefUnitId], map (\ci -> (unDefUnitId (ci_id ci), ci_pkgid ci))
rc_public :: Bool, (instc_includes instc)
-- PackageId here is a bit dodgy, but its just for ++ instc_insts_deps instc
-- BC so it shouldn't matter.
rc_depends :: [(UnitId, PackageId)],
rc_i :: Either IndefiniteComponent InstantiatedComponent
}
instance Package ReadyComponent where instance Package ReadyComponent where
packageId = rc_pkgid packageId = rc_pkgid
...@@ -194,13 +239,10 @@ toReadyComponents pid_map subst0 comps ...@@ -194,13 +239,10 @@ toReadyComponents pid_map subst0 comps
-> InstM (Maybe ReadyComponent) -> InstM (Maybe ReadyComponent)
instantiateComponent uid cid insts instantiateComponent uid cid insts
| Just lc <- Map.lookup cid cmap = do | Just lc <- Map.lookup cid cmap = do
deps <- forM (lc_depends lc) $ \(x, y) -> do
x' <- substUnitId insts x
return (x', y)
provides <- T.mapM (substModule insts) (modShapeProvides (lc_shape lc)) provides <- T.mapM (substModule insts) (modShapeProvides (lc_shape lc))
includes <- forM (lc_includes lc) $ \(x, y) -> do includes <- forM (lc_includes lc) $ \ci -> do
x' <- substUnitId insts x uid' <- substUnitId insts (ci_id ci)
return (x', y) return ci { ci_id = uid' }
build_tools <- mapM (substUnitId insts) (lc_internal_build_tools lc) build_tools <- mapM (substUnitId insts) (lc_internal_build_tools lc)
s <- InstM $ \s -> (s, s) s <- InstM $ \s -> (s, s)
let getDep (Module dep_def_uid _) let getDep (Module dep_def_uid _)
...@@ -217,8 +259,16 @@ toReadyComponents pid_map subst0 comps ...@@ -217,8 +259,16 @@ toReadyComponents pid_map subst0 comps
(mkVersion [0]) (mkVersion [0])
instc = InstantiatedComponent { instc = InstantiatedComponent {
instc_insts = Map.toList insts, instc_insts = Map.toList insts,
instc_insts_deps = concatMap getDep (Map.elems insts),
instc_provides = provides, instc_provides = provides,
instc_includes = includes instc_includes = includes
-- NB: there is no dependency on the
-- indefinite version of this instantiated package here,
-- as (1) it doesn't go in depends in the
-- IPI: it's not a run time dep, and (2)
-- we don't have to tell GHC about it, it
-- will match up the ComponentId
-- automatically
} }
return $ Just ReadyComponent { return $ Just ReadyComponent {
rc_uid = uid, rc_uid = uid,
...@@ -228,12 +278,6 @@ toReadyComponents pid_map subst0 comps ...@@ -228,12 +278,6 @@ toReadyComponents pid_map subst0 comps
rc_component = lc_component lc, rc_component = lc_component lc,
rc_internal_build_tools = build_tools,