1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
-- | Info about modules in the "home" unit
module GHC.Unit.Home.ModInfo
( HomeModInfo (..)
, HomePackageTable
, emptyHomePackageTable
, lookupHpt
, eltsHpt
, filterHpt
, allHpt
, mapHpt
, delFromHpt
, addToHpt
, addListToHpt
, lookupHptDirectly
, lookupHptByModule
, listToHpt
, pprHPT
)
where
import GHC.Prelude
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.ModDetails
import GHC.Unit.Module
import GHC.Runtime.Linker.Types ( Linkable(..) )
import GHC.Types.Unique
import GHC.Types.Unique.DFM
import GHC.Utils.Outputable
-- | Information about modules in the package being compiled
data HomeModInfo = HomeModInfo
{ hm_iface :: !ModIface
-- ^ The basic loaded interface file: every loaded module has one of
-- these, even if it is imported from another package
, hm_details :: !ModDetails
-- ^ Extra information that has been created from the 'ModIface' for
-- the module, typically during typechecking
, hm_linkable :: !(Maybe Linkable)
-- ^ The actual artifact we would like to link to access things in
-- this module.
--
-- 'hm_linkable' might be Nothing:
--
-- 1. If this is an .hs-boot module
--
-- 2. Temporarily during compilation if we pruned away
-- the old linkable because it was out of date.
--
-- After a complete compilation ('GHC.load'), all 'hm_linkable' fields
-- in the 'HomePackageTable' will be @Just@.
--
-- When re-linking a module ('GHC.Driver.Main.HscNoRecomp'), we construct the
-- 'HomeModInfo' by building a new 'ModDetails' from the old
-- 'ModIface' (only).
}
-- | Helps us find information about modules in the home package
type HomePackageTable = DModuleNameEnv HomeModInfo
-- Domain = modules in the home unit that have been fully compiled
-- "home" unit id cached (implicit) here for convenience
-- | Constructs an empty HomePackageTable
emptyHomePackageTable :: HomePackageTable
emptyHomePackageTable = emptyUDFM
lookupHpt :: HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt = lookupUDFM
lookupHptDirectly :: HomePackageTable -> Unique -> Maybe HomeModInfo
lookupHptDirectly = lookupUDFM_Directly
eltsHpt :: HomePackageTable -> [HomeModInfo]
eltsHpt = eltsUDFM
filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable
filterHpt = filterUDFM
allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
allHpt = allUDFM
mapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable
mapHpt = mapUDFM
delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable
delFromHpt = delFromUDFM
addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
addToHpt = addToUDFM
addListToHpt
:: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
addListToHpt = addListToUDFM
listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable
listToHpt = listToUDFM
lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo
-- The HPT is indexed by ModuleName, not Module,
-- we must check for a hit on the right Module
lookupHptByModule hpt mod
= case lookupHpt hpt (moduleName mod) of
Just hm | mi_module (hm_iface hm) == mod -> Just hm
_otherwise -> Nothing
pprHPT :: HomePackageTable -> SDoc
-- A bit arbitrary for now
pprHPT hpt = pprUDFM hpt $ \hms ->
vcat [ hang (ppr (mi_module (hm_iface hm)))
2 (ppr (md_types (hm_details hm)))
| hm <- hms ]
|
