a6b94c98a0554f06776c8640464635fab0ec4389
[ghc.git] / compiler / deSugar / DsUsage.hs
1 {-# LANGUAGE CPP #-}
2 {-# LANGUAGE TupleSections #-}
3 {-# LANGUAGE ViewPatterns #-}
4
5 module DsUsage (
6 -- * Dependency/fingerprinting code (used by MkIface)
7 mkUsageInfo, mkUsedNames, mkDependencies
8 ) where
9
10 #include "HsVersions.h"
11
12 import GhcPrelude
13
14 import DynFlags
15 import HscTypes
16 import TcRnTypes
17 import Name
18 import NameSet
19 import Module
20 import Outputable
21 import Util
22 import UniqSet
23 import UniqFM
24 import Fingerprint
25 import Maybes
26 import Packages
27 import Finder
28
29 import Control.Monad (filterM)
30 import Data.List
31 import Data.IORef
32 import Data.Map (Map)
33 import qualified Data.Map as Map
34 import qualified Data.Set as Set
35 import System.Directory
36 import System.FilePath
37
38 {- Note [Module self-dependency]
39 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
40
41 RnNames.calculateAvails asserts the invariant that a module must not occur in
42 its own dep_orphs or dep_finsts. However, if we aren't careful this can occur
43 in the presence of hs-boot files: Consider that we have two modules, A and B,
44 both with hs-boot files,
45
46 A.hs contains a SOURCE import of B B.hs-boot contains a SOURCE import of A
47 A.hs-boot declares an orphan instance A.hs defines the orphan instance
48
49 In this case, B's dep_orphs will contain A due to its SOURCE import of A.
50 Consequently, A will contain itself in its imp_orphs due to its import of B.
51 This fact would end up being recorded in A's interface file. This would then
52 break the invariant asserted by calculateAvails that a module does not itself in
53 its dep_orphs. This was the cause of Trac #14128.
54
55 -}
56
57 -- | Extract information from the rename and typecheck phases to produce
58 -- a dependencies information for the module being compiled.
59 --
60 -- The first argument is additional dependencies from plugins
61 mkDependencies :: InstalledUnitId -> [Module] -> TcGblEnv -> IO Dependencies
62 mkDependencies iuid pluginModules
63 (TcGblEnv{ tcg_mod = mod,
64 tcg_imports = imports,
65 tcg_th_used = th_var
66 })
67 = do
68 -- Template Haskell used?
69 let (dep_plgins, ms) = unzip [ (moduleName mn, mn) | mn <- pluginModules ]
70 plugin_dep_pkgs = filter (/= iuid) (map (toInstalledUnitId . moduleUnitId) ms)
71 th_used <- readIORef th_var
72 let dep_mods = modDepsElts (delFromUFM (imp_dep_mods imports)
73 (moduleName mod))
74 -- M.hi-boot can be in the imp_dep_mods, but we must remove
75 -- it before recording the modules on which this one depends!
76 -- (We want to retain M.hi-boot in imp_dep_mods so that
77 -- loadHiBootInterface can see if M's direct imports depend
78 -- on M.hi-boot, and hence that we should do the hi-boot consistency
79 -- check.)
80
81 dep_orphs = filter (/= mod) (imp_orphs imports)
82 -- We must also remove self-references from imp_orphs. See
83 -- Note [Module self-dependency]
84
85 raw_pkgs = foldr Set.insert (imp_dep_pkgs imports) plugin_dep_pkgs
86
87 pkgs | th_used = Set.insert (toInstalledUnitId thUnitId) raw_pkgs
88 | otherwise = raw_pkgs
89
90 -- Set the packages required to be Safe according to Safe Haskell.
91 -- See Note [RnNames . Tracking Trust Transitively]
92 sorted_pkgs = sort (Set.toList pkgs)
93 trust_pkgs = imp_trust_pkgs imports
94 dep_pkgs' = map (\x -> (x, x `Set.member` trust_pkgs)) sorted_pkgs
95
96 return Deps { dep_mods = dep_mods,
97 dep_pkgs = dep_pkgs',
98 dep_orphs = dep_orphs,
99 dep_plgins = dep_plgins,
100 dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
101 -- sort to get into canonical order
102 -- NB. remember to use lexicographic ordering
103
104 mkUsedNames :: TcGblEnv -> NameSet
105 mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
106
107 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath]
108 -> [(Module, Fingerprint)] -> [ModIface] -> IO [Usage]
109 mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged
110 pluginModules
111 = do
112 eps <- hscEPS hsc_env
113 hashes <- mapM getFileHash dependent_files
114 plugin_usages <- mapM (mkPluginUsage hsc_env) pluginModules
115 let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
116 dir_imp_mods used_names
117 usages = mod_usages ++ [ UsageFile { usg_file_path = f
118 , usg_file_hash = hash }
119 | (f, hash) <- zip dependent_files hashes ]
120 ++ [ UsageMergedRequirement
121 { usg_mod = mod,
122 usg_mod_hash = hash
123 }
124 | (mod, hash) <- merged ]
125 ++ concat plugin_usages
126 usages `seqList` return usages
127 -- seq the list of Usages returned: occasionally these
128 -- don't get evaluated for a while and we can end up hanging on to
129 -- the entire collection of Ifaces.
130
131 {- Note [Plugin dependencies]
132 Modules for which plugins were used in the compilation process, should be
133 recompiled whenever one of those plugins changes. But how do we know if a
134 plugin changed from the previous time a module was compiled?
135
136 We could try storing the fingerprints of the interface files of plugins in
137 the interface file of the module. And see if there are changes between
138 compilation runs. However, this is pretty much a non-option because interface
139 fingerprints of plugin modules are fairly stable, unless you compile plugins
140 with optimisations turned on, and give basically all binders an INLINE pragma.
141
142 So instead:
143
144 * For plugins that were built locally: we store the filepath and hash of the
145 object files of the module with the `plugin` binder, and the object files of
146 modules that are dependencies of the plugin module and belong to the same
147 `UnitId` as the plugin
148 * For plugins in an external package: we store the filepath and hash of
149 the dynamic library containing the plugin module.
150
151 During recompilation we then compare the hashes of those files again to see
152 if anything has changed.
153
154 One issue with this approach is that object files are currently (GHC 8.6.1)
155 not created fully deterministicly, which could sometimes induce accidental
156 recompilation of a module for which plugins were used in the compile process.
157
158 One way to improve this is to either:
159
160 * Have deterministic object file creation
161 * Create and store implementation hashes, which would be based on the Core
162 of the module and the implementation hashes of its dependencies, and then
163 compare implementation hashes for recompilation. Creation of implementation
164 hashes is however potentially expensive.
165 -}
166 mkPluginUsage :: HscEnv -> ModIface -> IO [Usage]
167 mkPluginUsage hsc_env pluginModule
168 = case lookupPluginModuleWithSuggestions dflags pNm Nothing of
169 LookupFound _ pkg -> do
170 -- The plugin is from an external package:
171 -- search for the library files containing the plugin.
172 let searchPaths = collectLibraryPaths dflags [pkg]
173 useDyn = WayDyn `elem` ways dflags
174 suffix = if useDyn then soExt platform else "a"
175 libLocs = [ searchPath </> "lib" ++ libLoc <.> suffix
176 | searchPath <- searchPaths
177 , libLoc <- packageHsLibs dflags pkg
178 ]
179 -- we also try to find plugin library files by adding WayDyn way,
180 -- if it isn't already present (see trac #15492)
181 paths =
182 if useDyn
183 then libLocs
184 else
185 let dflags' = updateWays (addWay' WayDyn dflags)
186 dlibLocs = [ searchPath </> mkHsSOName platform dlibLoc
187 | searchPath <- searchPaths
188 , dlibLoc <- packageHsLibs dflags' pkg
189 ]
190 in libLocs ++ dlibLocs
191 files <- filterM doesFileExist paths
192 case files of
193 [] ->
194 pprPanic
195 ( "mkPluginUsage: missing plugin library, tried:\n"
196 ++ unlines paths
197 )
198 (ppr pNm)
199 _ -> mapM hashFile (nub files)
200 _ -> do
201 foundM <- findPluginModule hsc_env pNm
202 case foundM of
203 -- The plugin was built locally: look up the object file containing
204 -- the `plugin` binder, and all object files belong to modules that are
205 -- transitive dependencies of the plugin that belong to the same package.
206 Found ml _ -> do
207 pluginObject <- hashFile (ml_obj_file ml)
208 depObjects <- catMaybes <$> mapM lookupObjectFile deps
209 return (nub (pluginObject : depObjects))
210 _ -> pprPanic "mkPluginUsage: no object file found" (ppr pNm)
211 where
212 dflags = hsc_dflags hsc_env
213 platform = targetPlatform dflags
214 pNm = moduleName (mi_module pluginModule)
215 pPkg = moduleUnitId (mi_module pluginModule)
216 deps = map fst (dep_mods (mi_deps pluginModule))
217
218 -- Lookup object file for a plugin dependency,
219 -- from the same package as the plugin.
220 lookupObjectFile nm = do
221 foundM <- findImportedModule hsc_env nm Nothing
222 case foundM of
223 Found ml m
224 | moduleUnitId m == pPkg -> Just <$> hashFile (ml_obj_file ml)
225 | otherwise -> return Nothing
226 _ -> pprPanic "mkPluginUsage: no object for dependency"
227 (ppr pNm <+> ppr nm)
228
229 hashFile f = do
230 fExist <- doesFileExist f
231 if fExist
232 then do
233 h <- getFileHash f
234 return (UsageFile f h)
235 else pprPanic "mkPluginUsage: file not found" (ppr pNm <+> text f)
236
237 mk_mod_usage_info :: PackageIfaceTable
238 -> HscEnv
239 -> Module
240 -> ImportedMods
241 -> NameSet
242 -> [Usage]
243 mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
244 = mapMaybe mkUsage usage_mods
245 where
246 hpt = hsc_HPT hsc_env
247 dflags = hsc_dflags hsc_env
248 this_pkg = thisPackage dflags
249
250 used_mods = moduleEnvKeys ent_map
251 dir_imp_mods = moduleEnvKeys direct_imports
252 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
253 usage_mods = sortBy stableModuleCmp all_mods
254 -- canonical order is imported, to avoid interface-file
255 -- wobblage.
256
257 -- ent_map groups together all the things imported and used
258 -- from a particular module
259 ent_map :: ModuleEnv [OccName]
260 ent_map = nonDetFoldUniqSet add_mv emptyModuleEnv used_names
261 -- nonDetFoldUFM is OK here. If you follow the logic, we sort by OccName
262 -- in ent_hashs
263 where
264 add_mv name mv_map
265 | isWiredInName name = mv_map -- ignore wired-in names
266 | otherwise
267 = case nameModule_maybe name of
268 Nothing -> ASSERT2( isSystemName name, ppr name ) mv_map
269 -- See Note [Internal used_names]
270
271 Just mod ->
272 -- See Note [Identity versus semantic module]
273 let mod' = if isHoleModule mod
274 then mkModule this_pkg (moduleName mod)
275 else mod
276 -- This lambda function is really just a
277 -- specialised (++); originally came about to
278 -- avoid quadratic behaviour (trac #2680)
279 in extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod' [occ]
280 where occ = nameOccName name
281
282 -- We want to create a Usage for a home module if
283 -- a) we used something from it; has something in used_names
284 -- b) we imported it, even if we used nothing from it
285 -- (need to recompile if its export list changes: export_fprint)
286 mkUsage :: Module -> Maybe Usage
287 mkUsage mod
288 | isNothing maybe_iface -- We can't depend on it if we didn't
289 -- load its interface.
290 || mod == this_mod -- We don't care about usages of
291 -- things in *this* module
292 = Nothing
293
294 | moduleUnitId mod /= this_pkg
295 = Just UsagePackageModule{ usg_mod = mod,
296 usg_mod_hash = mod_hash,
297 usg_safe = imp_safe }
298 -- for package modules, we record the module hash only
299
300 | (null used_occs
301 && isNothing export_hash
302 && not is_direct_import
303 && not finsts_mod)
304 = Nothing -- Record no usage info
305 -- for directly-imported modules, we always want to record a usage
306 -- on the orphan hash. This is what triggers a recompilation if
307 -- an orphan is added or removed somewhere below us in the future.
308
309 | otherwise
310 = Just UsageHomeModule {
311 usg_mod_name = moduleName mod,
312 usg_mod_hash = mod_hash,
313 usg_exports = export_hash,
314 usg_entities = Map.toList ent_hashs,
315 usg_safe = imp_safe }
316 where
317 maybe_iface = lookupIfaceByModule dflags hpt pit mod
318 -- In one-shot mode, the interfaces for home-package
319 -- modules accumulate in the PIT not HPT. Sigh.
320
321 Just iface = maybe_iface
322 finsts_mod = mi_finsts iface
323 hash_env = mi_hash_fn iface
324 mod_hash = mi_mod_hash iface
325 export_hash | depend_on_exports = Just (mi_exp_hash iface)
326 | otherwise = Nothing
327
328 by_is_safe (ImportedByUser imv) = imv_is_safe imv
329 by_is_safe _ = False
330 (is_direct_import, imp_safe)
331 = case lookupModuleEnv direct_imports mod of
332 -- ezyang: I'm not sure if any is the correct
333 -- metric here. If safety was guaranteed to be uniform
334 -- across all imports, why did the old code only look
335 -- at the first import?
336 Just bys -> (True, any by_is_safe bys)
337 Nothing -> (False, safeImplicitImpsReq dflags)
338 -- Nothing case is for references to entities which were
339 -- not directly imported (NB: the "implicit" Prelude import
340 -- counts as directly imported! An entity is not directly
341 -- imported if, e.g., we got a reference to it from a
342 -- reexport of another module.)
343
344 used_occs = lookupModuleEnv ent_map mod `orElse` []
345
346 -- Making a Map here ensures that (a) we remove duplicates
347 -- when we have usages on several subordinates of a single parent,
348 -- and (b) that the usages emerge in a canonical order, which
349 -- is why we use Map rather than OccEnv: Map works
350 -- using Ord on the OccNames, which is a lexicographic ordering.
351 ent_hashs :: Map OccName Fingerprint
352 ent_hashs = Map.fromList (map lookup_occ used_occs)
353
354 lookup_occ occ =
355 case hash_env occ of
356 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
357 Just r -> r
358
359 depend_on_exports = is_direct_import
360 {- True
361 Even if we used 'import M ()', we have to register a
362 usage on the export list because we are sensitive to
363 changes in orphan instances/rules.
364 False
365 In GHC 6.8.x we always returned true, and in
366 fact it recorded a dependency on *all* the
367 modules underneath in the dependency tree. This
368 happens to make orphans work right, but is too
369 expensive: it'll read too many interface files.
370 The 'isNothing maybe_iface' check above saved us
371 from generating many of these usages (at least in
372 one-shot mode), but that's even more bogus!
373 -}