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
fd893156
Commit
fd893156
authored
Oct 01, 2016
by
Edward Z. Yang
Browse files
Rename IndefUnitId constructor to DefiniteUnitId
Signed-off-by:
Edward Z. Yang
<
ezyang@cs.stanford.edu
>
parent
1be2b213
Changes
9
Hide whitespace changes
Inline
Side-by-side
Cabal/Distribution/Backpack.hs
View file @
fd893156
...
...
@@ -85,7 +85,7 @@ data IndefUnitId
-- been compiled and abbreviated as a hash. The embedded 'UnitId'
-- MUST NOT be for an indefinite component; an 'IndefUnitId'
-- is guaranteed not to have any holes.
|
Indef
UnitId
UnitId
|
Definite
UnitId
UnitId
deriving
(
Generic
,
Read
,
Show
,
Eq
,
Ord
,
Typeable
,
Data
)
-- TODO: cache holes?
...
...
@@ -93,7 +93,7 @@ instance Binary IndefUnitId
instance
NFData
IndefUnitId
where
rnf
(
IndefFullUnitId
cid
subst
)
=
rnf
cid
`
seq
`
rnf
subst
rnf
(
Indef
UnitId
uid
)
=
rnf
uid
rnf
(
Definite
UnitId
uid
)
=
rnf
uid
instance
Text
IndefUnitId
where
disp
(
IndefFullUnitId
cid
insts
)
...
...
@@ -101,8 +101,8 @@ instance Text IndefUnitId where
-- better
|
Map
.
null
insts
=
disp
cid
|
otherwise
=
disp
cid
<<>>
Disp
.
brackets
(
dispIndefModuleSubst
insts
)
disp
(
Indef
UnitId
uid
)
=
disp
uid
parse
=
parseIndefUnitId
<++
fmap
Indef
UnitId
parse
disp
(
Definite
UnitId
uid
)
=
disp
uid
parse
=
parseIndefUnitId
<++
fmap
Definite
UnitId
parse
where
parseIndefUnitId
=
do
cid
<-
parse
...
...
@@ -113,7 +113,7 @@ instance Text IndefUnitId where
-- | Get the 'ComponentId' of an 'IndefUnitId'.
indefUnitIdComponentId
::
IndefUnitId
->
ComponentId
indefUnitIdComponentId
(
IndefFullUnitId
cid
_
)
=
cid
indefUnitIdComponentId
(
Indef
UnitId
uid
)
=
unitIdComponentId
uid
indefUnitIdComponentId
(
Definite
UnitId
uid
)
=
unitIdComponentId
uid
-- | Get the set of holes ('ModuleVar') embedded in a 'UnitId'.
indefUnitIdFreeHoles
::
IndefUnitId
->
Set
ModuleName
...
...
@@ -208,7 +208,7 @@ indefModuleSubstFreeHoles insts = Set.unions (map indefModuleFreeHoles (Map.elem
-- 'IndefFullUnitId' be compiled; instead, we just depend on the
-- installed indefinite unit installed at the 'ComponentId'.
abstractUnitId
::
IndefUnitId
->
UnitId
abstractUnitId
(
Indef
UnitId
uid
)
=
uid
abstractUnitId
(
Definite
UnitId
uid
)
=
uid
abstractUnitId
(
IndefFullUnitId
cid
_
)
=
newSimpleUnitId
cid
-- | Take a module substitution and hash it into a string suitable for
...
...
Cabal/Distribution/Backpack/Configure.hs
View file @
fd893156
...
...
@@ -248,7 +248,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
=
Installed
.
ExposedModule
modname'
Nothing
|
otherwise
=
Installed
.
ExposedModule
modname'
(
Just
(
IndefModule
(
Indef
UnitId
uid
)
modname
))
(
Just
(
IndefModule
(
Definite
UnitId
uid
)
modname
))
convIndefModuleExport
(
modname'
,
modu
@
(
IndefModule
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
...
...
@@ -270,7 +270,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
insts
=
case
rc_i
rc
of
Left
indefc
->
[
(
m
,
IndefModuleVar
m
)
|
m
<-
indefc_requires
indefc
]
Right
instc
->
[
(
m
,
IndefModule
(
Indef
UnitId
uid'
)
m'
)
Right
instc
->
[
(
m
,
IndefModule
(
Definite
UnitId
uid'
)
m'
)
|
(
m
,
Module
uid'
m'
)
<-
instc_insts
instc
]
in
LibComponentLocalBuildInfo
{
componentPackageDeps
=
cpds
,
...
...
@@ -327,7 +327,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
Left
indefc
->
indefc_includes
indefc
Right
instc
->
map
(
\
(
x
,
y
)
->
(
Indef
UnitId
x
,
y
))
(
instc_includes
instc
)
map
(
\
(
x
,
y
)
->
(
Definite
UnitId
x
,
y
))
(
instc_includes
instc
)
internal_deps
=
filter
isInternal
(
nodeNeighbors
rc
)
++
rc_internal_build_tools
rc
...
...
Cabal/Distribution/Backpack/FullUnitId.hs
View file @
fd893156
...
...
@@ -19,7 +19,7 @@ type FullDb = UnitId -> FullUnitId
expandIndefUnitId
::
FullDb
->
IndefUnitId
->
FullUnitId
expandIndefUnitId
_db
(
IndefFullUnitId
cid
subst
)
=
FullUnitId
cid
subst
expandIndefUnitId
db
(
Indef
UnitId
uid
)
expandIndefUnitId
db
(
Definite
UnitId
uid
)
=
expandUnitId
db
uid
expandUnitId
::
FullDb
->
UnitId
->
FullUnitId
...
...
Cabal/Distribution/Backpack/ModuleShape.hs
View file @
fd893156
...
...
@@ -74,10 +74,14 @@ emptyModuleShape = ModuleShape Map.empty Set.empty
shapeInstalledPackage
::
IPI
.
InstalledPackageInfo
->
ModuleShape
shapeInstalledPackage
ipi
=
ModuleShape
(
Map
.
fromList
provs
)
reqs
where
uid
=
IPI
.
installedUnitId
ipi
insts
=
Map
.
fromList
(
IPI
.
instantiatedWith
ipi
)
uid
=
if
Set
.
null
(
indefModuleSubstFreeHoles
insts
)
then
DefiniteUnitId
(
IPI
.
installedUnitId
ipi
)
else
IndefFullUnitId
(
IPI
.
installedComponentId
ipi
)
insts
provs
=
map
shapeExposedModule
(
IPI
.
exposedModules
ipi
)
reqs
=
indefModuleSubstFreeHoles
(
Map
.
fromList
(
IPI
.
instantiatedWith
ipi
))
shapeExposedModule
(
IPI
.
ExposedModule
mod_name
Nothing
)
=
(
mod_name
,
IndefModule
(
IndefUnitId
uid
)
mod_name
)
=
(
mod_name
,
IndefModule
uid
mod_name
)
shapeExposedModule
(
IPI
.
ExposedModule
mod_name
(
Just
mod
))
=
(
mod_name
,
mod
)
Cabal/Distribution/Backpack/ReadyComponent.hs
View file @
fd893156
...
...
@@ -222,7 +222,7 @@ toReadyComponents pid_map subst0 comps
|
otherwise
=
return
Nothing
substUnitId
::
Map
ModuleName
Module
->
IndefUnitId
->
InstM
UnitId
substUnitId
_
(
Indef
UnitId
uid
)
=
substUnitId
_
(
Definite
UnitId
uid
)
=
return
uid
substUnitId
subst
(
IndefFullUnitId
cid
insts
)
=
do
insts'
<-
substSubst
subst
insts
...
...
Cabal/Distribution/Backpack/UnifyM.hs
View file @
fd893156
...
...
@@ -237,7 +237,7 @@ convertUnitId' :: MuEnv s
->
UnifyM
s
(
UnitIdU
s
)
-- TODO: this could be more lazy if we know there are no internal
-- references
convertUnitId'
_
(
Indef
UnitId
uid
)
=
convertUnitId'
_
(
Definite
UnitId
uid
)
=
liftST
$
UnionFind
.
fresh
(
UnitIdThunkU
uid
)
convertUnitId'
stk
(
IndefFullUnitId
cid
insts
)
=
do
fs
<-
fmap
unify_uniq
getUnifEnv
...
...
@@ -314,7 +314,7 @@ convertUnitIdU' :: MooEnv -> UnitIdU s -> UnifyM s IndefUnitId
convertUnitIdU'
stk
uid_u
=
do
x
<-
liftST
$
UnionFind
.
find
uid_u
case
x
of
UnitIdThunkU
uid
->
return
(
Indef
UnitId
uid
)
UnitIdThunkU
uid
->
return
(
Definite
UnitId
uid
)
UnitIdU
u
cid
insts_u
->
case
lookupMooEnv
stk
u
of
Just
_i
->
error
"convertUnitIdU': mutual recursion"
-- return (UnitIdVar i)
...
...
Cabal/Distribution/Simple/Build.hs
View file @
fd893156
...
...
@@ -474,7 +474,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
componentExeDeps
=
[]
,
componentLocalName
=
CExeName
(
stubName
test
),
componentPackageDeps
=
deps
,
componentIncludes
=
zip
(
map
(
Indef
UnitId
.
fst
)
deps
)
(
repeat
defaultRenaming
)
componentIncludes
=
zip
(
map
(
Definite
UnitId
.
fst
)
deps
)
(
repeat
defaultRenaming
)
}
testSuiteLibV09AsLibAndExe
_
TestSuite
{}
_
_
_
_
=
error
"testSuiteLibV09AsLibAndExe: wrong kind"
...
...
cabal-install/Distribution/Client/ProjectPlanning.hs
View file @
fd893156
...
...
@@ -1732,7 +1732,7 @@ instantiateInstallPlan plan =
|
otherwise
=
error
(
"instantiateComponent: "
++
display
cid
)
substUnitId
::
Map
ModuleName
Module
->
IndefUnitId
->
InstM
UnitId
substUnitId
_
(
Indef
UnitId
uid
)
=
substUnitId
_
(
Definite
UnitId
uid
)
=
return
uid
substUnitId
subst
(
IndefFullUnitId
cid
insts
)
=
do
insts'
<-
substSubst
subst
insts
...
...
cabal-install/Distribution/Client/SetupWrapper.hs
View file @
fd893156
...
...
@@ -819,7 +819,7 @@ getExternalSetupMethod verbosity options pkg bt = do
then
[]
else
cabalDep
addRenaming
(
ipid
,
_
)
=
(
Backpack
.
Indef
UnitId
(
newSimpleUnitId
ipid
),
defaultRenaming
)
(
Backpack
.
Definite
UnitId
(
newSimpleUnitId
ipid
),
defaultRenaming
)
cppMacrosFile
=
setupDir
</>
"setup_macros.h"
ghcOptions
=
mempty
{
-- Respect -v0, but don't crank up verbosity on GHC if
...
...
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