Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
62ddf8e0
Commit
62ddf8e0
authored
Oct 02, 2016
by
Edward Z. Yang
Browse files
Rename IndefUnitId to OpenUnitId.
Signed-off-by:
Edward Z. Yang
<
ezyang@cs.stanford.edu
>
parent
42364776
Changes
16
Hide whitespace changes
Inline
Side-by-side
Cabal/Distribution/Backpack.hs
View file @
62ddf8e0
...
...
@@ -10,10 +10,10 @@
-- <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
module
Distribution.Backpack
(
-- *
Indef
UnitId
Indef
UnitId
(
..
),
indef
UnitIdComponentId
,
indef
UnitIdFreeHoles
,
-- *
Open
UnitId
Open
UnitId
(
..
),
open
UnitIdComponentId
,
open
UnitIdFreeHoles
,
-- * IndefModule
IndefModule
(
..
),
...
...
@@ -49,33 +49,33 @@ import Data.Set (Set)
import
qualified
Data.Set
as
Set
-----------------------------------------------------------------------
--
Indef
UnitId
--
Open
UnitId
-- | An '
Indef
UnitId' describes a (possibly partially) instantiated
-- | An '
Open
UnitId' describes a (possibly partially) instantiated
-- Backpack component, with a description of how the holes are filled
-- in. Unlike '
Indef
UnitId', the 'ModuleSubst' is kept in a structured
-- in. Unlike '
Open
UnitId', the 'ModuleSubst' is kept in a structured
-- form that allows for substitution (which fills in holes.) This form
-- of unit cannot be installed. It must first be converted to a
-- 'UnitId'.
--
-- In the absence of Backpack, there are no holes to fill, so any such
-- component always has an empty module substitution; thus we can lossly
-- represent it as an '
Indef
UnitId uid'.
-- represent it as an '
Open
UnitId uid'.
--
-- For a source component using Backpack, however, there is more
-- structure as components may be parametrized over some signatures, and
-- these \"holes\" may be partially or wholly filled.
--
--
Indef
UnitId plays an important role when we are mix-in linking,
--
Open
UnitId plays an important role when we are mix-in linking,
-- and is recorded to the installed packaged database for indefinite
-- packages; however, for compiled packages that are fully instantiated,
-- we instantiate '
Indef
UnitId' into 'UnitId'.
-- we instantiate '
Open
UnitId' into 'UnitId'.
--
-- For more details see the Backpack spec
-- <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
--
data
Indef
UnitId
data
Open
UnitId
-- | Identifies a component which may have some unfilled holes;
-- specifying its 'ComponentId' and its 'IndefModuleSubst'.
-- TODO: Invariant that 'IndefModuleSubst' is non-empty?
...
...
@@ -83,42 +83,42 @@ data IndefUnitId
=
IndefFullUnitId
ComponentId
IndefModuleSubst
-- | Identifies a fully instantiated component, which has
-- been compiled and abbreviated as a hash. The embedded 'UnitId'
-- MUST NOT be for an indefinite component; an '
Indef
UnitId'
-- MUST NOT be for an indefinite component; an '
Open
UnitId'
-- is guaranteed not to have any holes.
|
DefiniteUnitId
UnitId
deriving
(
Generic
,
Read
,
Show
,
Eq
,
Ord
,
Typeable
,
Data
)
-- TODO: cache holes?
instance
Binary
Indef
UnitId
instance
Binary
Open
UnitId
instance
NFData
Indef
UnitId
where
instance
NFData
Open
UnitId
where
rnf
(
IndefFullUnitId
cid
subst
)
=
rnf
cid
`
seq
`
rnf
subst
rnf
(
DefiniteUnitId
uid
)
=
rnf
uid
instance
Text
Indef
UnitId
where
instance
Text
Open
UnitId
where
disp
(
IndefFullUnitId
cid
insts
)
-- TODO: arguably a smart constructor to enforce invariant would be
-- better
|
Map
.
null
insts
=
disp
cid
|
otherwise
=
disp
cid
<<>>
Disp
.
brackets
(
dispIndefModuleSubst
insts
)
disp
(
DefiniteUnitId
uid
)
=
disp
uid
parse
=
parse
Indef
UnitId
<++
fmap
DefiniteUnitId
parse
parse
=
parse
Open
UnitId
<++
fmap
DefiniteUnitId
parse
where
parse
Indef
UnitId
=
do
parse
Open
UnitId
=
do
cid
<-
parse
insts
<-
Parse
.
between
(
Parse
.
char
'['
)
(
Parse
.
char
']'
)
parseIndefModuleSubst
return
(
IndefFullUnitId
cid
insts
)
-- | Get the 'ComponentId' of an '
Indef
UnitId'.
indef
UnitIdComponentId
::
Indef
UnitId
->
ComponentId
indef
UnitIdComponentId
(
IndefFullUnitId
cid
_
)
=
cid
indef
UnitIdComponentId
(
DefiniteUnitId
uid
)
=
unitIdComponentId
uid
-- | Get the 'ComponentId' of an '
Open
UnitId'.
open
UnitIdComponentId
::
Open
UnitId
->
ComponentId
open
UnitIdComponentId
(
IndefFullUnitId
cid
_
)
=
cid
open
UnitIdComponentId
(
DefiniteUnitId
uid
)
=
unitIdComponentId
uid
-- | Get the set of holes ('ModuleVar') embedded in a 'UnitId'.
indef
UnitIdFreeHoles
::
Indef
UnitId
->
Set
ModuleName
indef
UnitIdFreeHoles
(
IndefFullUnitId
_
insts
)
=
indefModuleSubstFreeHoles
insts
indef
UnitIdFreeHoles
_
=
Set
.
empty
open
UnitIdFreeHoles
::
Open
UnitId
->
Set
ModuleName
open
UnitIdFreeHoles
(
IndefFullUnitId
_
insts
)
=
indefModuleSubstFreeHoles
insts
open
UnitIdFreeHoles
_
=
Set
.
empty
-----------------------------------------------------------------------
-- IndefModule
...
...
@@ -128,7 +128,7 @@ indefUnitIdFreeHoles _ = Set.empty
-- hole that needs to be filled in. Substitutions are over
-- module variables.
data
IndefModule
=
IndefModule
Indef
UnitId
ModuleName
=
IndefModule
Open
UnitId
ModuleName
|
IndefModuleVar
ModuleName
deriving
(
Generic
,
Read
,
Show
,
Eq
,
Ord
,
Typeable
,
Data
)
...
...
@@ -159,7 +159,7 @@ instance Text IndefModule where
-- | Get the set of holes ('ModuleVar') embedded in a 'Module'.
indefModuleFreeHoles
::
IndefModule
->
Set
ModuleName
indefModuleFreeHoles
(
IndefModuleVar
mod_name
)
=
Set
.
singleton
mod_name
indefModuleFreeHoles
(
IndefModule
uid
_n
)
=
indef
UnitIdFreeHoles
uid
indefModuleFreeHoles
(
IndefModule
uid
_n
)
=
open
UnitIdFreeHoles
uid
-----------------------------------------------------------------------
-- IndefModuleSubst
...
...
@@ -171,7 +171,7 @@ indefModuleFreeHoles (IndefModule uid _n) = indefUnitIdFreeHoles uid
type
IndefModuleSubst
=
Map
ModuleName
IndefModule
-- | Pretty-print the entries of a module substitution, suitable
-- for embedding into a '
Indef
UnitId' or passing to GHC via @--instantiate-with@.
-- for embedding into a '
Open
UnitId' or passing to GHC via @--instantiate-with@.
dispIndefModuleSubst
::
IndefModuleSubst
->
Disp
.
Doc
dispIndefModuleSubst
subst
=
Disp
.
hcat
...
...
@@ -207,7 +207,7 @@ indefModuleSubstFreeHoles insts = Set.unions (map indefModuleFreeHoles (Map.elem
-- | When typechecking, we don't demand that a freshly instantiated
-- 'IndefFullUnitId' be compiled; instead, we just depend on the
-- installed indefinite unit installed at the 'ComponentId'.
abstractUnitId
::
Indef
UnitId
->
UnitId
abstractUnitId
::
Open
UnitId
->
UnitId
abstractUnitId
(
DefiniteUnitId
uid
)
=
uid
abstractUnitId
(
IndefFullUnitId
cid
_
)
=
newSimpleUnitId
cid
...
...
Cabal/Distribution/Backpack/Configure.hs
View file @
62ddf8e0
...
...
@@ -91,7 +91,7 @@ configureComponentLocalBuildInfos
(
vcat
(
map
dispConfiguredComponent
graph1
))
let
shape_pkg_map
=
Map
.
fromList
[
(
pc_cid
pkg
,
(
pc_
indef
_uid
pkg
,
pc_shape
pkg
))
[
(
pc_cid
pkg
,
(
pc_
open
_uid
pkg
,
pc_shape
pkg
))
|
pkg
<-
prePkgDeps
]
uid_lookup
uid
|
Just
pkg
<-
PackageIndex
.
lookupUnitId
installedPackageSet
uid
...
...
@@ -253,7 +253,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
-- 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.)
|
indef
UnitIdComponentId
uid
==
this_cid
|
open
UnitIdComponentId
uid
==
this_cid
,
modname'
==
modname
=
Installed
.
ExposedModule
modname'
Nothing
|
otherwise
...
...
Cabal/Distribution/Backpack/FullUnitId.hs
View file @
62ddf8e0
...
...
@@ -2,7 +2,7 @@
module
Distribution.Backpack.FullUnitId
(
FullUnitId
(
..
),
FullDb
,
expand
Indef
UnitId
,
expand
Open
UnitId
,
expandUnitId
)
where
...
...
@@ -10,16 +10,16 @@ import Distribution.Backpack
import
Distribution.Package
import
Distribution.Compat.Prelude
-- Unlike
Indef
UnitId, which could direct to a UnitId.
-- Unlike
Open
UnitId, which could direct to a UnitId.
data
FullUnitId
=
FullUnitId
ComponentId
IndefModuleSubst
deriving
(
Show
,
Generic
)
type
FullDb
=
UnitId
->
FullUnitId
expand
Indef
UnitId
::
FullDb
->
Indef
UnitId
->
FullUnitId
expand
Indef
UnitId
_db
(
IndefFullUnitId
cid
subst
)
expand
Open
UnitId
::
FullDb
->
Open
UnitId
->
FullUnitId
expand
Open
UnitId
_db
(
IndefFullUnitId
cid
subst
)
=
FullUnitId
cid
subst
expand
Indef
UnitId
db
(
DefiniteUnitId
uid
)
expand
Open
UnitId
db
(
DefiniteUnitId
uid
)
=
expandUnitId
db
uid
expandUnitId
::
FullDb
->
UnitId
->
FullUnitId
...
...
Cabal/Distribution/Backpack/LinkedComponent.hs
View file @
62ddf8e0
...
...
@@ -46,22 +46,22 @@ import Text.PrettyPrint
-- going to build it.
data
LinkedComponent
=
LinkedComponent
{
lc_uid
::
Indef
UnitId
,
lc_uid
::
Open
UnitId
,
lc_pkgid
::
PackageId
,
lc_insts
::
[(
ModuleName
,
IndefModule
)],
lc_component
::
Component
,
lc_shape
::
ModuleShape
,
-- | Local buildTools dependencies
lc_internal_build_tools
::
[
Indef
UnitId
],
lc_internal_build_tools
::
[
Open
UnitId
],
lc_public
::
Bool
,
lc_includes
::
[(
Indef
UnitId
,
ModuleRenaming
)],
lc_includes
::
[(
Open
UnitId
,
ModuleRenaming
)],
-- PackageId here is a bit dodgy, but its just for
-- BC so it shouldn't matter.
lc_depends
::
[(
Indef
UnitId
,
PackageId
)]
lc_depends
::
[(
Open
UnitId
,
PackageId
)]
}
lc_cid
::
LinkedComponent
->
ComponentId
lc_cid
=
indef
UnitIdComponentId
.
lc_uid
lc_cid
=
open
UnitIdComponentId
.
lc_uid
dispLinkedComponent
::
LinkedComponent
->
Doc
dispLinkedComponent
lc
=
...
...
@@ -88,7 +88,7 @@ instance IsNode LinkedComponent where
type Key LinkedComponent = UnitId
nodeKey = lc_uid
nodeNeighbors n =
if Set.null (
indef
UnitIdFreeHoles (lc_uid n))
if Set.null (
open
UnitIdFreeHoles (lc_uid n))
then map fst (lc_depends n)
else ordNub (map (generalizeUnitId . fst) (lc_depends n))
-}
...
...
@@ -128,11 +128,11 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
-- Take each included ComponentId and resolve it into an
-- *unlinked* unit identity. We will use unification (relying
-- on the ModuleShape) to resolve these into linked identities.
unlinked_includes
::
[((
Indef
UnitId
,
ModuleShape
),
PackageId
,
IncludeRenaming
)]
unlinked_includes
::
[((
Open
UnitId
,
ModuleShape
),
PackageId
,
IncludeRenaming
)]
unlinked_includes
=
[
(
lookupUid
cid
,
pid
,
rns
)
|
(
cid
,
pid
,
rns
)
<-
cid_includes
]
lookupUid
::
ComponentId
->
(
Indef
UnitId
,
ModuleShape
)
lookupUid
::
ComponentId
->
(
Open
UnitId
,
ModuleShape
)
lookupUid
cid
=
fromMaybe
(
error
"linkComponent: lookupUid"
)
(
Map
.
lookup
cid
pkg_map
)
...
...
@@ -143,8 +143,8 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
-- TODO: the unification monad might return errors, in which
-- case we have to deal. Use monadic bind for now.
(
linked_shape0
::
ModuleScope
,
linked_deps
::
[(
Indef
UnitId
,
PackageId
)],
linked_includes
::
[(
Indef
UnitId
,
ModuleRenaming
)])
<-
orErr
$
runUnifyM
verbosity
db
$
do
linked_deps
::
[(
Open
UnitId
,
PackageId
)],
linked_includes
::
[(
Open
UnitId
,
ModuleRenaming
)])
<-
orErr
$
runUnifyM
verbosity
db
$
do
-- The unification monad is implemented using mutable
-- references. Thus, we must convert our *pure* data
-- structures into mutable ones to perform unification.
...
...
@@ -261,14 +261,14 @@ toLinkedComponents
toLinkedComponents
verbosity
db
this_pid
lc_map0
comps
=
fmap
snd
(
mapAccumM
go
lc_map0
comps
)
where
go
::
Map
ComponentId
(
Indef
UnitId
,
ModuleShape
)
go
::
Map
ComponentId
(
Open
UnitId
,
ModuleShape
)
->
ConfiguredComponent
->
LogProgress
(
Map
ComponentId
(
Indef
UnitId
,
ModuleShape
),
LinkedComponent
)
->
LogProgress
(
Map
ComponentId
(
Open
UnitId
,
ModuleShape
),
LinkedComponent
)
go
lc_map
cc
=
do
lc
<-
toLinkedComponent
verbosity
db
this_pid
lc_map
cc
return
(
extendLinkedComponentMap
lc
lc_map
,
lc
)
type
LinkedComponentMap
=
Map
ComponentId
(
Indef
UnitId
,
ModuleShape
)
type
LinkedComponentMap
=
Map
ComponentId
(
Open
UnitId
,
ModuleShape
)
extendLinkedComponentMap
::
LinkedComponent
->
LinkedComponentMap
...
...
Cabal/Distribution/Backpack/ModSubst.hs
View file @
62ddf8e0
...
...
@@ -35,7 +35,7 @@ instance ModSubst IndefModule where
|
Just
mod'
<-
Map
.
lookup
mod_name
subst
=
mod'
|
otherwise
=
mod
instance
ModSubst
Indef
UnitId
where
instance
ModSubst
Open
UnitId
where
modSubst
subst
(
IndefFullUnitId
cid
insts
)
=
IndefFullUnitId
cid
(
modSubst
subst
insts
)
modSubst
_subst
uid
=
uid
...
...
Cabal/Distribution/Backpack/ModuleShape.hs
View file @
62ddf8e0
...
...
@@ -74,7 +74,7 @@ emptyModuleShape = ModuleShape Map.empty Set.empty
shapeInstalledPackage
::
IPI
.
InstalledPackageInfo
->
ModuleShape
shapeInstalledPackage
ipi
=
ModuleShape
(
Map
.
fromList
provs
)
reqs
where
uid
=
installed
Indef
UnitId
ipi
uid
=
installed
Open
UnitId
ipi
provs
=
map
shapeExposedModule
(
IPI
.
exposedModules
ipi
)
reqs
=
requiredSignatures
ipi
shapeExposedModule
(
IPI
.
ExposedModule
mod_name
Nothing
)
...
...
Cabal/Distribution/Backpack/PreExistingComponent.hs
View file @
62ddf8e0
...
...
@@ -27,7 +27,7 @@ data PreExistingComponent
pc_pkgname
::
PackageName
,
pc_pkgid
::
PackageId
,
pc_uid
::
UnitId
,
pc_
indef
_uid
::
Indef
UnitId
,
pc_
open
_uid
::
Open
UnitId
,
pc_shape
::
ModuleShape
}
...
...
@@ -44,7 +44,7 @@ ipiToPreExistingComponent (pn, ipi) =
pc_pkgname
=
pn
,
pc_pkgid
=
Installed
.
sourcePackageId
ipi
,
pc_uid
=
Installed
.
installedUnitId
ipi
,
pc_
indef
_uid
=
pc_
open
_uid
=
IndefFullUnitId
(
Installed
.
installedComponentId
ipi
)
(
Map
.
fromList
(
Installed
.
instantiatedWith
ipi
)),
pc_shape
=
shapeInstalledPackage
ipi
...
...
Cabal/Distribution/Backpack/ReadyComponent.hs
View file @
62ddf8e0
...
...
@@ -56,7 +56,7 @@ data IndefiniteComponent
=
IndefiniteComponent
{
indefc_requires
::
[
ModuleName
],
indefc_provides
::
Map
ModuleName
IndefModule
,
indefc_includes
::
[(
Indef
UnitId
,
ModuleRenaming
)]
indefc_includes
::
[(
Open
UnitId
,
ModuleRenaming
)]
}
data
ReadyComponent
...
...
@@ -221,7 +221,7 @@ toReadyComponents pid_map subst0 comps
}
|
otherwise
=
return
Nothing
substUnitId
::
Map
ModuleName
Module
->
Indef
UnitId
->
InstM
UnitId
substUnitId
::
Map
ModuleName
Module
->
Open
UnitId
->
InstM
UnitId
substUnitId
_
(
DefiniteUnitId
uid
)
=
return
uid
substUnitId
subst
(
IndefFullUnitId
cid
insts
)
=
do
...
...
Cabal/Distribution/Backpack/UnifyM.hs
View file @
62ddf8e0
...
...
@@ -233,7 +233,7 @@ emptyMuEnv = (IntMap.empty, -1)
-- * @MuEnv@ - the environment for mu-binders.
convertUnitId'
::
MuEnv
s
->
Indef
UnitId
->
Open
UnitId
->
UnifyM
s
(
UnitIdU
s
)
-- TODO: this could be more lazy if we know there are no internal
-- references
...
...
@@ -264,7 +264,7 @@ convertModule' stk (IndefModule uid mod_name) = do
uid_u
<-
convertUnitId'
stk
uid
liftST
$
UnionFind
.
fresh
(
ModuleU
uid_u
mod_name
)
convertUnitId
::
Indef
UnitId
->
UnifyM
s
(
UnitIdU
s
)
convertUnitId
::
Open
UnitId
->
UnifyM
s
(
UnitIdU
s
)
convertUnitId
=
convertUnitId'
emptyMuEnv
convertModule
::
IndefModule
->
UnifyM
s
(
ModuleU
s
)
...
...
@@ -310,7 +310,7 @@ lookupMooEnv (m, i) k =
-- The workhorse functions
convertUnitIdU'
::
MooEnv
->
UnitIdU
s
->
UnifyM
s
Indef
UnitId
convertUnitIdU'
::
MooEnv
->
UnitIdU
s
->
UnifyM
s
Open
UnitId
convertUnitIdU'
stk
uid_u
=
do
x
<-
liftST
$
UnionFind
.
find
uid_u
case
x
of
...
...
@@ -333,7 +333,7 @@ convertModuleU' stk mod_u = do
-- Helper functions
convertUnitIdU
::
UnitIdU
s
->
UnifyM
s
Indef
UnitId
convertUnitIdU
::
UnitIdU
s
->
UnifyM
s
Open
UnitId
convertUnitIdU
=
convertUnitIdU'
emptyMooEnv
convertModuleU
::
ModuleU
s
->
UnifyM
s
IndefModule
...
...
@@ -361,7 +361,7 @@ data ModuleSourceU s =
-- | Convert a 'ModuleShape' into a 'ModuleScopeU', so we can do
-- unification on it.
convertInclude
::
((
Indef
UnitId
,
ModuleShape
),
PackageId
,
IncludeRenaming
)
::
((
Open
UnitId
,
ModuleShape
),
PackageId
,
IncludeRenaming
)
->
UnifyM
s
(
ModuleScopeU
s
,
(
UnitIdU
s
,
PackageId
,
ModuleRenaming
))
convertInclude
((
uid
,
ModuleShape
provs
reqs
),
pid
,
incl
@
(
IncludeRenaming
prov_rns
req_rns
))
=
do
let
pn
=
packageName
pid
...
...
Cabal/Distribution/InstalledPackageInfo.hs
View file @
62ddf8e0
...
...
@@ -33,7 +33,7 @@ module Distribution.InstalledPackageInfo (
installedPackageId
,
indefinite
,
requiredSignatures
,
installed
Indef
UnitId
,
installed
Open
UnitId
,
ExposedModule
(
..
),
ParseResult
(
..
),
PError
(
..
),
PWarning
,
emptyInstalledPackageInfo
,
...
...
@@ -75,7 +75,7 @@ data InstalledPackageInfo
sourcePackageId
::
PackageId
,
installedUnitId
::
UnitId
,
-- INVARIANT: if this package is definite, IndefModule's
--
Indef
UnitId directly records UnitId. If it is
--
Open
UnitId directly records UnitId. If it is
-- indefinite, IndefModule is always an IndefModuleVar
-- with the same ModuleName as the key.
instantiatedWith
::
[(
ModuleName
,
IndefModule
)],
...
...
@@ -94,7 +94,7 @@ data InstalledPackageInfo
abiHash
::
AbiHash
,
exposed
::
Bool
,
-- INVARIANT: if the package is definite, IndefModule's
--
Indef
UnitId directly records UnitId.
--
Open
UnitId directly records UnitId.
exposedModules
::
[
ExposedModule
],
hiddenModules
::
[
ModuleName
],
trusted
::
Bool
,
...
...
@@ -130,9 +130,9 @@ indefinite ipi =
-- This IS NOT guaranteed to give you a substitution; for
-- instantiated packages you will get @DefiniteUnitId (installedUnitId ipi)@.
-- For indefinite libraries, however, you will correctly get
-- an @IndefUnitId@ with the appropriate 'IndefModuleSubst'.
installedIndefUnitId
::
InstalledPackageInfo
->
IndefUnitId
-- an @OpenUnitId@ with the appropriate 'IndefModuleSubst'.
installedOpenUnitId
::
InstalledPackageInfo
->
OpenUnitId
installedOpenUnitId
ipi
=
if
indefinite
ipi
then
IndefFullUnitId
(
installedComponentId
ipi
)
(
Map
.
fromList
(
instantiatedWith
ipi
))
...
...
Cabal/Distribution/Package.hs
View file @
62ddf8e0
...
...
@@ -236,12 +236,12 @@ getHSLibraryName uid = "HS" ++ display uid
-- holes, and each different combination is a unit (and has a separate
-- 'UnitId').
--
-- 'UnitId' is distinct from '
Indef
UnitId', in that it is always
-- installed, whereas '
Indef
UnitId' are intermediate unit identities
-- 'UnitId' is distinct from '
Open
UnitId', in that it is always
-- installed, whereas '
Open
UnitId' are intermediate unit identities
-- that arise during mixin linking, and don't necessarily correspond
-- to any actually installed unit. Since the mapping is not actually
-- recorded in a 'UnitId', you can't actually substitute over them
-- (but you can substitute over '
Indef
UnitId'). See also
-- (but you can substitute over '
Open
UnitId'). See also
-- "Distribution.Backpack.FullUnitId" for a mechanism for expanding an
-- instantiated 'UnitId' to retrieve its mapping.
--
...
...
Cabal/Distribution/Simple/GHC/Internal.hs
View file @
62ddf8e0
...
...
@@ -381,7 +381,7 @@ getHaskellObjects _implInfo lib lbi clbi pref wanted_obj_ext allow_split_objs
|
x
<-
allLibModules
lib
clbi
]
mkGhcOptPackages
::
ComponentLocalBuildInfo
->
[(
Indef
UnitId
,
ModuleRenaming
)]
->
[(
Open
UnitId
,
ModuleRenaming
)]
mkGhcOptPackages
=
componentIncludes
substTopDir
::
FilePath
->
InstalledPackageInfo
->
InstalledPackageInfo
...
...
Cabal/Distribution/Simple/Program/GHC.hs
View file @
62ddf8e0
...
...
@@ -94,7 +94,7 @@ data GhcOptions = GhcOptions {
-- | The GHC packages to bring into scope when compiling,
-- the @ghc -package-id@ flags.
ghcOptPackages
::
NubListR
(
Indef
UnitId
,
ModuleRenaming
),
NubListR
(
Open
UnitId
,
ModuleRenaming
),
-- | Start with a clean package set; the @ghc -hide-all-packages@ flag
ghcOptHideAllPackages
::
Flag
Bool
,
...
...
Cabal/Distribution/Types/ComponentLocalBuildInfo.hs
View file @
62ddf8e0
...
...
@@ -46,7 +46,7 @@ data ComponentLocalBuildInfo
-- to hide or rename modules. This is what gets translated into
-- @-package-id@ arguments. This is a modernized version of
-- 'componentPackageDeps', which is kept around for BC purposes.
componentIncludes
::
[(
Indef
UnitId
,
ModuleRenaming
)],
componentIncludes
::
[(
Open
UnitId
,
ModuleRenaming
)],
componentExeDeps
::
[
UnitId
],
-- | The internal dependencies which induce a graph on the
-- 'ComponentLocalBuildInfo' of this package. This does NOT
...
...
@@ -69,7 +69,7 @@ data ComponentLocalBuildInfo
componentLocalName
::
ComponentName
,
componentUnitId
::
UnitId
,
componentPackageDeps
::
[(
UnitId
,
PackageId
)],
componentIncludes
::
[(
Indef
UnitId
,
ModuleRenaming
)],
componentIncludes
::
[(
Open
UnitId
,
ModuleRenaming
)],
componentExeDeps
::
[
UnitId
],
componentInternalDeps
::
[
UnitId
]
}
...
...
@@ -77,7 +77,7 @@ data ComponentLocalBuildInfo
componentLocalName
::
ComponentName
,
componentUnitId
::
UnitId
,
componentPackageDeps
::
[(
UnitId
,
PackageId
)],
componentIncludes
::
[(
Indef
UnitId
,
ModuleRenaming
)],
componentIncludes
::
[(
Open
UnitId
,
ModuleRenaming
)],
componentExeDeps
::
[
UnitId
],
componentInternalDeps
::
[
UnitId
]
...
...
@@ -86,7 +86,7 @@ data ComponentLocalBuildInfo
componentLocalName
::
ComponentName
,
componentUnitId
::
UnitId
,
componentPackageDeps
::
[(
UnitId
,
PackageId
)],
componentIncludes
::
[(
Indef
UnitId
,
ModuleRenaming
)],
componentIncludes
::
[(
Open
UnitId
,
ModuleRenaming
)],
componentExeDeps
::
[
UnitId
],
componentInternalDeps
::
[
UnitId
]
}
...
...
cabal-install/Distribution/Client/ProjectPlanning.hs
View file @
62ddf8e0
...
...
@@ -1262,7 +1262,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
(
packageName
dpkg
,
(
componentId
dpkg
,
packageId
dpkg
))
mkShapeMapping
::
ElaboratedPlanPackage
->
(
ComponentId
,
(
Indef
UnitId
,
ModuleShape
))
->
(
ComponentId
,
(
Open
UnitId
,
ModuleShape
))
mkShapeMapping
dpkg
=
(
componentId
dpkg
,
(
indef_uid
,
shape
))
where
...
...
@@ -1731,7 +1731,7 @@ instantiateInstallPlan plan =
_
->
return
planpkg
|
otherwise
=
error
(
"instantiateComponent: "
++
display
cid
)
substUnitId
::
Map
ModuleName
Module
->
Indef
UnitId
->
InstM
UnitId
substUnitId
::
Map
ModuleName
Module
->
Open
UnitId
->
InstM
UnitId
substUnitId
_
(
DefiniteUnitId
uid
)
=
return
uid
substUnitId
subst
(
IndefFullUnitId
cid
insts
)
=
do
...
...
cabal-install/Distribution/Client/ProjectPlanning/Types.hs
View file @
62ddf8e0
...
...
@@ -396,7 +396,7 @@ data ElaboratedComponent
-- care about from the perspective of ORDERING builds. It's more
-- precise than 'compLibDependencies', and also stores information
-- about internal dependencies.
compLinkedLibDependencies
::
[
Indef
UnitId
],
compLinkedLibDependencies
::
[
Open
UnitId
],
-- | The executable dependencies of this component (including
-- internal executables).
compExeDependencies
::
[
ComponentId
],
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment