1{-# LANGUAGE CPP #-} 2{-# LANGUAGE TupleSections #-} 3{-# LANGUAGE ViewPatterns #-} 4 5module DsUsage ( 6 -- * Dependency/fingerprinting code (used by MkIface) 7 mkUsageInfo, mkUsedNames, mkDependencies 8 ) where 9 10#include "HsVersions.h" 11 12import GhcPrelude 13 14import DynFlags 15import HscTypes 16import TcRnTypes 17import Name 18import NameSet 19import Module 20import Outputable 21import Util 22import UniqSet 23import UniqFM 24import Fingerprint 25import Maybes 26import Packages 27import Finder 28 29import Control.Monad (filterM) 30import Data.List 31import Data.IORef 32import Data.Map (Map) 33import qualified Data.Map as Map 34import qualified Data.Set as Set 35import System.Directory 36import System.FilePath 37 38{- Note [Module self-dependency] 39 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 40 41RnNames.calculateAvails asserts the invariant that a module must not occur in 42its own dep_orphs or dep_finsts. However, if we aren't careful this can occur 43in the presence of hs-boot files: Consider that we have two modules, A and B, 44both 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 49In this case, B's dep_orphs will contain A due to its SOURCE import of A. 50Consequently, A will contain itself in its imp_orphs due to its import of B. 51This fact would end up being recorded in A's interface file. This would then 52break the invariant asserted by calculateAvails that a module does not itself in 53its dep_orphs. This was the cause of #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 61mkDependencies :: InstalledUnitId -> [Module] -> TcGblEnv -> IO Dependencies 62mkDependencies 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 104mkUsedNames :: TcGblEnv -> NameSet 105mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus 106 107mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] 108 -> [(Module, Fingerprint)] -> [ModIface] -> IO [Usage] 109mkUsageInfo 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] 132Modules for which plugins were used in the compilation process, should be 133recompiled whenever one of those plugins changes. But how do we know if a 134plugin changed from the previous time a module was compiled? 135 136We could try storing the fingerprints of the interface files of plugins in 137the interface file of the module. And see if there are changes between 138compilation runs. However, this is pretty much a non-option because interface 139fingerprints of plugin modules are fairly stable, unless you compile plugins 140with optimisations turned on, and give basically all binders an INLINE pragma. 141 142So 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 151During recompilation we then compare the hashes of those files again to see 152if anything has changed. 153 154One issue with this approach is that object files are currently (GHC 8.6.1) 155not created fully deterministicly, which could sometimes induce accidental 156recompilation of a module for which plugins were used in the compile process. 157 158One 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-} 166mkPluginUsage :: HscEnv -> ModIface -> IO [Usage] 167mkPluginUsage 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 237mk_mod_usage_info :: PackageIfaceTable 238 -> HscEnv 239 -> Module 240 -> ImportedMods 241 -> NameSet 242 -> [Usage] 243mk_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 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 (mi_final_exts iface) 323 hash_env = mi_hash_fn (mi_final_exts iface) 324 mod_hash = mi_mod_hash (mi_final_exts iface) 325 export_hash | depend_on_exports = Just (mi_exp_hash (mi_final_exts 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 -} 374