never executed always true always false
1 {-# LANGUAGE MultiWayIf #-}
2 {-# LANGUAGE TupleSections #-}
3 {-# LANGUAGE LambdaCase #-}
4
5 -- | Module for detecting if recompilation is required
6 module GHC.Iface.Recomp
7 ( checkOldIface
8 , RecompileRequired(..)
9 , RecompReason (..)
10 , recompileRequired
11 , addFingerprints
12 )
13 where
14
15 import GHC.Prelude
16
17 import GHC.Driver.Backend
18 import GHC.Driver.Config.Finder
19 import GHC.Driver.Env
20 import GHC.Driver.Session
21 import GHC.Driver.Ppr
22 import GHC.Driver.Plugins ( PluginRecompile(..), PluginWithArgs(..), pluginRecompile', plugins )
23
24 import GHC.Iface.Syntax
25 import GHC.Iface.Recomp.Binary
26 import GHC.Iface.Load
27 import GHC.Iface.Recomp.Flags
28 import GHC.Iface.Env
29
30 import GHC.Core
31 import GHC.Tc.Utils.Monad
32 import GHC.Hs
33
34 import GHC.Data.Graph.Directed
35 import GHC.Data.Maybe
36
37 import GHC.Utils.Error
38 import GHC.Utils.Panic
39 import GHC.Utils.Panic.Plain
40 import GHC.Utils.Outputable as Outputable
41 import GHC.Utils.Misc as Utils hiding ( eqListBy )
42 import GHC.Utils.Binary
43 import GHC.Utils.Fingerprint
44 import GHC.Utils.Exception
45 import GHC.Utils.Logger
46 import GHC.Utils.Constants (debugIsOn)
47 import GHC.Utils.Trace
48
49 import GHC.Types.Annotations
50 import GHC.Types.Name
51 import GHC.Types.Name.Set
52 import GHC.Types.SrcLoc
53 import GHC.Types.Unique
54 import GHC.Types.Unique.Set
55 import GHC.Types.Fixity.Env
56
57 import GHC.Unit.External
58 import GHC.Unit.Finder
59 import GHC.Unit.State
60 import GHC.Unit.Home
61 import GHC.Unit.Module
62 import GHC.Unit.Module.ModIface
63 import GHC.Unit.Module.ModSummary
64 import GHC.Unit.Module.Warnings
65 import GHC.Unit.Module.Deps
66
67 import Control.Monad
68 import Data.List (sortBy, sort)
69 import qualified Data.Map as Map
70 import qualified Data.Set as Set
71 import Data.Word (Word64)
72 import Data.Either
73
74 --Qualified import so we can define a Semigroup instance
75 -- but it doesn't clash with Outputable.<>
76 import qualified Data.Semigroup
77 import GHC.List (uncons)
78 import Data.Ord
79 import Data.Containers.ListUtils
80
81 {-
82 -----------------------------------------------
83 Recompilation checking
84 -----------------------------------------------
85
86 A complete description of how recompilation checking works can be
87 found in the wiki commentary:
88
89 https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance
90
91 Please read the above page for a top-down description of how this all
92 works. Notes below cover specific issues related to the implementation.
93
94 Basic idea:
95
96 * In the mi_usages information in an interface, we record the
97 fingerprint of each free variable of the module
98
99 * In mkIface, we compute the fingerprint of each exported thing A.f.
100 For each external thing that A.f refers to, we include the fingerprint
101 of the external reference when computing the fingerprint of A.f. So
102 if anything that A.f depends on changes, then A.f's fingerprint will
103 change.
104 Also record any dependent files added with
105 * addDependentFile
106 * #include
107 * -optP-include
108
109 * In checkOldIface we compare the mi_usages for the module with
110 the actual fingerprint for all each thing recorded in mi_usages
111 -}
112
113 data RecompileRequired
114 = UpToDate
115 -- ^ everything is up to date, recompilation is not required
116 | MustCompile
117 -- ^ The .hs file has been modified, or the .o/.hi file does not exist
118 | RecompBecause !RecompReason
119 -- ^ The .o/.hi files are up to date, but something else has changed
120 -- to force recompilation; the String says what (one-line summary)
121 deriving (Eq)
122
123 instance Semigroup RecompileRequired where
124 UpToDate <> r = r
125 mc <> _ = mc
126
127 instance Monoid RecompileRequired where
128 mempty = UpToDate
129
130 data RecompReason
131 = UnitDepRemoved UnitId
132 | ModulePackageChanged String
133 | SourceFileChanged
134 | ThisUnitIdChanged
135 | ImpurePlugin
136 | PluginsChanged
137 | PluginFingerprintChanged
138 | ModuleInstChanged
139 | HieMissing
140 | HieOutdated
141 | SigsMergeChanged
142 | ModuleChanged ModuleName
143 | ModuleRemoved ModuleName
144 | ModuleAdded ModuleName
145 | ModuleChangedRaw ModuleName
146 | ModuleChangedIface ModuleName
147 | FileChanged FilePath
148 | CustomReason String
149 | FlagsChanged
150 | OptimFlagsChanged
151 | HpcFlagsChanged
152 | MissingBytecode
153 | MissingObjectFile
154 | MissingDynObjectFile
155 | MissingDynHiFile
156 | MismatchedDynHiFile
157 deriving (Eq)
158
159 instance Outputable RecompReason where
160 ppr = \case
161 UnitDepRemoved uid -> ppr uid <+> text "removed"
162 ModulePackageChanged s -> text s <+> text "package changed"
163 SourceFileChanged -> text "Source file changed"
164 ThisUnitIdChanged -> text "-this-unit-id changed"
165 ImpurePlugin -> text "Impure plugin forced recompilation"
166 PluginsChanged -> text "Plugins changed"
167 PluginFingerprintChanged -> text "Plugin fingerprint changed"
168 ModuleInstChanged -> text "Implementing module changed"
169 HieMissing -> text "HIE file is missing"
170 HieOutdated -> text "HIE file is out of date"
171 SigsMergeChanged -> text "Signatures to merge in changed"
172 ModuleChanged m -> ppr m <+> text "changed"
173 ModuleChangedRaw m -> ppr m <+> text "changed (raw)"
174 ModuleChangedIface m -> ppr m <+> text "changed (interface)"
175 ModuleRemoved m -> ppr m <+> text "removed"
176 ModuleAdded m -> ppr m <+> text "added"
177 FileChanged fp -> text fp <+> text "changed"
178 CustomReason s -> text s
179 FlagsChanged -> text "Flags changed"
180 OptimFlagsChanged -> text "Optimisation flags changed"
181 HpcFlagsChanged -> text "HPC flags changed"
182 MissingBytecode -> text "Missing bytecode"
183 MissingObjectFile -> text "Missing object file"
184 MissingDynObjectFile -> text "Missing dynamic object file"
185 MissingDynHiFile -> text "Missing dynamic interface file"
186 MismatchedDynHiFile -> text "Mismatched dynamic interface file"
187
188 recompileRequired :: RecompileRequired -> Bool
189 recompileRequired UpToDate = False
190 recompileRequired _ = True
191
192 recompThen :: Monad m => m RecompileRequired -> m RecompileRequired -> m RecompileRequired
193 recompThen ma mb = ma >>= \case
194 UpToDate -> mb
195 mc -> pure mc
196
197 -- | Top level function to check if the version of an old interface file
198 -- is equivalent to the current source file the user asked us to compile.
199 -- If the same, we can avoid recompilation. We return a tuple where the
200 -- first element is a bool saying if we should recompile the object file
201 -- and the second is maybe the interface file, where Nothing means to
202 -- rebuild the interface file and not use the existing one.
203 checkOldIface
204 :: HscEnv
205 -> ModSummary
206 -> Maybe ModIface -- Old interface from compilation manager, if any
207 -> IO (RecompileRequired, Maybe ModIface)
208
209 checkOldIface hsc_env mod_summary maybe_iface
210 = do let dflags = hsc_dflags hsc_env
211 let logger = hsc_logger hsc_env
212 showPass logger $
213 "Checking old interface for " ++
214 (showPpr dflags $ ms_mod mod_summary) ++
215 " (use -ddump-hi-diffs for more details)"
216 initIfaceCheck (text "checkOldIface") hsc_env $
217 check_old_iface hsc_env mod_summary maybe_iface
218
219 check_old_iface
220 :: HscEnv
221 -> ModSummary
222 -> Maybe ModIface
223 -> IfG (RecompileRequired, Maybe ModIface)
224
225 check_old_iface hsc_env mod_summary maybe_iface
226 = let dflags = hsc_dflags hsc_env
227 logger = hsc_logger hsc_env
228 getIface =
229 case maybe_iface of
230 Just _ -> do
231 trace_if logger (text "We already have the old interface for" <+>
232 ppr (ms_mod mod_summary))
233 return maybe_iface
234 Nothing -> loadIface dflags (msHiFilePath mod_summary)
235
236 loadIface read_dflags iface_path = do
237 let ncu = hsc_NC hsc_env
238 read_result <- readIface read_dflags ncu (ms_mod mod_summary) iface_path
239 case read_result of
240 Failed err -> do
241 trace_if logger (text "FYI: cannot read old interface file:" $$ nest 4 err)
242 trace_hi_diffs logger (text "Old interface file was invalid:" $$ nest 4 err)
243 return Nothing
244 Succeeded iface -> do
245 trace_if logger (text "Read the interface file" <+> text iface_path)
246 return $ Just iface
247 check_dyn_hi :: ModIface
248 -> IfG (RecompileRequired, Maybe a)
249 -> IfG (RecompileRequired, Maybe a)
250 check_dyn_hi normal_iface recomp_check | gopt Opt_BuildDynamicToo dflags = do
251 res <- recomp_check
252 case fst res of
253 UpToDate -> do
254 maybe_dyn_iface <- liftIO $ loadIface (setDynamicNow dflags) (msDynHiFilePath mod_summary)
255 case maybe_dyn_iface of
256 Nothing -> return (RecompBecause MissingDynHiFile, Nothing)
257 Just dyn_iface | mi_iface_hash (mi_final_exts dyn_iface)
258 /= mi_iface_hash (mi_final_exts normal_iface)
259 -> return (RecompBecause MismatchedDynHiFile, Nothing)
260 Just {} -> return res
261 _ -> return res
262 check_dyn_hi _ recomp_check = recomp_check
263
264
265 src_changed
266 | gopt Opt_ForceRecomp dflags = True
267 | otherwise = False
268 in do
269 when src_changed $
270 liftIO $ trace_hi_diffs logger (nest 4 $ text "Recompilation check turned off")
271
272 case src_changed of
273 -- If the source has changed and we're in interactive mode,
274 -- avoid reading an interface; just return the one we might
275 -- have been supplied with.
276 True | not (backendProducesObject $ backend dflags) ->
277 return (MustCompile, maybe_iface)
278
279 -- Try and read the old interface for the current module
280 -- from the .hi file left from the last time we compiled it
281 True -> do
282 maybe_iface' <- liftIO $ getIface
283 return (MustCompile, maybe_iface')
284
285 False -> do
286 maybe_iface' <- liftIO $ getIface
287 case maybe_iface' of
288 -- We can't retrieve the iface
289 Nothing -> return (MustCompile, Nothing)
290
291 -- We have got the old iface; check its versions
292 -- even in the SourceUnmodifiedAndStable case we
293 -- should check versions because some packages
294 -- might have changed or gone away.
295 Just iface ->
296 check_dyn_hi iface $ checkVersions hsc_env mod_summary iface
297
298 -- | Check if a module is still the same 'version'.
299 --
300 -- This function is called in the recompilation checker after we have
301 -- determined that the module M being checked hasn't had any changes
302 -- to its source file since we last compiled M. So at this point in general
303 -- two things may have changed that mean we should recompile M:
304 -- * The interface export by a dependency of M has changed.
305 -- * The compiler flags specified this time for M have changed
306 -- in a manner that is significant for recompilation.
307 -- We return not just if we should recompile the object file but also
308 -- if we should rebuild the interface file.
309 checkVersions :: HscEnv
310 -> ModSummary
311 -> ModIface -- Old interface
312 -> IfG (RecompileRequired, Maybe ModIface)
313 checkVersions hsc_env mod_summary iface
314 = do { liftIO $ trace_hi_diffs logger
315 (text "Considering whether compilation is required for" <+>
316 ppr (mi_module iface) <> colon)
317
318 -- readIface will have verified that the UnitId matches,
319 -- but we ALSO must make sure the instantiation matches up. See
320 -- test case bkpcabal04!
321 ; hsc_env <- getTopEnv
322 ; if mi_src_hash iface /= ms_hs_hash mod_summary
323 then return (RecompBecause SourceFileChanged, Nothing) else do {
324 ; if not (isHomeModule home_unit (mi_module iface))
325 then return (RecompBecause ThisUnitIdChanged, Nothing) else do {
326 ; recomp <- liftIO $ checkFlagHash hsc_env iface
327 `recompThen` checkOptimHash hsc_env iface
328 `recompThen` checkHpcHash hsc_env iface
329 `recompThen` checkMergedSignatures hsc_env mod_summary iface
330 `recompThen` checkHsig logger home_unit mod_summary iface
331 `recompThen` pure (checkHie dflags mod_summary)
332 ; if recompileRequired recomp then return (recomp, Nothing) else do {
333 ; recomp <- checkDependencies hsc_env mod_summary iface
334 ; if recompileRequired recomp then return (recomp, Just iface) else do {
335 ; recomp <- checkPlugins hsc_env iface
336 ; if recompileRequired recomp then return (recomp, Nothing) else do {
337
338
339 -- Source code unchanged and no errors yet... carry on
340 --
341 -- First put the dependent-module info, read from the old
342 -- interface, into the envt, so that when we look for
343 -- interfaces we look for the right one (.hi or .hi-boot)
344 --
345 -- It's just temporary because either the usage check will succeed
346 -- (in which case we are done with this module) or it'll fail (in which
347 -- case we'll compile the module from scratch anyhow).
348
349 when (isOneShot (ghcMode (hsc_dflags hsc_env))) $ do {
350 ; updateEps_ $ \eps -> eps { eps_is_boot = mkModDeps $ dep_boot_mods (mi_deps iface) }
351 }
352 ; recomp <- checkList [checkModUsage (hsc_FC hsc_env) (homeUnitAsUnit home_unit) u
353 | u <- mi_usages iface]
354 ; return (recomp, Just iface)
355 }}}}}}
356 where
357 logger = hsc_logger hsc_env
358 dflags = hsc_dflags hsc_env
359 home_unit = hsc_home_unit hsc_env
360
361
362
363 -- | Check if any plugins are requesting recompilation
364 checkPlugins :: HscEnv -> ModIface -> IfG RecompileRequired
365 checkPlugins hsc_env iface = liftIO $ do
366 new_fingerprint <- fingerprintPlugins hsc_env
367 let old_fingerprint = mi_plugin_hash (mi_final_exts iface)
368 pr <- mconcat <$> mapM pluginRecompile' (plugins hsc_env)
369 return $
370 pluginRecompileToRecompileRequired old_fingerprint new_fingerprint pr
371
372 fingerprintPlugins :: HscEnv -> IO Fingerprint
373 fingerprintPlugins hsc_env =
374 fingerprintPlugins' $ plugins hsc_env
375
376 fingerprintPlugins' :: [PluginWithArgs] -> IO Fingerprint
377 fingerprintPlugins' plugins = do
378 res <- mconcat <$> mapM pluginRecompile' plugins
379 return $ case res of
380 NoForceRecompile -> fingerprintString "NoForceRecompile"
381 ForceRecompile -> fingerprintString "ForceRecompile"
382 -- is the chance of collision worth worrying about?
383 -- An alternative is to fingerprintFingerprints [fingerprintString
384 -- "maybeRecompile", fp]
385 (MaybeRecompile fp) -> fp
386
387
388 pluginRecompileToRecompileRequired
389 :: Fingerprint -> Fingerprint -> PluginRecompile -> RecompileRequired
390 pluginRecompileToRecompileRequired old_fp new_fp pr
391 | old_fp == new_fp =
392 case pr of
393 NoForceRecompile -> UpToDate
394
395 -- we already checked the fingerprint above so a mismatch is not possible
396 -- here, remember that: `fingerprint (MaybeRecomp x) == x`.
397 MaybeRecompile _ -> UpToDate
398
399 -- when we have an impure plugin in the stack we have to unconditionally
400 -- recompile since it might integrate all sorts of crazy IO results into
401 -- its compilation output.
402 ForceRecompile -> RecompBecause ImpurePlugin
403
404 | old_fp `elem` magic_fingerprints ||
405 new_fp `elem` magic_fingerprints
406 -- The fingerprints do not match either the old or new one is a magic
407 -- fingerprint. This happens when non-pure plugins are added for the first
408 -- time or when we go from one recompilation strategy to another: (force ->
409 -- no-force, maybe-recomp -> no-force, no-force -> maybe-recomp etc.)
410 --
411 -- For example when we go from ForceRecomp to NoForceRecomp
412 -- recompilation is triggered since the old impure plugins could have
413 -- changed the build output which is now back to normal.
414 = RecompBecause PluginsChanged
415
416 | otherwise =
417 case pr of
418 -- even though a plugin is forcing recompilation the fingerprint changed
419 -- which would cause recompilation anyways so we report the fingerprint
420 -- change instead.
421 ForceRecompile -> RecompBecause PluginFingerprintChanged
422
423 _ -> RecompBecause PluginFingerprintChanged
424
425 where
426 magic_fingerprints =
427 [ fingerprintString "NoForceRecompile"
428 , fingerprintString "ForceRecompile"
429 ]
430
431
432 -- | Check if an hsig file needs recompilation because its
433 -- implementing module has changed.
434 checkHsig :: Logger -> HomeUnit -> ModSummary -> ModIface -> IO RecompileRequired
435 checkHsig logger home_unit mod_summary iface = do
436 let outer_mod = ms_mod mod_summary
437 inner_mod = homeModuleNameInstantiation home_unit (moduleName outer_mod)
438 massert (isHomeModule home_unit outer_mod)
439 case inner_mod == mi_semantic_module iface of
440 True -> up_to_date logger (text "implementing module unchanged")
441 False -> return (RecompBecause ModuleInstChanged)
442
443 -- | Check if @.hie@ file is out of date or missing.
444 checkHie :: DynFlags -> ModSummary -> RecompileRequired
445 checkHie dflags mod_summary =
446 let hie_date_opt = ms_hie_date mod_summary
447 hi_date = ms_iface_date mod_summary
448 in if not (gopt Opt_WriteHie dflags)
449 then UpToDate
450 else case (hie_date_opt, hi_date) of
451 (Nothing, _) -> RecompBecause HieMissing
452 (Just hie_date, Just hi_date)
453 | hie_date < hi_date
454 -> RecompBecause HieOutdated
455 _ -> UpToDate
456
457 -- | Check the flags haven't changed
458 checkFlagHash :: HscEnv -> ModIface -> IO RecompileRequired
459 checkFlagHash hsc_env iface = do
460 let logger = hsc_logger hsc_env
461 let old_hash = mi_flag_hash (mi_final_exts iface)
462 new_hash <- fingerprintDynFlags hsc_env (mi_module iface) putNameLiterally
463 case old_hash == new_hash of
464 True -> up_to_date logger (text "Module flags unchanged")
465 False -> out_of_date_hash logger FlagsChanged
466 (text " Module flags have changed")
467 old_hash new_hash
468
469 -- | Check the optimisation flags haven't changed
470 checkOptimHash :: HscEnv -> ModIface -> IO RecompileRequired
471 checkOptimHash hsc_env iface = do
472 let logger = hsc_logger hsc_env
473 let old_hash = mi_opt_hash (mi_final_exts iface)
474 new_hash <- fingerprintOptFlags (hsc_dflags hsc_env)
475 putNameLiterally
476 if | old_hash == new_hash
477 -> up_to_date logger (text "Optimisation flags unchanged")
478 | gopt Opt_IgnoreOptimChanges (hsc_dflags hsc_env)
479 -> up_to_date logger (text "Optimisation flags changed; ignoring")
480 | otherwise
481 -> out_of_date_hash logger OptimFlagsChanged
482 (text " Optimisation flags have changed")
483 old_hash new_hash
484
485 -- | Check the HPC flags haven't changed
486 checkHpcHash :: HscEnv -> ModIface -> IO RecompileRequired
487 checkHpcHash hsc_env iface = do
488 let logger = hsc_logger hsc_env
489 let old_hash = mi_hpc_hash (mi_final_exts iface)
490 new_hash <- fingerprintHpcFlags (hsc_dflags hsc_env)
491 putNameLiterally
492 if | old_hash == new_hash
493 -> up_to_date logger (text "HPC flags unchanged")
494 | gopt Opt_IgnoreHpcChanges (hsc_dflags hsc_env)
495 -> up_to_date logger (text "HPC flags changed; ignoring")
496 | otherwise
497 -> out_of_date_hash logger HpcFlagsChanged
498 (text " HPC flags have changed")
499 old_hash new_hash
500
501 -- Check that the set of signatures we are merging in match.
502 -- If the -unit-id flags change, this can change too.
503 checkMergedSignatures :: HscEnv -> ModSummary -> ModIface -> IO RecompileRequired
504 checkMergedSignatures hsc_env mod_summary iface = do
505 let logger = hsc_logger hsc_env
506 let unit_state = hsc_units hsc_env
507 let old_merged = sort [ mod | UsageMergedRequirement{ usg_mod = mod } <- mi_usages iface ]
508 new_merged = case Map.lookup (ms_mod_name mod_summary)
509 (requirementContext unit_state) of
510 Nothing -> []
511 Just r -> sort $ map (instModuleToModule unit_state) r
512 if old_merged == new_merged
513 then up_to_date logger (text "signatures to merge in unchanged" $$ ppr new_merged)
514 else return (RecompBecause SigsMergeChanged)
515
516 -- If the direct imports of this module are resolved to targets that
517 -- are not among the dependencies of the previous interface file,
518 -- then we definitely need to recompile. This catches cases like
519 -- - an exposed package has been upgraded
520 -- - we are compiling with different package flags
521 -- - a home module that was shadowing a package module has been removed
522 -- - a new home module has been added that shadows a package module
523 -- See bug #1372.
524 --
525 -- Returns (RecompBecause <reason>) if recompilation is required.
526 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
527 checkDependencies hsc_env summary iface
528 = do
529 res_normal <- classify_import (findImportedModule fc fopts units home_unit) (ms_textual_imps summary ++ ms_srcimps summary)
530 res_plugin <- classify_import (\mod _ -> findPluginModule fc fopts units home_unit mod) (ms_plugin_imps summary)
531 case sequence (res_normal ++ res_plugin ++ [Right (fake_ghc_prim_import)| ms_ghc_prim_import summary]) of
532 Left recomp -> return recomp
533 Right es -> do
534 let (hs, ps) = partitionEithers es
535 res1 <- liftIO $ check_mods (sort hs) prev_dep_mods
536
537 let allPkgDeps = sortBy (comparing snd) $ nubOrdOn snd (ps ++ implicit_deps ++ bkpk_units)
538 res2 <- liftIO $ check_packages allPkgDeps prev_dep_pkgs
539 return (res1 `mappend` res2)
540 where
541
542 classify_import find_import imports =
543 liftIO $ traverse (\(mb_pkg, L _ mod) ->
544 let reason = ModuleChanged mod
545 in classify reason <$> find_import mod mb_pkg)
546 imports
547 dflags = hsc_dflags hsc_env
548 fopts = initFinderOpts dflags
549 logger = hsc_logger hsc_env
550 fc = hsc_FC hsc_env
551 home_unit = hsc_home_unit hsc_env
552 units = hsc_units hsc_env
553 prev_dep_mods = map gwib_mod $ Set.toAscList $ dep_direct_mods (mi_deps iface)
554 prev_dep_pkgs = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface))
555 (dep_plugin_pkgs (mi_deps iface)))
556 bkpk_units = map (("Signature",) . instUnitInstanceOf . moduleUnit) (requirementMerges units (moduleName (mi_module iface)))
557
558 implicit_deps = map ("Implicit",) (implicitPackageDeps dflags)
559
560 -- GHC.Prim is very special and doesn't appear in ms_textual_imps but
561 -- ghc-prim will appear in the package dependencies still. In order to not confuse
562 -- the recompilation logic we need to not forget we imported GHC.Prim.
563 fake_ghc_prim_import = if homeUnitId home_unit == primUnitId
564 then Left (mkModuleName "GHC.Prim")
565 else Right ("GHC.Prim", primUnitId)
566
567
568 classify _ (Found _ mod)
569 | isHomeUnit home_unit (moduleUnit mod) = Right (Left (moduleName mod))
570 | otherwise = Right (Right (moduleNameString (moduleName mod), toUnitId $ moduleUnit mod))
571 classify reason _ = Left (RecompBecause reason)
572
573 check_mods [] [] = return UpToDate
574 check_mods [] (old:_) = do
575 -- This case can happen when a module is change from HPT to package import
576 trace_hi_diffs logger $
577 text "module no longer " <> quotes (ppr old) <>
578 text "in dependencies"
579 return (RecompBecause (ModuleRemoved old))
580 check_mods (new:news) olds
581 | Just (old, olds') <- uncons olds
582 , new == old = check_mods (dropWhile (== new) news) olds'
583 | otherwise = do
584 trace_hi_diffs logger $
585 text "imported module " <> quotes (ppr new) <>
586 text " not among previous dependencies"
587 return (RecompBecause (ModuleAdded new))
588
589 check_packages :: [(String, UnitId)] -> [UnitId] -> IO RecompileRequired
590 check_packages [] [] = return UpToDate
591 check_packages [] (old:_) = do
592 trace_hi_diffs logger $
593 text "package " <> quotes (ppr old) <>
594 text "no longer in dependencies"
595 return (RecompBecause (UnitDepRemoved old))
596 check_packages (new:news) olds
597 | Just (old, olds') <- uncons olds
598 , snd new == old = check_packages (dropWhile ((== (snd new)) . snd) news) olds'
599 | otherwise = do
600 trace_hi_diffs logger $
601 text "imported package " <> quotes (ppr new) <>
602 text " not among previous dependencies"
603 return (RecompBecause (ModulePackageChanged (fst new)))
604
605
606 needInterface :: Module -> (ModIface -> IO RecompileRequired)
607 -> IfG RecompileRequired
608 needInterface mod continue
609 = do
610 mb_recomp <- getFromModIface
611 "need version info for"
612 mod
613 continue
614 case mb_recomp of
615 Nothing -> return MustCompile
616 Just recomp -> return recomp
617
618 getFromModIface :: String -> Module -> (ModIface -> IO a)
619 -> IfG (Maybe a)
620 getFromModIface doc_msg mod getter
621 = do -- Load the imported interface if possible
622 logger <- getLogger
623 let doc_str = sep [text doc_msg, ppr mod]
624 liftIO $ trace_hi_diffs logger (text "Checking interface for module" <+> ppr mod)
625
626 mb_iface <- loadInterface doc_str mod ImportBySystem
627 -- Load the interface, but don't complain on failure;
628 -- Instead, get an Either back which we can test
629
630 case mb_iface of
631 Failed _ -> do
632 liftIO $ trace_hi_diffs logger (sep [text "Couldn't load interface for module", ppr mod])
633 return Nothing
634 -- Couldn't find or parse a module mentioned in the
635 -- old interface file. Don't complain: it might
636 -- just be that the current module doesn't need that
637 -- import and it's been deleted
638 Succeeded iface -> Just <$> liftIO (getter iface)
639
640 -- | Given the usage information extracted from the old
641 -- M.hi file for the module being compiled, figure out
642 -- whether M needs to be recompiled.
643 checkModUsage :: FinderCache -> Unit -> Usage -> IfG RecompileRequired
644 checkModUsage _ _this_pkg UsagePackageModule{
645 usg_mod = mod,
646 usg_mod_hash = old_mod_hash } = do
647 logger <- getLogger
648 needInterface mod $ \iface -> do
649 let reason = ModuleChanged (moduleName mod)
650 checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
651 -- We only track the ABI hash of package modules, rather than
652 -- individual entity usages, so if the ABI hash changes we must
653 -- recompile. This is safe but may entail more recompilation when
654 -- a dependent package has changed.
655
656 checkModUsage _ _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash } = do
657 logger <- getLogger
658 needInterface mod $ \iface -> do
659 let reason = ModuleChangedRaw (moduleName mod)
660 checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
661 checkModUsage _ this_pkg UsageHomeModuleInterface{ usg_mod_name = mod_name, usg_iface_hash = old_mod_hash } = do
662 let mod = mkModule this_pkg mod_name
663 logger <- getLogger
664 needInterface mod $ \iface -> do
665 let reason = ModuleChangedIface mod_name
666 checkIfaceFingerprint logger reason old_mod_hash (mi_iface_hash (mi_final_exts iface))
667
668 checkModUsage _ this_pkg UsageHomeModule{
669 usg_mod_name = mod_name,
670 usg_mod_hash = old_mod_hash,
671 usg_exports = maybe_old_export_hash,
672 usg_entities = old_decl_hash }
673 = do
674 let mod = mkModule this_pkg mod_name
675 logger <- getLogger
676 needInterface mod $ \iface -> do
677 let
678 new_mod_hash = mi_mod_hash (mi_final_exts iface)
679 new_decl_hash = mi_hash_fn (mi_final_exts iface)
680 new_export_hash = mi_exp_hash (mi_final_exts iface)
681
682 reason = ModuleChanged (moduleName mod)
683
684 liftIO $ do
685 -- CHECK MODULE
686 recompile <- checkModuleFingerprint logger reason old_mod_hash new_mod_hash
687 if not (recompileRequired recompile)
688 then return UpToDate
689 else
690 -- CHECK EXPORT LIST
691 checkMaybeHash logger reason maybe_old_export_hash new_export_hash
692 (text " Export list changed") $ do
693
694 -- CHECK ITEMS ONE BY ONE
695 !recompile <- checkList [ checkEntityUsage logger reason new_decl_hash u
696 | u <- old_decl_hash]
697 if recompileRequired recompile
698 then return recompile -- This one failed, so just bail out now
699 else up_to_date logger (text " Great! The bits I use are up to date")
700
701 checkModUsage fc _this_pkg UsageFile{ usg_file_path = file,
702 usg_file_hash = old_hash,
703 usg_file_label = mlabel } =
704 liftIO $
705 handleIO handler $ do
706 new_hash <- lookupFileCache fc file
707 if (old_hash /= new_hash)
708 then return recomp
709 else return UpToDate
710 where
711 reason = FileChanged file
712 recomp = RecompBecause (fromMaybe reason (fmap CustomReason mlabel))
713 handler = if debugIsOn
714 then \e -> pprTrace "UsageFile" (text (show e)) $ return recomp
715 else \_ -> return recomp -- if we can't find the file, just recompile, don't fail
716
717 ------------------------
718 checkModuleFingerprint
719 :: Logger
720 -> RecompReason
721 -> Fingerprint
722 -> Fingerprint
723 -> IO RecompileRequired
724 checkModuleFingerprint logger reason old_mod_hash new_mod_hash
725 | new_mod_hash == old_mod_hash
726 = up_to_date logger (text "Module fingerprint unchanged")
727
728 | otherwise
729 = out_of_date_hash logger reason (text " Module fingerprint has changed")
730 old_mod_hash new_mod_hash
731
732 checkIfaceFingerprint
733 :: Logger
734 -> RecompReason
735 -> Fingerprint
736 -> Fingerprint
737 -> IO RecompileRequired
738 checkIfaceFingerprint logger reason old_mod_hash new_mod_hash
739 | new_mod_hash == old_mod_hash
740 = up_to_date logger (text "Iface fingerprint unchanged")
741
742 | otherwise
743 = out_of_date_hash logger reason (text " Iface fingerprint has changed")
744 old_mod_hash new_mod_hash
745
746 ------------------------
747 checkMaybeHash
748 :: Logger
749 -> RecompReason
750 -> Maybe Fingerprint
751 -> Fingerprint
752 -> SDoc
753 -> IO RecompileRequired
754 -> IO RecompileRequired
755 checkMaybeHash logger reason maybe_old_hash new_hash doc continue
756 | Just hash <- maybe_old_hash, hash /= new_hash
757 = out_of_date_hash logger reason doc hash new_hash
758 | otherwise
759 = continue
760
761 ------------------------
762 checkEntityUsage :: Logger
763 -> RecompReason
764 -> (OccName -> Maybe (OccName, Fingerprint))
765 -> (OccName, Fingerprint)
766 -> IO RecompileRequired
767 checkEntityUsage logger reason new_hash (name,old_hash) = do
768 case new_hash name of
769 -- We used it before, but it ain't there now
770 Nothing -> out_of_date logger reason (sep [text "No longer exported:", ppr name])
771 -- It's there, but is it up to date?
772 Just (_, new_hash)
773 | new_hash == old_hash
774 -> do trace_hi_diffs logger (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
775 return UpToDate
776 | otherwise
777 -> out_of_date_hash logger reason (text " Out of date:" <+> ppr name) old_hash new_hash
778
779 up_to_date :: Logger -> SDoc -> IO RecompileRequired
780 up_to_date logger msg = trace_hi_diffs logger msg >> return UpToDate
781
782 out_of_date :: Logger -> RecompReason -> SDoc -> IO RecompileRequired
783 out_of_date logger reason msg = trace_hi_diffs logger msg >> return (RecompBecause reason)
784
785 out_of_date_hash :: Logger -> RecompReason -> SDoc -> Fingerprint -> Fingerprint -> IO RecompileRequired
786 out_of_date_hash logger reason msg old_hash new_hash
787 = out_of_date logger reason (hsep [msg, ppr old_hash, text "->", ppr new_hash])
788
789 ----------------------
790 checkList :: Monad m => [m RecompileRequired] -> m RecompileRequired
791 -- This helper is used in two places
792 checkList [] = return UpToDate
793 checkList (check:checks) = do recompile <- check
794 if recompileRequired recompile
795 then return recompile
796 else checkList checks
797
798
799 -- ---------------------------------------------------------------------------
800 -- Compute fingerprints for the interface
801
802 {-
803 Note [Fingerprinting IfaceDecls]
804 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
805
806 The general idea here is that we first examine the 'IfaceDecl's and determine
807 the recursive groups of them. We then walk these groups in dependency order,
808 serializing each contained 'IfaceDecl' to a "Binary" buffer which we then
809 hash using MD5 to produce a fingerprint for the group.
810
811 However, the serialization that we use is a bit funny: we override the @putName@
812 operation with our own which serializes the hash of a 'Name' instead of the
813 'Name' itself. This ensures that the fingerprint of a decl changes if anything
814 in its transitive closure changes. This trick is why we must be careful about
815 traversing in dependency order: we need to ensure that we have hashes for
816 everything referenced by the decl which we are fingerprinting.
817
818 Moreover, we need to be careful to distinguish between serialization of binding
819 Names (e.g. the ifName field of a IfaceDecl) and non-binding (e.g. the ifInstCls
820 field of a IfaceClsInst): only in the non-binding case should we include the
821 fingerprint; in the binding case we shouldn't since it is merely the name of the
822 thing that we are currently fingerprinting.
823
824
825 Note [Fingerprinting recursive groups]
826 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
827
828 The fingerprinting of a single recursive group is a rather subtle affair, as
829 seen in #18733.
830
831 How not to fingerprint
832 ----------------------
833
834 Prior to fixing #18733 we used the following (flawed) scheme to fingerprint a
835 group in hash environment `hash_env0`:
836
837 1. extend hash_env0, giving each declaration in the group the fingerprint 0
838 2. use this environment to hash the declarations' ABIs, resulting in
839 group_fingerprint
840 3. produce the final hash environment by extending hash_env0, mapping each
841 declaration of the group to group_fingerprint
842
843 However, this is wrong. Consider, for instance, a program like:
844
845 data A = ARecu B | ABase String deriving (Show)
846 data B = BRecu A | BBase Int deriving (Show)
847
848 info :: B
849 info = BBase 1
850
851 A consequence of (3) is that A and B will have the same fingerprint. This means
852 that if the user changes `info` to:
853
854 info :: A
855 info = ABase "hello"
856
857 The program's ABI fingerprint will not change despite `info`'s type, and
858 therefore ABI, being clearly different.
859
860 However, the incorrectness doesn't end there: (1) means that all recursive
861 occurrences of names within the group will be given the same fingerprint. This
862 means that the group's fingerprint won't change if we change an occurrence of A
863 to B.
864
865 Surprisingly, this bug (#18733) lurked for many years before being uncovered.
866
867 How we now fingerprint
868 ----------------------
869
870 As seen above, the fingerprinting function must ensure that a groups
871 fingerprint captures the structure of within-group occurrences. The scheme that
872 we use is:
873
874 0. To ensure determinism, sort the declarations into a stable order by
875 declaration name
876
877 1. Extend hash_env0, giving each declaration in the group a sequential
878 fingerprint (e.g. 0, 1, 2, ...).
879
880 2. Use this environment to hash the declarations' ABIs, resulting in
881 group_fingerprint.
882
883 Since we included the sequence number in step (1) programs identical up to
884 transposition of recursive occurrences are distinguisable, avoiding the
885 second issue mentioned above.
886
887 3. Produce the final environment by extending hash_env, mapping each
888 declaration of the group to the hash of (group_fingerprint, i), where
889 i is the position of the declaration in the stable ordering.
890
891 Including i in the hash ensures that the first issue noted above is
892 avoided.
893
894 -}
895
896 -- | Add fingerprints for top-level declarations to a 'ModIface'.
897 --
898 -- See Note [Fingerprinting IfaceDecls]
899 addFingerprints
900 :: HscEnv
901 -> PartialModIface
902 -> IO ModIface
903 addFingerprints hsc_env iface0
904 = do
905 eps <- hscEPS hsc_env
906 let
907 decls = mi_decls iface0
908 warn_fn = mkIfaceWarnCache (mi_warns iface0)
909 fix_fn = mkIfaceFixCache (mi_fixities iface0)
910
911 -- The ABI of a declaration represents everything that is made
912 -- visible about the declaration that a client can depend on.
913 -- see IfaceDeclABI below.
914 declABI :: IfaceDecl -> IfaceDeclABI
915 -- TODO: I'm not sure if this should be semantic_mod or this_mod.
916 -- See also Note [Identity versus semantic module]
917 declABI decl = (this_mod, decl, extras)
918 where extras = declExtras fix_fn ann_fn non_orph_rules non_orph_insts
919 non_orph_fis top_lvl_name_env decl
920
921 -- This is used for looking up the Name of a default method
922 -- from its OccName. See Note [default method Name]
923 top_lvl_name_env =
924 mkOccEnv [ (nameOccName nm, nm)
925 | IfaceId { ifName = nm } <- decls ]
926
927 -- Dependency edges between declarations in the current module.
928 -- This is computed by finding the free external names of each
929 -- declaration, including IfaceDeclExtras (things that a
930 -- declaration implicitly depends on).
931 edges :: [ Node Unique IfaceDeclABI ]
932 edges = [ DigraphNode abi (getUnique (getOccName decl)) out
933 | decl <- decls
934 , let abi = declABI decl
935 , let out = localOccs $ freeNamesDeclABI abi
936 ]
937
938 name_module n = assertPpr (isExternalName n) (ppr n) (nameModule n)
939 localOccs =
940 map (getUnique . getParent . getOccName)
941 -- NB: names always use semantic module, so
942 -- filtering must be on the semantic module!
943 -- See Note [Identity versus semantic module]
944 . filter ((== semantic_mod) . name_module)
945 . nonDetEltsUniqSet
946 -- It's OK to use nonDetEltsUFM as localOccs is only
947 -- used to construct the edges and
948 -- stronglyConnCompFromEdgedVertices is deterministic
949 -- even with non-deterministic order of edges as
950 -- explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed.
951 where getParent :: OccName -> OccName
952 getParent occ = lookupOccEnv parent_map occ `orElse` occ
953
954 -- maps OccNames to their parents in the current module.
955 -- e.g. a reference to a constructor must be turned into a reference
956 -- to the TyCon for the purposes of calculating dependencies.
957 parent_map :: OccEnv OccName
958 parent_map = foldl' extend emptyOccEnv decls
959 where extend env d =
960 extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ]
961 where n = getOccName d
962
963 -- Strongly-connected groups of declarations, in dependency order
964 groups :: [SCC IfaceDeclABI]
965 groups = stronglyConnCompFromEdgedVerticesUniq edges
966
967 global_hash_fn = mkHashFun hsc_env eps
968
969 -- How to output Names when generating the data to fingerprint.
970 -- Here we want to output the fingerprint for each top-level
971 -- Name, whether it comes from the current module or another
972 -- module. In this way, the fingerprint for a declaration will
973 -- change if the fingerprint for anything it refers to (transitively)
974 -- changes.
975 mk_put_name :: OccEnv (OccName,Fingerprint)
976 -> BinHandle -> Name -> IO ()
977 mk_put_name local_env bh name
978 | isWiredInName name = putNameLiterally bh name
979 -- wired-in names don't have fingerprints
980 | otherwise
981 = assertPpr (isExternalName name) (ppr name) $
982 let hash | nameModule name /= semantic_mod = global_hash_fn name
983 -- Get it from the REAL interface!!
984 -- This will trigger when we compile an hsig file
985 -- and we know a backing impl for it.
986 -- See Note [Identity versus semantic module]
987 | semantic_mod /= this_mod
988 , not (isHoleModule semantic_mod) = global_hash_fn name
989 | otherwise = return (snd (lookupOccEnv local_env (getOccName name)
990 `orElse` pprPanic "urk! lookup local fingerprint"
991 (ppr name $$ ppr local_env)))
992 -- This panic indicates that we got the dependency
993 -- analysis wrong, because we needed a fingerprint for
994 -- an entity that wasn't in the environment. To debug
995 -- it, turn the panic into a trace, uncomment the
996 -- pprTraces below, run the compile again, and inspect
997 -- the output and the generated .hi file with
998 -- --show-iface.
999 in hash >>= put_ bh
1000
1001 -- take a strongly-connected group of declarations and compute
1002 -- its fingerprint.
1003
1004 fingerprint_group :: (OccEnv (OccName,Fingerprint),
1005 [(Fingerprint,IfaceDecl)])
1006 -> SCC IfaceDeclABI
1007 -> IO (OccEnv (OccName,Fingerprint),
1008 [(Fingerprint,IfaceDecl)])
1009
1010 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
1011 = do let hash_fn = mk_put_name local_env
1012 decl = abiDecl abi
1013 --pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
1014 hash <- computeFingerprint hash_fn abi
1015 env' <- extend_hash_env local_env (hash,decl)
1016 return (env', (hash,decl) : decls_w_hashes)
1017
1018 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
1019 = do let stable_abis = sortBy cmp_abiNames abis
1020 stable_decls = map abiDecl stable_abis
1021 local_env1 <- foldM extend_hash_env local_env
1022 (zip (map mkRecFingerprint [0..]) stable_decls)
1023 -- See Note [Fingerprinting recursive groups]
1024 let hash_fn = mk_put_name local_env1
1025 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
1026 -- put the cycle in a canonical order
1027 hash <- computeFingerprint hash_fn stable_abis
1028 let pairs = zip (map (bumpFingerprint hash) [0..]) stable_decls
1029 -- See Note [Fingerprinting recursive groups]
1030 local_env2 <- foldM extend_hash_env local_env pairs
1031 return (local_env2, pairs ++ decls_w_hashes)
1032
1033 -- Make a fingerprint from the ordinal position of a binding in its group.
1034 mkRecFingerprint :: Word64 -> Fingerprint
1035 mkRecFingerprint i = Fingerprint 0 i
1036
1037 bumpFingerprint :: Fingerprint -> Word64 -> Fingerprint
1038 bumpFingerprint fp n = fingerprintFingerprints [ fp, mkRecFingerprint n ]
1039
1040 -- we have fingerprinted the whole declaration, but we now need
1041 -- to assign fingerprints to all the OccNames that it binds, to
1042 -- use when referencing those OccNames in later declarations.
1043 --
1044 extend_hash_env :: OccEnv (OccName,Fingerprint)
1045 -> (Fingerprint,IfaceDecl)
1046 -> IO (OccEnv (OccName,Fingerprint))
1047 extend_hash_env env0 (hash,d) =
1048 return (foldr (\(b,fp) env -> extendOccEnv env b (b,fp)) env0
1049 (ifaceDeclFingerprints hash d))
1050
1051 --
1052 (local_env, decls_w_hashes) <-
1053 foldM fingerprint_group (emptyOccEnv, []) groups
1054
1055 -- when calculating fingerprints, we always need to use canonical ordering
1056 -- for lists of things. The mi_deps has various lists of modules and
1057 -- suchlike, which are stored in canonical order:
1058 let sorted_deps :: Dependencies
1059 sorted_deps = mi_deps iface0
1060
1061 -- The export hash of a module depends on the orphan hashes of the
1062 -- orphan modules below us in the dependency tree. This is the way
1063 -- that changes in orphans get propagated all the way up the
1064 -- dependency tree.
1065 --
1066 -- Note [A bad dep_orphs optimization]
1067 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1068 -- In a previous version of this code, we filtered out orphan modules which
1069 -- were not from the home package, justifying it by saying that "we'd
1070 -- pick up the ABI hashes of the external module instead". This is wrong.
1071 -- Suppose that we have:
1072 --
1073 -- module External where
1074 -- instance Show (a -> b)
1075 --
1076 -- module Home1 where
1077 -- import External
1078 --
1079 -- module Home2 where
1080 -- import Home1
1081 --
1082 -- The export hash of Home1 needs to reflect the orphan instances of
1083 -- External. It's true that Home1 will get rebuilt if the orphans
1084 -- of External, but we also need to make sure Home2 gets rebuilt
1085 -- as well. See #12733 for more details.
1086 let orph_mods
1087 = filter (/= this_mod) -- Note [Do not update EPS with your own hi-boot]
1088 $ dep_orphs sorted_deps
1089 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
1090
1091 -- Note [Do not update EPS with your own hi-boot]
1092 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1093 -- (See also #10182). When your hs-boot file includes an orphan
1094 -- instance declaration, you may find that the dep_orphs of a module you
1095 -- import contains reference to yourself. DO NOT actually load this module
1096 -- or add it to the orphan hashes: you're going to provide the orphan
1097 -- instances yourself, no need to consult hs-boot; if you do load the
1098 -- interface into EPS, you will see a duplicate orphan instance.
1099
1100 orphan_hash <- computeFingerprint (mk_put_name local_env)
1101 (map ifDFun orph_insts, orph_rules, orph_fis)
1102
1103 -- Hash of the transitive things in dependencies
1104 dep_hash <- computeFingerprint putNameLiterally
1105 (dep_sig_mods (mi_deps iface0),
1106 dep_boot_mods (mi_deps iface0),
1107 -- Trusted packages are like orphans
1108 dep_trusted_pkgs (mi_deps iface0),
1109 -- See Note [Export hash depends on non-orphan family instances]
1110 dep_finsts (mi_deps iface0) )
1111
1112 -- the export list hash doesn't depend on the fingerprints of
1113 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
1114 export_hash <- computeFingerprint putNameLiterally
1115 (mi_exports iface0,
1116 orphan_hash,
1117 dep_hash,
1118 dep_orphan_hashes,
1119 mi_trust iface0)
1120 -- Make sure change of Safe Haskell mode causes recomp.
1121
1122 -- Note [Export hash depends on non-orphan family instances]
1123 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1124 --
1125 -- Suppose we have:
1126 --
1127 -- module A where
1128 -- type instance F Int = Bool
1129 --
1130 -- module B where
1131 -- import A
1132 --
1133 -- module C where
1134 -- import B
1135 --
1136 -- The family instance consistency check for C depends on the dep_finsts of
1137 -- B. If we rename module A to A2, when the dep_finsts of B changes, we need
1138 -- to make sure that C gets rebuilt. Effectively, the dep_finsts are part of
1139 -- the exports of B, because C always considers them when checking
1140 -- consistency.
1141 --
1142 -- A full discussion is in #12723.
1143 --
1144 -- We do NOT need to hash dep_orphs, because this is implied by
1145 -- dep_orphan_hashes, and we do not need to hash ordinary class instances,
1146 -- because there is no eager consistency check as there is with type families
1147 -- (also we didn't store it anywhere!)
1148 --
1149
1150 -- put the declarations in a canonical order, sorted by OccName
1151 let sorted_decls :: [(Fingerprint, IfaceDecl)]
1152 sorted_decls = Map.elems $ Map.fromList $
1153 [(getOccName d, e) | e@(_, d) <- decls_w_hashes]
1154
1155 -- the flag hash depends on:
1156 -- - (some of) dflags
1157 -- it returns two hashes, one that shouldn't change
1158 -- the abi hash and one that should
1159 flag_hash <- fingerprintDynFlags hsc_env this_mod putNameLiterally
1160
1161 opt_hash <- fingerprintOptFlags dflags putNameLiterally
1162
1163 hpc_hash <- fingerprintHpcFlags dflags putNameLiterally
1164
1165 plugin_hash <- fingerprintPlugins hsc_env
1166
1167 -- the ABI hash depends on:
1168 -- - decls
1169 -- - export list
1170 -- - orphans
1171 -- - deprecations
1172 -- - flag abi hash
1173 mod_hash <- computeFingerprint putNameLiterally
1174 (map fst sorted_decls,
1175 export_hash, -- includes orphan_hash
1176 mi_warns iface0)
1177
1178 -- The interface hash depends on:
1179 -- - the ABI hash, plus
1180 -- - the source file hash,
1181 -- - the module level annotations,
1182 -- - usages
1183 -- - deps (home and external packages, dependent files)
1184 -- - hpc
1185 iface_hash <- computeFingerprint putNameLiterally
1186 (mod_hash,
1187 mi_src_hash iface0,
1188 ann_fn (mkVarOcc "module"), -- See mkIfaceAnnCache
1189 mi_usages iface0,
1190 sorted_deps,
1191 mi_hpc iface0)
1192
1193 let
1194 final_iface_exts = ModIfaceBackend
1195 { mi_iface_hash = iface_hash
1196 , mi_mod_hash = mod_hash
1197 , mi_flag_hash = flag_hash
1198 , mi_opt_hash = opt_hash
1199 , mi_hpc_hash = hpc_hash
1200 , mi_plugin_hash = plugin_hash
1201 , mi_orphan = not ( all ifRuleAuto orph_rules
1202 -- See Note [Orphans and auto-generated rules]
1203 && null orph_insts
1204 && null orph_fis)
1205 , mi_finsts = not (null (mi_fam_insts iface0))
1206 , mi_exp_hash = export_hash
1207 , mi_orphan_hash = orphan_hash
1208 , mi_warn_fn = warn_fn
1209 , mi_fix_fn = fix_fn
1210 , mi_hash_fn = lookupOccEnv local_env
1211 }
1212 final_iface = iface0 { mi_decls = sorted_decls, mi_final_exts = final_iface_exts }
1213 --
1214 return final_iface
1215
1216 where
1217 this_mod = mi_module iface0
1218 semantic_mod = mi_semantic_module iface0
1219 dflags = hsc_dflags hsc_env
1220 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
1221 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
1222 (non_orph_fis, orph_fis) = mkOrphMap ifFamInstOrph (mi_fam_insts iface0)
1223 ann_fn = mkIfaceAnnCache (mi_anns iface0)
1224
1225 -- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules
1226 -- (in particular, the orphan modules which are transitively imported by the
1227 -- current module).
1228 --
1229 -- Q: Why do we need the hash at all, doesn't the list of transitively
1230 -- imported orphan modules suffice?
1231 --
1232 -- A: If one of our transitive imports adds a new orphan instance, our
1233 -- export hash must change so that modules which import us rebuild. If we just
1234 -- hashed the [Module], the hash would not change even when a new instance was
1235 -- added to a module that already had an orphan instance.
1236 --
1237 -- Q: Why don't we just hash the orphan hashes of our direct dependencies?
1238 -- Why the full transitive closure?
1239 --
1240 -- A: Suppose we have these modules:
1241 --
1242 -- module A where
1243 -- instance Show (a -> b) where
1244 -- module B where
1245 -- import A -- **
1246 -- module C where
1247 -- import A
1248 -- import B
1249 --
1250 -- Whether or not we add or remove the import to A in B affects the
1251 -- orphan hash of B. But it shouldn't really affect the orphan hash
1252 -- of C. If we hashed only direct dependencies, there would be no
1253 -- way to tell that the net effect was a wash, and we'd be forced
1254 -- to recompile C and everything else.
1255 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
1256 getOrphanHashes hsc_env mods = do
1257 eps <- hscEPS hsc_env
1258 let
1259 hpt = hsc_HPT hsc_env
1260 dflags = hsc_dflags hsc_env
1261 pit = eps_PIT eps
1262 ctx = initSDocContext dflags defaultUserStyle
1263 get_orph_hash mod =
1264 case lookupIfaceByModule hpt pit mod of
1265 Just iface -> return (mi_orphan_hash (mi_final_exts iface))
1266 Nothing -> do -- similar to 'mkHashFun'
1267 iface <- initIfaceLoad hsc_env . withException ctx
1268 $ loadInterface (text "getOrphanHashes") mod ImportBySystem
1269 return (mi_orphan_hash (mi_final_exts iface))
1270
1271 --
1272 mapM get_orph_hash mods
1273
1274
1275 {-
1276 ************************************************************************
1277 * *
1278 The ABI of an IfaceDecl
1279 * *
1280 ************************************************************************
1281
1282 Note [The ABI of an IfaceDecl]
1283 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1284 The ABI of a declaration consists of:
1285
1286 (a) the full name of the identifier (inc. module and package,
1287 because these are used to construct the symbol name by which
1288 the identifier is known externally).
1289
1290 (b) the declaration itself, as exposed to clients. That is, the
1291 definition of an Id is included in the fingerprint only if
1292 it is made available as an unfolding in the interface.
1293
1294 (c) the fixity of the identifier (if it exists)
1295 (d) for Ids: rules
1296 (e) for classes: instances, fixity & rules for methods
1297 (f) for datatypes: instances, fixity & rules for constrs
1298
1299 Items (c)-(f) are not stored in the IfaceDecl, but instead appear
1300 elsewhere in the interface file. But they are *fingerprinted* with
1301 the declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
1302 and fingerprinting that as part of the declaration.
1303 -}
1304
1305 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
1306
1307 data IfaceDeclExtras
1308 = IfaceIdExtras IfaceIdExtras
1309
1310 | IfaceDataExtras
1311 (Maybe Fixity) -- Fixity of the tycon itself (if it exists)
1312 [IfaceInstABI] -- Local class and family instances of this tycon
1313 -- See Note [Orphans] in GHC.Core.InstEnv
1314 [AnnPayload] -- Annotations of the type itself
1315 [IfaceIdExtras] -- For each constructor: fixity, RULES and annotations
1316
1317 | IfaceClassExtras
1318 (Maybe Fixity) -- Fixity of the class itself (if it exists)
1319 [IfaceInstABI] -- Local instances of this class *or*
1320 -- of its associated data types
1321 -- See Note [Orphans] in GHC.Core.InstEnv
1322 [AnnPayload] -- Annotations of the type itself
1323 [IfaceIdExtras] -- For each class method: fixity, RULES and annotations
1324 [IfExtName] -- Default methods. If a module
1325 -- mentions a class, then it can
1326 -- instantiate the class and thereby
1327 -- use the default methods, so we must
1328 -- include these in the fingerprint of
1329 -- a class.
1330
1331 | IfaceSynonymExtras (Maybe Fixity) [AnnPayload]
1332
1333 | IfaceFamilyExtras (Maybe Fixity) [IfaceInstABI] [AnnPayload]
1334
1335 | IfaceOtherDeclExtras
1336
1337 data IfaceIdExtras
1338 = IdExtras
1339 (Maybe Fixity) -- Fixity of the Id (if it exists)
1340 [IfaceRule] -- Rules for the Id
1341 [AnnPayload] -- Annotations for the Id
1342
1343 -- When hashing a class or family instance, we hash only the
1344 -- DFunId or CoAxiom, because that depends on all the
1345 -- information about the instance.
1346 --
1347 type IfaceInstABI = IfExtName -- Name of DFunId or CoAxiom that is evidence for the instance
1348
1349 abiDecl :: IfaceDeclABI -> IfaceDecl
1350 abiDecl (_, decl, _) = decl
1351
1352 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
1353 cmp_abiNames abi1 abi2 = getOccName (abiDecl abi1) `compare`
1354 getOccName (abiDecl abi2)
1355
1356 freeNamesDeclABI :: IfaceDeclABI -> NameSet
1357 freeNamesDeclABI (_mod, decl, extras) =
1358 freeNamesIfDecl decl `unionNameSet` freeNamesDeclExtras extras
1359
1360 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
1361 freeNamesDeclExtras (IfaceIdExtras id_extras)
1362 = freeNamesIdExtras id_extras
1363 freeNamesDeclExtras (IfaceDataExtras _ insts _ subs)
1364 = unionNameSets (mkNameSet insts : map freeNamesIdExtras subs)
1365 freeNamesDeclExtras (IfaceClassExtras _ insts _ subs defms)
1366 = unionNameSets $
1367 mkNameSet insts : mkNameSet defms : map freeNamesIdExtras subs
1368 freeNamesDeclExtras (IfaceSynonymExtras _ _)
1369 = emptyNameSet
1370 freeNamesDeclExtras (IfaceFamilyExtras _ insts _)
1371 = mkNameSet insts
1372 freeNamesDeclExtras IfaceOtherDeclExtras
1373 = emptyNameSet
1374
1375 freeNamesIdExtras :: IfaceIdExtras -> NameSet
1376 freeNamesIdExtras (IdExtras _ rules _) = unionNameSets (map freeNamesIfRule rules)
1377
1378 instance Outputable IfaceDeclExtras where
1379 ppr IfaceOtherDeclExtras = Outputable.empty
1380 ppr (IfaceIdExtras extras) = ppr_id_extras extras
1381 ppr (IfaceSynonymExtras fix anns) = vcat [ppr fix, ppr anns]
1382 ppr (IfaceFamilyExtras fix finsts anns) = vcat [ppr fix, ppr finsts, ppr anns]
1383 ppr (IfaceDataExtras fix insts anns stuff) = vcat [ppr fix, ppr_insts insts, ppr anns,
1384 ppr_id_extras_s stuff]
1385 ppr (IfaceClassExtras fix insts anns stuff defms) =
1386 vcat [ppr fix, ppr_insts insts, ppr anns,
1387 ppr_id_extras_s stuff, ppr defms]
1388
1389 ppr_insts :: [IfaceInstABI] -> SDoc
1390 ppr_insts _ = text "<insts>"
1391
1392 ppr_id_extras_s :: [IfaceIdExtras] -> SDoc
1393 ppr_id_extras_s stuff = vcat (map ppr_id_extras stuff)
1394
1395 ppr_id_extras :: IfaceIdExtras -> SDoc
1396 ppr_id_extras (IdExtras fix rules anns) = ppr fix $$ vcat (map ppr rules) $$ vcat (map ppr anns)
1397
1398 -- This instance is used only to compute fingerprints
1399 instance Binary IfaceDeclExtras where
1400 get _bh = panic "no get for IfaceDeclExtras"
1401 put_ bh (IfaceIdExtras extras) = do
1402 putByte bh 1; put_ bh extras
1403 put_ bh (IfaceDataExtras fix insts anns cons) = do
1404 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh anns; put_ bh cons
1405 put_ bh (IfaceClassExtras fix insts anns methods defms) = do
1406 putByte bh 3
1407 put_ bh fix
1408 put_ bh insts
1409 put_ bh anns
1410 put_ bh methods
1411 put_ bh defms
1412 put_ bh (IfaceSynonymExtras fix anns) = do
1413 putByte bh 4; put_ bh fix; put_ bh anns
1414 put_ bh (IfaceFamilyExtras fix finsts anns) = do
1415 putByte bh 5; put_ bh fix; put_ bh finsts; put_ bh anns
1416 put_ bh IfaceOtherDeclExtras = putByte bh 6
1417
1418 instance Binary IfaceIdExtras where
1419 get _bh = panic "no get for IfaceIdExtras"
1420 put_ bh (IdExtras fix rules anns)= do { put_ bh fix; put_ bh rules; put_ bh anns }
1421
1422 declExtras :: (OccName -> Maybe Fixity)
1423 -> (OccName -> [AnnPayload])
1424 -> OccEnv [IfaceRule]
1425 -> OccEnv [IfaceClsInst]
1426 -> OccEnv [IfaceFamInst]
1427 -> OccEnv IfExtName -- lookup default method names
1428 -> IfaceDecl
1429 -> IfaceDeclExtras
1430
1431 declExtras fix_fn ann_fn rule_env inst_env fi_env dm_env decl
1432 = case decl of
1433 IfaceId{} -> IfaceIdExtras (id_extras n)
1434 IfaceData{ifCons=cons} ->
1435 IfaceDataExtras (fix_fn n)
1436 (map ifFamInstAxiom (lookupOccEnvL fi_env n) ++
1437 map ifDFun (lookupOccEnvL inst_env n))
1438 (ann_fn n)
1439 (map (id_extras . occName . ifConName) (visibleIfConDecls cons))
1440 IfaceClass{ifBody = IfConcreteClass { ifSigs=sigs, ifATs=ats }} ->
1441 IfaceClassExtras (fix_fn n) insts (ann_fn n) meths defms
1442 where
1443 insts = (map ifDFun $ (concatMap at_extras ats)
1444 ++ lookupOccEnvL inst_env n)
1445 -- Include instances of the associated types
1446 -- as well as instances of the class (#5147)
1447 meths = [id_extras (getOccName op) | IfaceClassOp op _ _ <- sigs]
1448 -- Names of all the default methods (see Note [default method Name])
1449 defms = [ dmName
1450 | IfaceClassOp bndr _ (Just _) <- sigs
1451 , let dmOcc = mkDefaultMethodOcc (nameOccName bndr)
1452 , Just dmName <- [lookupOccEnv dm_env dmOcc] ]
1453 IfaceSynonym{} -> IfaceSynonymExtras (fix_fn n)
1454 (ann_fn n)
1455 IfaceFamily{} -> IfaceFamilyExtras (fix_fn n)
1456 (map ifFamInstAxiom (lookupOccEnvL fi_env n))
1457 (ann_fn n)
1458 _other -> IfaceOtherDeclExtras
1459 where
1460 n = getOccName decl
1461 id_extras occ = IdExtras (fix_fn occ) (lookupOccEnvL rule_env occ) (ann_fn occ)
1462 at_extras (IfaceAT decl _) = lookupOccEnvL inst_env (getOccName decl)
1463
1464
1465 {- Note [default method Name] (see also #15970)
1466
1467 The Names for the default methods aren't available in Iface syntax.
1468
1469 * We originally start with a DefMethInfo from the class, contain a
1470 Name for the default method
1471
1472 * We turn that into Iface syntax as a DefMethSpec which lacks a Name
1473 entirely. Why? Because the Name can be derived from the method name
1474 (in GHC.IfaceToCore), so doesn't need to be serialised into the interface
1475 file.
1476
1477 But now we have to get the Name back, because the class declaration's
1478 fingerprint needs to depend on it (this was the bug in #15970). This
1479 is done in a slightly convoluted way:
1480
1481 * Then, in addFingerprints we build a map that maps OccNames to Names
1482
1483 * We pass that map to declExtras which laboriously looks up in the map
1484 (using the derived occurrence name) to recover the Name we have just
1485 thrown away.
1486 -}
1487
1488 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
1489 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
1490
1491 {-
1492 -- for testing: use the md5sum command to generate fingerprints and
1493 -- compare the results against our built-in version.
1494 fp' <- oldMD5 dflags bh
1495 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
1496 else return fp
1497
1498 oldMD5 dflags bh = do
1499 tmp <- newTempName dflags CurrentModule "bin"
1500 writeBinMem bh tmp
1501 tmp2 <- newTempName dflags CurrentModule "md5"
1502 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
1503 r <- system cmd
1504 case r of
1505 ExitFailure _ -> throwGhcExceptionIO (PhaseFailed cmd r)
1506 ExitSuccess -> do
1507 hash_str <- readFile tmp2
1508 return $! readHexFingerprint hash_str
1509 -}
1510
1511 ----------------------
1512 -- mkOrphMap partitions instance decls or rules into
1513 -- (a) an OccEnv for ones that are not orphans,
1514 -- mapping the local OccName to a list of its decls
1515 -- (b) a list of orphan decls
1516 mkOrphMap :: (decl -> IsOrphan) -- Extract orphan status from decl
1517 -> [decl] -- Sorted into canonical order
1518 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
1519 -- each sublist in canonical order
1520 [decl]) -- Orphan decls; in canonical order
1521 mkOrphMap get_key decls
1522 = foldl' go (emptyOccEnv, []) decls
1523 where
1524 go (non_orphs, orphs) d
1525 | NotOrphan occ <- get_key d
1526 = (extendOccEnv_Acc (:) Utils.singleton non_orphs occ d, orphs)
1527 | otherwise = (non_orphs, d:orphs)
1528
1529 -- -----------------------------------------------------------------------------
1530 -- Look up parents and versions of Names
1531
1532 -- This is like a global version of the mi_hash_fn field in each ModIface.
1533 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
1534 -- the parent and version info.
1535
1536 mkHashFun
1537 :: HscEnv -- needed to look up versions
1538 -> ExternalPackageState -- ditto
1539 -> (Name -> IO Fingerprint)
1540 mkHashFun hsc_env eps name
1541 | isHoleModule orig_mod
1542 = lookup (mkHomeModule home_unit (moduleName orig_mod))
1543 | otherwise
1544 = lookup orig_mod
1545 where
1546 home_unit = hsc_home_unit hsc_env
1547 dflags = hsc_dflags hsc_env
1548 hpt = hsc_HPT hsc_env
1549 pit = eps_PIT eps
1550 ctx = initSDocContext dflags defaultUserStyle
1551 occ = nameOccName name
1552 orig_mod = nameModule name
1553 lookup mod = do
1554 massertPpr (isExternalName name) (ppr name)
1555 iface <- case lookupIfaceByModule hpt pit mod of
1556 Just iface -> return iface
1557 Nothing ->
1558 -- This can occur when we're writing out ifaces for
1559 -- requirements; we didn't do any /real/ typechecking
1560 -- so there's no guarantee everything is loaded.
1561 -- Kind of a heinous hack.
1562 initIfaceLoad hsc_env . withException ctx
1563 $ withoutDynamicNow
1564 -- If you try and load interfaces when dynamic-too
1565 -- enabled then it attempts to load the dyn_hi and hi
1566 -- interface files. Backpack doesn't really care about
1567 -- dynamic object files as it isn't doing any code
1568 -- generation so -dynamic-too is turned off.
1569 -- Some tests fail without doing this (such as T16219),
1570 -- but they fail because dyn_hi files are not found for
1571 -- one of the dependencies (because they are deliberately turned off)
1572 -- Why is this check turned off here? That is unclear but
1573 -- just one of the many horrible hacks in the backpack
1574 -- implementation.
1575 $ loadInterface (text "lookupVers2") mod ImportBySystem
1576 return $ snd (mi_hash_fn (mi_final_exts iface) occ `orElse`
1577 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
1578
1579
1580 -- | Creates cached lookup for the 'mi_anns' field of ModIface
1581 -- Hackily, we use "module" as the OccName for any module-level annotations
1582 mkIfaceAnnCache :: [IfaceAnnotation] -> OccName -> [AnnPayload]
1583 mkIfaceAnnCache anns
1584 = \n -> lookupOccEnv env n `orElse` []
1585 where
1586 pair (IfaceAnnotation target value) =
1587 (case target of
1588 NamedTarget occn -> occn
1589 ModuleTarget _ -> mkVarOcc "module"
1590 , [value])
1591 -- flipping (++), so the first argument is always short
1592 env = mkOccEnv_C (flip (++)) (map pair anns)