Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Wander Hillen
GHC
Commits
3f13c20e
Commit
3f13c20e
authored
Sep 11, 2015
by
Edward Z. Yang
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Revert "Revert "Revert "Support for multiple signature files in scope."""
This reverts commit
214596de
.
parent
c234acbe
Changes
40
Hide whitespace changes
Inline
Side-by-side
Showing
40 changed files
with
139 additions
and
582 deletions
+139
-582
compiler/deSugar/DsMonad.hs
compiler/deSugar/DsMonad.hs
+1
-1
compiler/ghci/Linker.hs
compiler/ghci/Linker.hs
+16
-30
compiler/iface/LoadIface.hs
compiler/iface/LoadIface.hs
+6
-12
compiler/iface/MkIface.hs
compiler/iface/MkIface.hs
+4
-14
compiler/main/DriverMkDepend.hs
compiler/main/DriverMkDepend.hs
+1
-4
compiler/main/DynamicLoading.hs
compiler/main/DynamicLoading.hs
+5
-16
compiler/main/Finder.hs
compiler/main/Finder.hs
+25
-52
compiler/main/GHC.hs
compiler/main/GHC.hs
+4
-26
compiler/main/GhcMake.hs
compiler/main/GhcMake.hs
+2
-17
compiler/main/HscTypes.hs
compiler/main/HscTypes.hs
+6
-30
compiler/main/Packages.hs
compiler/main/Packages.hs
+66
-148
docs/users_guide/separate_compilation.xml
docs/users_guide/separate_compilation.xml
+0
-5
ghc/Main.hs
ghc/Main.hs
+2
-3
testsuite/.gitignore
testsuite/.gitignore
+0
-6
testsuite/tests/cabal/sigcabal02/Main.hs
testsuite/tests/cabal/sigcabal02/Main.hs
+0
-7
testsuite/tests/cabal/sigcabal02/Makefile
testsuite/tests/cabal/sigcabal02/Makefile
+0
-34
testsuite/tests/cabal/sigcabal02/Setup.hs
testsuite/tests/cabal/sigcabal02/Setup.hs
+0
-2
testsuite/tests/cabal/sigcabal02/ShouldFail.hs
testsuite/tests/cabal/sigcabal02/ShouldFail.hs
+0
-1
testsuite/tests/cabal/sigcabal02/all.T
testsuite/tests/cabal/sigcabal02/all.T
+0
-9
testsuite/tests/cabal/sigcabal02/p/LICENSE
testsuite/tests/cabal/sigcabal02/p/LICENSE
+0
-0
testsuite/tests/cabal/sigcabal02/p/Map.hsig
testsuite/tests/cabal/sigcabal02/p/Map.hsig
+0
-18
testsuite/tests/cabal/sigcabal02/p/P.hs
testsuite/tests/cabal/sigcabal02/p/P.hs
+0
-12
testsuite/tests/cabal/sigcabal02/p/Set.hsig
testsuite/tests/cabal/sigcabal02/p/Set.hsig
+0
-13
testsuite/tests/cabal/sigcabal02/p/p.cabal
testsuite/tests/cabal/sigcabal02/p/p.cabal
+0
-14
testsuite/tests/cabal/sigcabal02/q/LICENSE
testsuite/tests/cabal/sigcabal02/q/LICENSE
+0
-0
testsuite/tests/cabal/sigcabal02/q/Map.hsig
testsuite/tests/cabal/sigcabal02/q/Map.hsig
+0
-7
testsuite/tests/cabal/sigcabal02/q/Q.hs
testsuite/tests/cabal/sigcabal02/q/Q.hs
+0
-7
testsuite/tests/cabal/sigcabal02/q/q.cabal
testsuite/tests/cabal/sigcabal02/q/q.cabal
+0
-13
testsuite/tests/cabal/sigcabal02/sigcabal02.stderr
testsuite/tests/cabal/sigcabal02/sigcabal02.stderr
+0
-4
testsuite/tests/cabal/sigcabal02/sigcabal02.stdout
testsuite/tests/cabal/sigcabal02/sigcabal02.stdout
+0
-5
testsuite/tests/driver/recomp014/Makefile
testsuite/tests/driver/recomp014/Makefile
+0
-31
testsuite/tests/driver/recomp014/all.T
testsuite/tests/driver/recomp014/all.T
+0
-4
testsuite/tests/driver/recomp014/recomp014.stdout
testsuite/tests/driver/recomp014/recomp014.stdout
+0
-4
testsuite/tests/driver/sigof01/Makefile
testsuite/tests/driver/sigof01/Makefile
+0
-6
testsuite/tests/driver/sigof01/all.T
testsuite/tests/driver/sigof01/all.T
+0
-10
testsuite/tests/driver/sigof01/sigof01i.script
testsuite/tests/driver/sigof01/sigof01i.script
+0
-1
testsuite/tests/driver/sigof01/sigof01i.stdout
testsuite/tests/driver/sigof01/sigof01i.stdout
+0
-3
testsuite/tests/driver/sigof01/sigof01i2.script
testsuite/tests/driver/sigof01/sigof01i2.script
+0
-3
testsuite/tests/driver/sigof01/sigof01i2.stdout
testsuite/tests/driver/sigof01/sigof01i2.stdout
+0
-9
testsuite/tests/package/package09e.stderr
testsuite/tests/package/package09e.stderr
+1
-1
No files found.
compiler/deSugar/DsMonad.hs
View file @
3f13c20e
...
...
@@ -184,7 +184,7 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside
else
do
{
;
result
<-
liftIO
$
findImportedModule
hsc_env
modname
Nothing
;
case
result
of
Found
Module
h
->
loadModule
err
(
fr_mod
h
)
Found
_
mod
->
loadModule
err
mod
_
->
pprPgmError
"Unable to use Data Parallel Haskell (DPH):"
err
}
}
...
...
compiler/ghci/Linker.hs
View file @
3f13c20e
...
...
@@ -562,29 +562,23 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
-- 3. For each dependent module, find its linkable
-- This will either be in the HPT or (in the case of one-shot
-- compilation) we may need to use maybe_getFileLinkable.
-- If the module is actually a signature, there won't be a
-- linkable (thus catMaybes)
-- compilation) we may need to use maybe_getFileLinkable
;
let
{
osuf
=
objectSuf
dflags
}
;
lnks_needed
<-
fmap
Maybes
.
catMaybes
$
mapM
(
get_linkable
osuf
)
mods_needed
;
lnks_needed
<-
mapM
(
get_linkable
osuf
)
mods_needed
;
return
(
lnks_needed
,
pkgs_needed
)
}
where
dflags
=
hsc_dflags
hsc_env
this_pkg
=
thisPackage
dflags
-- | Given a list of modules @mods@, recursively discover all external
-- package and local module (according to @this_pkg@) dependencies.
--
-- The 'ModIface' contains the transitive closure of the module dependencies
-- within the current package, *except* for boot modules: if we encounter
-- a boot module, we have to find its real interface and discover the
-- dependencies of that. Hence we need to traverse the dependency
-- tree recursively. See bug #936, testcase ghci/prog007.
follow_deps
::
[
Module
]
-- modules to follow
->
UniqSet
ModuleName
-- accum. module dependencies
->
UniqSet
PackageKey
-- accum. package dependencies
-- The ModIface contains the transitive closure of the module dependencies
-- within the current package, *except* for boot modules: if we encounter
-- a boot module, we have to find its real interface and discover the
-- dependencies of that. Hence we need to traverse the dependency
-- tree recursively. See bug #936, testcase ghci/prog007.
follow_deps
::
[
Module
]
-- modules to follow
->
UniqSet
ModuleName
-- accum. module dependencies
->
UniqSet
PackageKey
-- accum. package dependencies
->
IO
([
ModuleName
],
[
PackageKey
])
-- result
follow_deps
[]
acc_mods
acc_pkgs
=
return
(
uniqSetToList
acc_mods
,
uniqSetToList
acc_pkgs
)
...
...
@@ -607,7 +601,6 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
where
is_boot
(
m
,
True
)
=
Left
m
is_boot
(
m
,
False
)
=
Right
m
-- Boot module dependencies which must be processed recursively
boot_deps'
=
filter
(
not
.
(`
elementOfUniqSet
`
acc_mods
))
boot_deps
acc_mods'
=
addListToUniqSet
acc_mods
(
moduleName
mod
:
mod_deps
)
acc_pkgs'
=
addListToUniqSet
acc_pkgs
$
map
fst
pkg_deps
...
...
@@ -638,37 +631,30 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
get_linkable
osuf
mod_name
-- A home-package module
|
Just
mod_info
<-
lookupUFM
hpt
mod_name
=
adjust_linkable
(
hm_iface
mod_info
)
(
Maybes
.
expectJust
"getLinkDeps"
(
hm_linkable
mod_info
))
=
adjust_linkable
(
Maybes
.
expectJust
"getLinkDeps"
(
hm_linkable
mod_info
))
|
otherwise
=
do
-- It's not in the HPT because we are in one shot mode,
-- so use the Finder to get a ModLocation...
-- ezyang: I don't actually know how to trigger this codepath,
-- seeing as this is GHCi logic. Template Haskell, maybe?
mb_stuff
<-
findHomeModule
hsc_env
mod_name
case
mb_stuff
of
Found
Exact
loc
mod
->
found
loc
mod
Found
loc
mod
->
found
loc
mod
_
->
no_obj
mod_name
where
found
loc
mod
=
do
{
-- ...and then find the linkable for it
mb_lnk
<-
findObjectLinkableMaybe
mod
loc
;
iface
<-
initIfaceCheck
hsc_env
$
loadUserInterface
False
(
text
"getLinkDeps2"
)
mod
;
case
mb_lnk
of
{
Nothing
->
no_obj
mod
;
Just
lnk
->
adjust_linkable
iface
lnk
Just
lnk
->
adjust_linkable
lnk
}}
adjust_linkable
iface
lnk
-- Signatures have no linkables! Don't return one.
|
mi_hsc_src
iface
==
HsigFile
=
return
Nothing
adjust_linkable
lnk
|
Just
new_osuf
<-
replace_osuf
=
do
new_uls
<-
mapM
(
adjust_ul
new_osuf
)
(
linkableUnlinked
lnk
)
return
(
Just
lnk
{
linkableUnlinked
=
new_uls
})
return
lnk
{
linkableUnlinked
=
new_uls
}
|
otherwise
=
return
(
Just
lnk
)
return
lnk
adjust_ul
new_osuf
(
DotO
file
)
=
do
MASSERT
(
osuf
`
isSuffixOf
`
file
)
...
...
compiler/iface/LoadIface.hs
View file @
3f13c20e
...
...
@@ -298,17 +298,12 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg
-- interface; it will call the Finder again, but the ModLocation will be
-- cached from the first search.
=
do
{
hsc_env
<-
getTopEnv
-- ToDo: findImportedModule should return a list of interfaces
;
res
<-
liftIO
$
findImportedModule
hsc_env
mod
maybe_pkg
;
case
res
of
FoundModule
(
FoundHs
{
fr_mod
=
mod
})
->
fmap
(
fmap
(
:
[]
))
.
initIfaceTcRn
$
loadInterface
doc
mod
(
ImportByUser
want_boot
)
FoundSigs
mods
_backing
->
initIfaceTcRn
$
do
ms
<-
forM
mods
$
\
(
FoundHs
{
fr_mod
=
mod
})
->
loadInterface
doc
mod
(
ImportByUser
want_boot
)
return
(
sequence
ms
)
Found
_
mod
->
fmap
(
fmap
(
:
[]
))
.
initIfaceTcRn
$
loadInterface
doc
mod
(
ImportByUser
want_boot
)
err
->
return
(
Failed
(
cannotFindInterface
(
hsc_dflags
hsc_env
)
mod
err
))
}
-- | Load interface directly for a fully qualified 'Module'. (This is a fairly
...
...
@@ -746,7 +741,7 @@ findAndReadIface doc_str mod hi_boot_file
hsc_env
<-
getTopEnv
mb_found
<-
liftIO
(
findExactModule
hsc_env
mod
)
case
mb_found
of
Found
Exact
loc
mod
->
do
Found
loc
mod
->
do
-- Found file, so read it
let
file_path
=
addBootSuffix_maybe
hi_boot_file
...
...
@@ -763,8 +758,7 @@ findAndReadIface doc_str mod hi_boot_file
traceIf
(
ptext
(
sLit
"...not found"
))
dflags
<-
getDynFlags
return
(
Failed
(
cannotFindInterface
dflags
(
moduleName
mod
)
(
convFindExactResult
err
)))
(
moduleName
mod
)
err
))
where
read_file
file_path
=
do
traceIf
(
ptext
(
sLit
"readIFace"
)
<+>
text
file_path
)
read_result
<-
readIface
mod
file_path
...
...
compiler/iface/MkIface.hs
View file @
3f13c20e
...
...
@@ -1334,20 +1334,9 @@ checkDependencies hsc_env summary iface
find_res
<-
liftIO
$
findImportedModule
hsc_env
mod
(
fmap
sl_fs
pkg
)
let
reason
=
moduleNameString
mod
++
" changed"
case
find_res
of
FoundModule
h
->
check_mod
reason
(
fr_mod
h
)
FoundSigs
hs
_backing
->
check_mods
reason
(
map
fr_mod
hs
)
_otherwise
->
return
(
RecompBecause
reason
)
check_mods
_
[]
=
return
UpToDate
check_mods
reason
(
m
:
ms
)
=
do
r
<-
check_mod
reason
m
case
r
of
UpToDate
->
check_mods
reason
ms
_otherwise
->
return
r
check_mod
reason
mod
Found
_
mod
|
pkg
==
this_pkg
=
if
moduleName
mod
`
notElem
`
map
fst
prev_dep_mods
->
if
moduleName
mod
`
notElem
`
map
fst
prev_dep_mods
then
do
traceHiDiffs
$
text
"imported module "
<>
quotes
(
ppr
mod
)
<>
text
" not among previous dependencies"
...
...
@@ -1355,7 +1344,7 @@ checkDependencies hsc_env summary iface
else
return
UpToDate
|
otherwise
=
if
pkg
`
notElem
`
(
map
fst
prev_dep_pkgs
)
->
if
pkg
`
notElem
`
(
map
fst
prev_dep_pkgs
)
then
do
traceHiDiffs
$
text
"imported module "
<>
quotes
(
ppr
mod
)
<>
text
" is from package "
<>
quotes
(
ppr
pkg
)
<>
...
...
@@ -1364,6 +1353,7 @@ checkDependencies hsc_env summary iface
else
return
UpToDate
where
pkg
=
modulePackageKey
mod
_otherwise
->
return
(
RecompBecause
reason
)
needInterface
::
Module
->
(
ModIface
->
IfG
RecompileRequired
)
->
IfG
RecompileRequired
...
...
compiler/main/DriverMkDepend.hs
View file @
3f13c20e
...
...
@@ -249,7 +249,7 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps
-- we've done it once during downsweep
r
<-
findImportedModule
hsc_env
imp
pkg
;
case
r
of
Found
Module
(
FoundHs
{
fr_loc
=
loc
})
Found
loc
_
-- Home package: just depend on the .hi or hi-boot file
|
isJust
(
ml_hs_file
loc
)
||
include_pkg_deps
->
return
(
Just
(
addBootSuffix_maybe
is_boot
(
ml_hi_file
loc
)))
...
...
@@ -258,9 +258,6 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps
|
otherwise
->
return
Nothing
-- TODO: FoundSignature. For now, we assume home package
-- "signature" dependencies look like FoundModule.
fail
->
let
dflags
=
hsc_dflags
hsc_env
in
throwOneError
$
mkPlainErrMsg
dflags
srcloc
$
...
...
compiler/main/DynamicLoading.hs
View file @
3f13c20e
...
...
@@ -203,15 +203,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
-- First find the package the module resides in by searching exposed packages and home modules
found_module
<-
findImportedModule
hsc_env
mod_name
Nothing
case
found_module
of
FoundModule
h
->
check_mod
(
fr_mod
h
)
FoundSigs
hs
_backing
->
check_mods
(
map
fr_mod
hs
)
-- (not tested)
err
->
throwCmdLineErrorS
dflags
$
cannotFindModule
dflags
mod_name
err
where
dflags
=
hsc_dflags
hsc_env
meth
=
"lookupRdrNameInModule"
doc
=
ptext
(
sLit
$
"contains a name used in an invocation of "
++
meth
)
check_mod
mod
=
do
Found
_
mod
->
do
-- Find the exports of the module
(
_
,
mb_iface
)
<-
initTcInteractive
hsc_env
$
initIfaceTcRn
$
...
...
@@ -229,13 +221,10 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
_
->
panic
"lookupRdrNameInModule"
Nothing
->
throwCmdLineErrorS
dflags
$
hsep
[
ptext
(
sLit
"Could not determine the exports of the module"
),
ppr
mod_name
]
check_mods
[]
=
return
Nothing
check_mods
(
m
:
ms
)
=
do
r
<-
check_mod
m
case
r
of
Nothing
->
check_mods
ms
Just
_
->
return
r
err
->
throwCmdLineErrorS
dflags
$
cannotFindModule
dflags
mod_name
err
where
dflags
=
hsc_dflags
hsc_env
doc
=
ptext
(
sLit
"contains a name used in an invocation of lookupRdrNameInModule"
)
wrongTyThingError
::
Name
->
TyThing
->
SDoc
wrongTyThingError
name
got_thing
=
hsep
[
ptext
(
sLit
"The name"
),
ppr
name
,
ptext
(
sLit
"is not that of a value but rather a"
),
pprTyThingCategory
got_thing
]
...
...
compiler/main/Finder.hs
View file @
3f13c20e
...
...
@@ -9,7 +9,6 @@
module
Finder
(
flushFinderCaches
,
FindResult
(
..
),
convFindExactResult
,
-- move to HscTypes?
findImportedModule
,
findExactModule
,
findHomeModule
,
...
...
@@ -46,7 +45,8 @@ import System.Directory
import
System.FilePath
import
Control.Monad
import
Data.Time
import
Data.List
(
foldl'
,
partition
)
import
Data.List
(
foldl'
)
type
FileExt
=
String
-- Filename extension
type
BaseName
=
String
-- Basename of file
...
...
@@ -75,7 +75,7 @@ flushFinderCaches hsc_env =
is_ext
mod
_
|
modulePackageKey
mod
/=
this_pkg
=
True
|
otherwise
=
False
addToFinderCache
::
IORef
FinderCache
->
Module
->
Find
Exact
Result
->
IO
()
addToFinderCache
::
IORef
FinderCache
->
Module
->
FindResult
->
IO
()
addToFinderCache
ref
key
val
=
atomicModifyIORef'
ref
$
\
c
->
(
extendModuleEnv
c
key
val
,
()
)
...
...
@@ -83,7 +83,7 @@ removeFromFinderCache :: IORef FinderCache -> Module -> IO ()
removeFromFinderCache
ref
key
=
atomicModifyIORef'
ref
$
\
c
->
(
delModuleEnv
c
key
,
()
)
lookupFinderCache
::
IORef
FinderCache
->
Module
->
IO
(
Maybe
Find
Exact
Result
)
lookupFinderCache
::
IORef
FinderCache
->
Module
->
IO
(
Maybe
FindResult
)
lookupFinderCache
ref
key
=
do
c
<-
readIORef
ref
return
$!
lookupModuleEnv
c
key
...
...
@@ -104,7 +104,7 @@ findImportedModule hsc_env mod_name mb_pkg =
Just
pkg
|
pkg
==
fsLit
"this"
->
home_import
-- "this" is special
|
otherwise
->
pkg_import
where
home_import
=
convFindExactResult
`
fmap
`
findHomeModule
hsc_env
mod_name
home_import
=
findHomeModule
hsc_env
mod_name
pkg_import
=
findExposedPackageModule
hsc_env
mod_name
mb_pkg
...
...
@@ -118,7 +118,7 @@ findImportedModule hsc_env mod_name mb_pkg =
-- reading the interface for a module mentioned by another interface,
-- for example (a "system import").
findExactModule
::
HscEnv
->
Module
->
IO
Find
Exact
Result
findExactModule
::
HscEnv
->
Module
->
IO
FindResult
findExactModule
hsc_env
mod
=
let
dflags
=
hsc_dflags
hsc_env
in
if
modulePackageKey
mod
==
thisPackage
dflags
...
...
@@ -152,45 +152,17 @@ orIfNotFound this or_this = do
-- been done. Otherwise, do the lookup (with the IO action) and save
-- the result in the finder cache and the module location cache (if it
-- was successful.)
homeSearchCache
::
HscEnv
->
ModuleName
->
IO
FindExactResult
->
IO
FindExactResult
homeSearchCache
::
HscEnv
->
ModuleName
->
IO
FindResult
->
IO
FindResult
homeSearchCache
hsc_env
mod_name
do_this
=
do
let
mod
=
mkModule
(
thisPackage
(
hsc_dflags
hsc_env
))
mod_name
modLocationCache
hsc_env
mod
do_this
-- | Converts a 'FindExactResult' into a 'FindResult' in the obvious way.
convFindExactResult
::
FindExactResult
->
FindResult
convFindExactResult
(
FoundExact
loc
m
)
=
FoundModule
(
FoundHs
loc
m
)
convFindExactResult
(
NoPackageExact
pk
)
=
NoPackage
pk
convFindExactResult
NotFoundExact
{
fer_paths
=
paths
,
fer_pkg
=
pkg
}
=
NotFound
{
fr_paths
=
paths
,
fr_pkg
=
pkg
,
fr_pkgs_hidden
=
[]
,
fr_mods_hidden
=
[]
,
fr_suggestions
=
[]
}
foundExact
::
FindExactResult
->
Bool
foundExact
FoundExact
{}
=
True
foundExact
_
=
False
findExposedPackageModule
::
HscEnv
->
ModuleName
->
Maybe
FastString
->
IO
FindResult
findExposedPackageModule
hsc_env
mod_name
mb_pkg
=
case
lookupModuleWithSuggestions
(
hsc_dflags
hsc_env
)
mod_name
mb_pkg
of
LookupFound
(
m
,
_
)
->
do
fmap
convFindExactResult
(
findPackageModule
hsc_env
m
)
LookupFoundSigs
ms
backing
->
do
locs
<-
mapM
(
findPackageModule
hsc_env
.
fst
)
ms
let
(
ok
,
missing
)
=
partition
foundExact
locs
case
missing
of
-- At the moment, we return the errors one at a time. It might be
-- better if we collected them up and reported them all, but
-- FindResult doesn't have enough information to support this.
-- In any case, this REALLY shouldn't happen (it means there are
-- broken packages in the database.)
(
m
:
_
)
->
return
(
convFindExactResult
m
)
_
->
return
(
FoundSigs
[
FoundHs
l
m
|
FoundExact
l
m
<-
ok
]
backing
)
LookupFound
m
pkg_conf
->
findPackageModule_
hsc_env
m
pkg_conf
LookupMultiple
rs
->
return
(
FoundMultiple
rs
)
LookupHidden
pkg_hiddens
mod_hiddens
->
...
...
@@ -204,7 +176,7 @@ findExposedPackageModule hsc_env mod_name mb_pkg
,
fr_mods_hidden
=
[]
,
fr_suggestions
=
suggest
})
modLocationCache
::
HscEnv
->
Module
->
IO
Find
ExactResult
->
IO
FindExact
Result
modLocationCache
::
HscEnv
->
Module
->
IO
Find
Result
->
IO
Find
Result
modLocationCache
hsc_env
mod
do_this
=
do
m
<-
lookupFinderCache
(
hsc_FC
hsc_env
)
mod
case
m
of
...
...
@@ -217,7 +189,7 @@ modLocationCache hsc_env mod do_this = do
addHomeModuleToFinder
::
HscEnv
->
ModuleName
->
ModLocation
->
IO
Module
addHomeModuleToFinder
hsc_env
mod_name
loc
=
do
let
mod
=
mkModule
(
thisPackage
(
hsc_dflags
hsc_env
))
mod_name
addToFinderCache
(
hsc_FC
hsc_env
)
mod
(
Found
Exact
loc
mod
)
addToFinderCache
(
hsc_FC
hsc_env
)
mod
(
Found
loc
mod
)
return
mod
uncacheModule
::
HscEnv
->
ModuleName
->
IO
()
...
...
@@ -244,7 +216,7 @@ uncacheModule hsc_env mod = do
--
-- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to
-- call this.)
findHomeModule
::
HscEnv
->
ModuleName
->
IO
Find
Exact
Result
findHomeModule
::
HscEnv
->
ModuleName
->
IO
FindResult
findHomeModule
hsc_env
mod_name
=
homeSearchCache
hsc_env
mod_name
$
let
...
...
@@ -275,19 +247,19 @@ findHomeModule hsc_env mod_name =
-- This is important only when compiling the base package (where GHC.Prim
-- is a home module).
if
mod
==
gHC_PRIM
then
return
(
Found
Exact
(
error
"GHC.Prim ModLocation"
)
mod
)
then
return
(
Found
(
error
"GHC.Prim ModLocation"
)
mod
)
else
searchPathExts
home_path
mod
exts
-- | Search for a module in external packages only.
findPackageModule
::
HscEnv
->
Module
->
IO
Find
Exact
Result
findPackageModule
::
HscEnv
->
Module
->
IO
FindResult
findPackageModule
hsc_env
mod
=
do
let
dflags
=
hsc_dflags
hsc_env
pkg_id
=
modulePackageKey
mod
--
case
lookupPackage
dflags
pkg_id
of
Nothing
->
return
(
NoPackage
Exact
pkg_id
)
Nothing
->
return
(
NoPackage
pkg_id
)
Just
pkg_conf
->
findPackageModule_
hsc_env
mod
pkg_conf
-- | Look up the interface file associated with module @mod@. This function
...
...
@@ -297,14 +269,14 @@ findPackageModule hsc_env mod = do
-- the 'PackageConfig' must be consistent with the package key in the 'Module'.
-- The redundancy is to avoid an extra lookup in the package state
-- for the appropriate config.
findPackageModule_
::
HscEnv
->
Module
->
PackageConfig
->
IO
Find
Exact
Result
findPackageModule_
::
HscEnv
->
Module
->
PackageConfig
->
IO
FindResult
findPackageModule_
hsc_env
mod
pkg_conf
=
ASSERT
(
modulePackageKey
mod
==
packageConfigId
pkg_conf
)
modLocationCache
hsc_env
mod
$
-- special case for GHC.Prim; we won't find it in the filesystem.
if
mod
==
gHC_PRIM
then
return
(
Found
Exact
(
error
"GHC.Prim ModLocation"
)
mod
)
then
return
(
Found
(
error
"GHC.Prim ModLocation"
)
mod
)
else
let
...
...
@@ -327,7 +299,7 @@ findPackageModule_ hsc_env mod pkg_conf =
-- don't bother looking for it.
let
basename
=
moduleNameSlashes
(
moduleName
mod
)
loc
<-
mk_hi_loc
one
basename
return
(
Found
Exact
loc
mod
)
return
(
Found
loc
mod
)
_otherwise
->
searchPathExts
import_dirs
mod
[(
package_hisuf
,
mk_hi_loc
)]
...
...
@@ -342,7 +314,7 @@ searchPathExts
FilePath
->
BaseName
->
IO
ModLocation
-- action
)
]
->
IO
Find
Exact
Result
->
IO
FindResult
searchPathExts
paths
mod
exts
=
do
result
<-
search
to_search
...
...
@@ -368,13 +340,15 @@ searchPathExts paths mod exts
file
=
base
<.>
ext
]
search
[]
=
return
(
NotFoundExact
{
fer_paths
=
map
fst
to_search
,
fer_pkg
=
Just
(
modulePackageKey
mod
)})
search
[]
=
return
(
NotFound
{
fr_paths
=
map
fst
to_search
,
fr_pkg
=
Just
(
modulePackageKey
mod
)
,
fr_mods_hidden
=
[]
,
fr_pkgs_hidden
=
[]
,
fr_suggestions
=
[]
})
search
((
file
,
mk_result
)
:
rest
)
=
do
b
<-
doesFileExist
file
if
b
then
do
{
loc
<-
mk_result
;
return
(
Found
Exact
loc
mod
)
}
then
do
{
loc
<-
mk_result
;
return
(
Found
loc
mod
)
}
else
search
rest
mkHomeModLocationSearched
::
DynFlags
->
ModuleName
->
FileExt
...
...
@@ -597,8 +571,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
vcat
(
map
mod_hidden
mod_hiddens
)
$$
tried_these
files
_
->
pprPanic
"cantFindErr"
(
ptext
cannot_find
<+>
quotes
(
ppr
mod_name
))
_
->
panic
"cantFindErr"
build_tag
=
buildTag
dflags
...
...
compiler/main/GHC.hs
View file @
3f13c20e
...
...
@@ -1361,20 +1361,6 @@ showRichTokenStream ts = go startLoc ts ""
-- | Takes a 'ModuleName' and possibly a 'PackageKey', and consults the
-- filesystem and package database to find the corresponding 'Module',
-- using the algorithm that is used for an @import@ declaration.
--
-- However, there is a twist for local modules, see #2682.
--
-- The full algorithm:
-- IF it's a package qualified import for a REMOTE package (not @this_pkg@ or
-- this), do a normal lookup.
-- OTHERWISE see if it is ALREADY loaded, and use it if it is.
-- OTHERWISE do a normal lookup, but reject the result if the found result
-- is from the LOCAL package (@this_pkg@).
--
-- For signatures, we return the BACKING implementation to keep the API
-- consistent with what we had before. (ToDo: create a new GHC API which
-- can deal with signatures.)
--
findModule
::
GhcMonad
m
=>
ModuleName
->
Maybe
FastString
->
m
Module
findModule
mod_name
maybe_pkg
=
withSession
$
\
hsc_env
->
do
let
...
...
@@ -1385,23 +1371,17 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
Just
pkg
|
fsToPackageKey
pkg
/=
this_pkg
&&
pkg
/=
fsLit
"this"
->
liftIO
$
do
res
<-
findImportedModule
hsc_env
mod_name
maybe_pkg
case
res
of
FoundModule
h
->
return
(
fr_mod
h
)
FoundSigs
_
backing
->
return
backing
Found
_
m
->
return
m
err
->
throwOneError
$
noModError
dflags
noSrcSpan
mod_name
err
_otherwise
->
do
home
<-
lookupLoadedHomeModule
mod_name
case
home
of
-- TODO: This COULD be a signature
Just
m
->
return
m
Nothing
->
liftIO
$
do
res
<-
findImportedModule
hsc_env
mod_name
maybe_pkg
case
res
of
FoundModule
(
FoundHs
{
fr_mod
=
m
,
fr_loc
=
loc
})
|
modulePackageKey
m
/=
this_pkg
->
return
m
|
otherwise
->
modNotLoadedError
dflags
m
loc
FoundSigs
(
FoundHs
{
fr_loc
=
loc
,
fr_mod
=
m
}
:
_
)
backing
|
modulePackageKey
m
/=
this_pkg
->
return
backing
|
otherwise
->
modNotLoadedError
dflags
m
loc
Found
loc
m
|
modulePackageKey
m
/=
this_pkg
->
return
m
|
otherwise
->
modNotLoadedError
dflags
m
loc
err
->
throwOneError
$
noModError
dflags
noSrcSpan
mod_name
err
modNotLoadedError
::
DynFlags
->
Module
->
ModLocation
->
IO
a
...
...
@@ -1422,13 +1402,11 @@ lookupModule mod_name (Just pkg) = findModule mod_name (Just pkg)
lookupModule
mod_name
Nothing
=
withSession
$
\
hsc_env
->
do
home
<-
lookupLoadedHomeModule
mod_name
case
home
of
-- TODO: This COULD be a signature
Just
m
->
return
m
Nothing
->
liftIO
$
do
res
<-
findExposedPackageModule
hsc_env
mod_name
Nothing
case
res
of
FoundModule
(
FoundHs
{
fr_mod
=
m
})
->
return
m
FoundSigs
_
backing
->
return
backing
Found
_
m
->
return
m
err
->
throwOneError
$
noModError
(
hsc_dflags
hsc_env
)
noSrcSpan
mod_name
err
lookupLoadedHomeModule
::
GhcMonad
m
=>
ModuleName
->
m
(
Maybe
Module
)
...
...
compiler/main/GhcMake.hs
View file @
3f13c20e
...
...
@@ -1818,10 +1818,7 @@ findSummaryBySourceFile summaries file
[]
->
Nothing
(
x
:
_
)
->
Just
x
-- | Summarise a module, and pick up source and timestamp.
-- Returns @Nothing@ if the module is excluded via @excl_mods@ or is an
-- external package module (which we don't compile), otherwise returns the
-- new module summary (or an error saying why we couldn't summarise it).
-- Summarise a module, and pick up source and timestamp.
summariseModule
::
HscEnv
->
NodeMap
ModSummary
-- Map of old summaries
...
...
@@ -1883,10 +1880,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
uncacheModule
hsc_env
wanted_mod
found
<-
findImportedModule
hsc_env
wanted_mod
Nothing
case
found
of
-- TODO: When we add -alias support, we can validly find
-- multiple signatures in the home package; need to make this
-- logic more flexible in that case.
FoundModule
(
FoundHs
{
fr_loc
=
location
,
fr_mod
=
mod
})
Found
location
mod
|
isJust
(
ml_hs_file
location
)
->
-- Home package
just_found
location
mod
...
...
@@ -1895,15 +1889,6 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
ASSERT
(
modulePackageKey
mod
/=
thisPackage
dflags
)
return
Nothing
FoundSigs
hs
_backing
|
Just
(
FoundHs
{
fr_loc
=
location
,
fr_mod
=
mod
})
<-
find
(
isJust
.
ml_hs_file
.
fr_loc
)
hs
->
just_found
location
mod
|
otherwise
->
ASSERT
(
all
(
\
h
->
modulePackageKey
(
fr_mod
h
)
/=
thisPackage
dflags
)
hs
)
return
Nothing
err
->
return
$
Just
$
Left
$
noModError
dflags
loc
wanted_mod
err
-- Not found
...
...
compiler/main/HscTypes.hs
View file @
3f13c20e
...
...
@@ -10,7 +10,7 @@
module
HscTypes
(
-- * compilation state
HscEnv
(
..
),
hscEPS
,
FinderCache
,
FindResult
(
..
),
FoundHs
(
..
),
FindExactResult
(
..
),
FinderCache
,
FindResult
(
..
),
Target
(
..
),
TargetId
(
..
),
pprTarget
,
pprTargetId
,
ModuleGraph
,
emptyMG
,
HscStatus
(
..
),
...
...
@@ -674,30 +674,15 @@ prepareAnnotations hsc_env mb_guts = do
-- modules along the search path. On @:load@, we flush the entire
-- contents of this cache.
--
type
FinderCache
=
ModuleEnv
FindExactResult
-- | The result of search for an exact 'Module'.
data
FindExactResult
=
FoundExact
ModLocation
Module
-- ^ The module/signature was found
|
NoPackageExact
PackageKey
|
NotFoundExact
{
fer_paths
::
[
FilePath
]
,
fer_pkg
::
Maybe
PackageKey
}
-- | A found module or signature; e.g. anything with an interface file
data
FoundHs
=
FoundHs
{
fr_loc
::
ModLocation
,
fr_mod
::
Module
-- , fr_origin :: ModuleOrigin
}
-- Although the @FinderCache@ range is 'FindResult' for convenience,
-- in fact it will only ever contain 'Found' or 'NotFound' entries.
--
type
FinderCache
=
ModuleEnv
FindResult
-- | The result of searching for an imported module.
data
FindResult
=
Found
Module
FoundHs
=
Found
ModLocation
Module
-- ^ The module was found
|
FoundSigs
[
FoundHs
]
Module
-- ^ Signatures were found, with some backing implementation
|
NoPackage
PackageKey
-- ^ The requested package was not found
|
FoundMultiple
[(
Module
,
ModuleOrigin
)]
...
...
@@ -2093,15 +2078,6 @@ type IsBootInterface = Bool
-- Invariant: the dependencies of a module @M@ never includes @M@.
--
-- Invariant: none of the lists contain duplicates.
--
-- NB: While this contains information about all modules and packages below
-- this one in the the import *hierarchy*, this may not accurately reflect
-- the full runtime dependencies of the module. This is because this module may
-- have imported a boot module, in which case we'll only have recorded the
-- dependencies from the hs-boot file, not the actual hs file. (This is
-- unavoidable: usually, the actual hs file will have been compiled *after*
-- we wrote this interface file.) See #936, and also @getLinkDeps@ in
-- @compiler/ghci/Linker.hs@ for code which cares about this distinction.
data
Dependencies
=
Deps
{
dep_mods
::
[(
ModuleName
,
IsBootInterface
)]
-- ^ All home-package modules transitively below this one
...
...
compiler/main/Packages.hs
View file @
3f13c20e
...
...
@@ -132,10 +132,9 @@ import qualified Data.Set as Set
-- in a different DLL, by setting the DLL flag.
-- | Given a module name, there may be multiple ways it came into scope,
-- possibly simultaneously. For a given particular implementation (e.g.
-- original module, or even a signature module), this data type tracks all the
-- possible ways it could have come into scope. Warning: don't use the record
-- functions, they're partial!
-- possibly simultaneously. This data type tracks all the possible ways
-- it could have come into scope. Warning: don't use the record functions,
-- they're partial!
data
ModuleOrigin
=
-- | Module is hidden, and thus never will be available for import.
-- (But maybe the user didn't realize), so we'll still keep track
...
...
@@ -159,7 +158,7 @@ data ModuleOrigin =
}