never executed always true always false
1
2
3 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
4
5 module GHC.HsToCore.Usage (
6 -- * Dependency/fingerprinting code (used by GHC.Iface.Make)
7 mkUsageInfo, mkUsedNames,
8 ) where
9
10 import GHC.Prelude
11
12 import GHC.Driver.Env
13 import GHC.Driver.Session
14
15
16 import GHC.Tc.Types
17
18 import GHC.Utils.Outputable
19 import GHC.Utils.Misc
20 import GHC.Utils.Fingerprint
21 import GHC.Utils.Panic
22
23 import GHC.Types.Name
24 import GHC.Types.Name.Set ( NameSet, allUses )
25 import GHC.Types.Unique.Set
26
27 import GHC.Unit
28 import GHC.Unit.External
29 import GHC.Unit.Module.Imported
30 import GHC.Unit.Module.ModIface
31 import GHC.Unit.Module.Deps
32
33 import GHC.Data.Maybe
34
35 import Data.List (sortBy)
36 import Data.Map (Map)
37 import qualified Data.Map as Map
38
39 import GHC.Linker.Types
40 import GHC.Linker.Loader ( getLoaderState )
41 import GHC.Types.SourceFile
42
43 {- Note [Module self-dependency]
44 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
45
46 GHC.Rename.Names.calculateAvails asserts the invariant that a module must not occur in
47 its own dep_orphs or dep_finsts. However, if we aren't careful this can occur
48 in the presence of hs-boot files: Consider that we have two modules, A and B,
49 both with hs-boot files,
50
51 A.hs contains a SOURCE import of B B.hs-boot contains a SOURCE import of A
52 A.hs-boot declares an orphan instance A.hs defines the orphan instance
53
54 In this case, B's dep_orphs will contain A due to its SOURCE import of A.
55 Consequently, A will contain itself in its imp_orphs due to its import of B.
56 This fact would end up being recorded in A's interface file. This would then
57 break the invariant asserted by calculateAvails that a module does not itself in
58 its dep_orphs. This was the cause of #14128.
59
60 -}
61
62 mkUsedNames :: TcGblEnv -> NameSet
63 mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
64
65 mkUsageInfo :: HscEnv -> Module -> HscSource -> ImportedMods -> NameSet -> [FilePath]
66 -> [(Module, Fingerprint)] -> IO [Usage]
67 mkUsageInfo hsc_env this_mod src dir_imp_mods used_names dependent_files merged
68 = do
69 eps <- hscEPS hsc_env
70 hashes <- mapM getFileHash dependent_files
71 -- Dependencies on object files due to TH and plugins
72 object_usages <- mkObjectUsage (eps_PIT eps) hsc_env (GWIB (moduleName this_mod) (hscSourceToIsBoot src))
73 let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
74 dir_imp_mods used_names
75 usages = mod_usages ++ [ UsageFile { usg_file_path = f
76 , usg_file_hash = hash
77 , usg_file_label = Nothing }
78 | (f, hash) <- zip dependent_files hashes ]
79 ++ [ UsageMergedRequirement
80 { usg_mod = mod,
81 usg_mod_hash = hash
82 }
83 | (mod, hash) <- merged ]
84 ++ object_usages
85 usages `seqList` return usages
86 -- seq the list of Usages returned: occasionally these
87 -- don't get evaluated for a while and we can end up hanging on to
88 -- the entire collection of Ifaces.
89
90 {- Note [Plugin dependencies]
91 ~~~~~~~~~~~~~~~~~~~~~~~~~~
92
93 Modules for which plugins were used in the compilation process, should be
94 recompiled whenever one of those plugins changes. But how do we know if a
95 plugin changed from the previous time a module was compiled?
96
97 We could try storing the fingerprints of the interface files of plugins in
98 the interface file of the module. And see if there are changes between
99 compilation runs. However, this is pretty much a non-option because interface
100 fingerprints of plugin modules are fairly stable, unless you compile plugins
101 with optimisations turned on, and give basically all binders an INLINE pragma.
102
103 So instead:
104
105 * For plugins that were built locally: we store the filepath and hash of the
106 object files of the module with the `plugin` binder, and the object files of
107 modules that are dependencies of the plugin module and belong to the same
108 `UnitId` as the plugin
109 * For plugins in an external package: we store the filepath and hash of
110 the dynamic library containing the plugin module.
111
112 During recompilation we then compare the hashes of those files again to see
113 if anything has changed.
114
115 One issue with this approach is that object files are currently (GHC 8.6.1)
116 not created fully deterministically, which could sometimes induce accidental
117 recompilation of a module for which plugins were used in the compile process.
118
119 One way to improve this is to either:
120
121 * Have deterministic object file creation
122 * Create and store implementation hashes, which would be based on the Core
123 of the module and the implementation hashes of its dependencies, and then
124 compare implementation hashes for recompilation. Creation of implementation
125 hashes is however potentially expensive.
126 -}
127
128 -- | Find object files corresponding to the transitive closure of given home
129 -- modules and direct object files for pkg dependencies
130 mkObjectUsage :: PackageIfaceTable -> HscEnv -> ModuleNameWithIsBoot -> IO [Usage]
131 mkObjectUsage pit hsc_env mnwib = do
132 case hsc_interp hsc_env of
133 Just interp -> do
134 mps <- getLoaderState interp
135 case mps of
136 Just ps -> do
137 let ls = fromMaybe [] $ Map.lookup mnwib (module_deps ps)
138 ds = hs_objs_loaded ps
139 concat <$> sequence (map linkableToUsage ls ++ map librarySpecToUsage ds)
140 Nothing -> return []
141 Nothing -> return []
142
143
144 where
145 linkableToUsage (LM _ m uls) = mapM (unlinkedToUsage m) uls
146
147 msg m = moduleNameString (moduleName m) ++ "[TH] changed"
148
149 fing mmsg fn = UsageFile fn <$> getFileHash fn <*> pure mmsg
150
151 unlinkedToUsage m ul =
152 case nameOfObject_maybe ul of
153 Just fn -> fing (Just (msg m)) fn
154 Nothing -> do
155 -- This should only happen for home package things but oneshot puts
156 -- home package ifaces in the PIT.
157 let miface = lookupIfaceByModule (hsc_HPT hsc_env) pit m
158 case miface of
159 Nothing -> pprPanic "mkObjectUsage" (ppr m)
160 Just iface ->
161 return $ UsageHomeModuleInterface (moduleName m) (mi_iface_hash (mi_final_exts iface))
162
163 librarySpecToUsage :: LibrarySpec -> IO [Usage]
164 librarySpecToUsage (Objects os) = traverse (fing Nothing) os
165 librarySpecToUsage (Archive fn) = traverse (fing Nothing) [fn]
166 librarySpecToUsage (DLLPath fn) = traverse (fing Nothing) [fn]
167 librarySpecToUsage _ = return []
168
169 mk_mod_usage_info :: PackageIfaceTable
170 -> HscEnv
171 -> Module
172 -> ImportedMods
173 -> NameSet
174 -> [Usage]
175 mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
176 = mapMaybe mkUsage usage_mods
177 where
178 hpt = hsc_HPT hsc_env
179 dflags = hsc_dflags hsc_env
180 home_unit = hsc_home_unit hsc_env
181
182 used_mods = moduleEnvKeys ent_map
183 dir_imp_mods = moduleEnvKeys direct_imports
184 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
185 usage_mods = sortBy stableModuleCmp all_mods
186 -- canonical order is imported, to avoid interface-file
187 -- wobblage.
188
189 -- ent_map groups together all the things imported and used
190 -- from a particular module
191 ent_map :: ModuleEnv [OccName]
192 ent_map = nonDetStrictFoldUniqSet add_mv emptyModuleEnv used_names
193 -- nonDetStrictFoldUniqSet is OK here. If you follow the logic, we sort by
194 -- OccName in ent_hashs
195 where
196 add_mv name mv_map
197 | isWiredInName name = mv_map -- ignore wired-in names
198 | otherwise
199 = case nameModule_maybe name of
200 Nothing -> assertPpr (isSystemName name) (ppr name) mv_map
201 -- See Note [Internal used_names]
202
203 Just mod ->
204 -- See Note [Identity versus semantic module]
205 let mod' = if isHoleModule mod
206 then mkHomeModule home_unit (moduleName mod)
207 else mod
208 -- This lambda function is really just a
209 -- specialised (++); originally came about to
210 -- avoid quadratic behaviour (trac #2680)
211 in extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod' [occ]
212 where occ = nameOccName name
213
214 -- We want to create a Usage for a home module if
215 -- a) we used something from it; has something in used_names
216 -- b) we imported it, even if we used nothing from it
217 -- (need to recompile if its export list changes: export_fprint)
218 mkUsage :: Module -> Maybe Usage
219 mkUsage mod
220 | isNothing maybe_iface -- We can't depend on it if we didn't
221 -- load its interface.
222 || mod == this_mod -- We don't care about usages of
223 -- things in *this* module
224 = Nothing
225
226 | not (isHomeModule home_unit mod)
227 = Just UsagePackageModule{ usg_mod = mod,
228 usg_mod_hash = mod_hash,
229 usg_safe = imp_safe }
230 -- for package modules, we record the module hash only
231
232 | (null used_occs
233 && isNothing export_hash
234 && not is_direct_import
235 && not finsts_mod)
236 = Nothing -- Record no usage info
237 -- for directly-imported modules, we always want to record a usage
238 -- on the orphan hash. This is what triggers a recompilation if
239 -- an orphan is added or removed somewhere below us in the future.
240
241 | otherwise
242 = Just UsageHomeModule {
243 usg_mod_name = moduleName mod,
244 usg_mod_hash = mod_hash,
245 usg_exports = export_hash,
246 usg_entities = Map.toList ent_hashs,
247 usg_safe = imp_safe }
248 where
249 maybe_iface = lookupIfaceByModule hpt pit mod
250 -- In one-shot mode, the interfaces for home-package
251 -- modules accumulate in the PIT not HPT. Sigh.
252
253 Just iface = maybe_iface
254 finsts_mod = mi_finsts (mi_final_exts iface)
255 hash_env = mi_hash_fn (mi_final_exts iface)
256 mod_hash = mi_mod_hash (mi_final_exts iface)
257 export_hash | depend_on_exports = Just (mi_exp_hash (mi_final_exts iface))
258 | otherwise = Nothing
259
260 by_is_safe (ImportedByUser imv) = imv_is_safe imv
261 by_is_safe _ = False
262 (is_direct_import, imp_safe)
263 = case lookupModuleEnv direct_imports mod of
264 -- ezyang: I'm not sure if any is the correct
265 -- metric here. If safety was guaranteed to be uniform
266 -- across all imports, why did the old code only look
267 -- at the first import?
268 Just bys -> (True, any by_is_safe bys)
269 Nothing -> (False, safeImplicitImpsReq dflags)
270 -- Nothing case is for references to entities which were
271 -- not directly imported (NB: the "implicit" Prelude import
272 -- counts as directly imported! An entity is not directly
273 -- imported if, e.g., we got a reference to it from a
274 -- reexport of another module.)
275
276 used_occs = lookupModuleEnv ent_map mod `orElse` []
277
278 -- Making a Map here ensures that (a) we remove duplicates
279 -- when we have usages on several subordinates of a single parent,
280 -- and (b) that the usages emerge in a canonical order, which
281 -- is why we use Map rather than OccEnv: Map works
282 -- using Ord on the OccNames, which is a lexicographic ordering.
283 ent_hashs :: Map OccName Fingerprint
284 ent_hashs = Map.fromList (map lookup_occ used_occs)
285
286 lookup_occ occ =
287 case hash_env occ of
288 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
289 Just r -> r
290
291 depend_on_exports = is_direct_import
292 {- True
293 Even if we used 'import M ()', we have to register a
294 usage on the export list because we are sensitive to
295 changes in orphan instances/rules.
296 False
297 In GHC 6.8.x we always returned true, and in
298 fact it recorded a dependency on *all* the
299 modules underneath in the dependency tree. This
300 happens to make orphans work right, but is too
301 expensive: it'll read too many interface files.
302 The 'isNothing maybe_iface' check above saved us
303 from generating many of these usages (at least in
304 one-shot mode), but that's even more bogus!
305 -}
306
307 {-
308 Note [Internal used_names]
309 ~~~~~~~~~~~~~~~~~~~~~~~~~~
310 Most of the used_names are External Names, but we can have System
311 Names too. Two examples:
312
313 * Names arising from Language.Haskell.TH.newName.
314 See Note [Binders in Template Haskell] in GHC.ThToHs (and #5362).
315 * The names of auxiliary bindings in derived instances.
316 See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
317
318 Such Names are always for locally-defined things, for which we don't gather
319 usage info, so we can just ignore them in ent_map. Moreover, they are always
320 System Names, hence the assert, just as a double check.
321 -}