gitlab-ci: Update bootstrap compiled used for Darwin builds
[ghc.git] / compiler / iface / MkIface.hs
1 {-
2 (c) The University of Glasgow 2006-2008
3 (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 -}
5
6 {-# LANGUAGE CPP, NondecreasingIndentation #-}
7 {-# LANGUAGE MultiWayIf #-}
8
9 -- | Module for constructing @ModIface@ values (interface files),
10 -- writing them to disk and comparing two versions to see if
11 -- recompilation is required.
12 module MkIface (
13 mkIface, -- Build a ModIface from a ModGuts,
14 -- including computing version information
15
16 mkIfaceTc,
17
18 writeIfaceFile, -- Write the interface file
19
20 checkOldIface, -- See if recompilation is required, by
21 -- comparing version information
22 RecompileRequired(..), recompileRequired,
23 mkIfaceExports,
24
25 coAxiomToIfaceDecl,
26 tyThingToIfaceDecl -- Converting things to their Iface equivalents
27 ) where
28
29 {-
30 -----------------------------------------------
31 Recompilation checking
32 -----------------------------------------------
33
34 A complete description of how recompilation checking works can be
35 found in the wiki commentary:
36
37 https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance
38
39 Please read the above page for a top-down description of how this all
40 works. Notes below cover specific issues related to the implementation.
41
42 Basic idea:
43
44 * In the mi_usages information in an interface, we record the
45 fingerprint of each free variable of the module
46
47 * In mkIface, we compute the fingerprint of each exported thing A.f.
48 For each external thing that A.f refers to, we include the fingerprint
49 of the external reference when computing the fingerprint of A.f. So
50 if anything that A.f depends on changes, then A.f's fingerprint will
51 change.
52 Also record any dependent files added with
53 * addDependentFile
54 * #include
55 * -optP-include
56
57 * In checkOldIface we compare the mi_usages for the module with
58 the actual fingerprint for all each thing recorded in mi_usages
59 -}
60
61 #include "HsVersions.h"
62
63 import GhcPrelude
64
65 import IfaceSyn
66 import BinFingerprint
67 import LoadIface
68 import ToIface
69 import FlagChecker
70
71 import DsUsage ( mkUsageInfo, mkUsedNames, mkDependencies )
72 import Id
73 import Annotations
74 import CoreSyn
75 import Class
76 import TyCon
77 import CoAxiom
78 import ConLike
79 import DataCon
80 import Type
81 import TcType
82 import InstEnv
83 import FamInstEnv
84 import TcRnMonad
85 import HsSyn
86 import HscTypes
87 import Finder
88 import DynFlags
89 import VarEnv
90 import Var
91 import Name
92 import Avail
93 import RdrName
94 import NameEnv
95 import NameSet
96 import Module
97 import BinIface
98 import ErrUtils
99 import Digraph
100 import SrcLoc
101 import Outputable
102 import BasicTypes hiding ( SuccessFlag(..) )
103 import Unique
104 import Util hiding ( eqListBy )
105 import FastString
106 import Maybes
107 import Binary
108 import Fingerprint
109 import Exception
110 import UniqSet
111 import Packages
112 import ExtractDocs
113
114 import Control.Monad
115 import Data.Function
116 import Data.List
117 import qualified Data.Map as Map
118 import qualified Data.Set as Set
119 import Data.Ord
120 import Data.IORef
121 import System.Directory
122 import System.FilePath
123 import Plugins ( PluginRecompile(..), PluginWithArgs(..), LoadedPlugin(..),
124 pluginRecompile', plugins )
125
126 --Qualified import so we can define a Semigroup instance
127 -- but it doesn't clash with Outputable.<>
128 import qualified Data.Semigroup
129
130 {-
131 ************************************************************************
132 * *
133 \subsection{Completing an interface}
134 * *
135 ************************************************************************
136 -}
137
138 mkIface :: HscEnv
139 -> Maybe Fingerprint -- The old fingerprint, if we have it
140 -> ModDetails -- The trimmed, tidied interface
141 -> ModGuts -- Usages, deprecations, etc
142 -> IO (ModIface, -- The new one
143 Bool) -- True <=> there was an old Iface, and the
144 -- new one is identical, so no need
145 -- to write it
146
147 mkIface hsc_env maybe_old_fingerprint mod_details
148 ModGuts{ mg_module = this_mod,
149 mg_hsc_src = hsc_src,
150 mg_usages = usages,
151 mg_used_th = used_th,
152 mg_deps = deps,
153 mg_rdr_env = rdr_env,
154 mg_fix_env = fix_env,
155 mg_warns = warns,
156 mg_hpc_info = hpc_info,
157 mg_safe_haskell = safe_mode,
158 mg_trust_pkg = self_trust,
159 mg_doc_hdr = doc_hdr,
160 mg_decl_docs = decl_docs,
161 mg_arg_docs = arg_docs
162 }
163 = mkIface_ hsc_env maybe_old_fingerprint
164 this_mod hsc_src used_th deps rdr_env fix_env
165 warns hpc_info self_trust
166 safe_mode usages
167 doc_hdr decl_docs arg_docs
168 mod_details
169
170 -- | make an interface from the results of typechecking only. Useful
171 -- for non-optimising compilation, or where we aren't generating any
172 -- object code at all ('HscNothing').
173 mkIfaceTc :: HscEnv
174 -> Maybe Fingerprint -- The old fingerprint, if we have it
175 -> SafeHaskellMode -- The safe haskell mode
176 -> ModDetails -- gotten from mkBootModDetails, probably
177 -> TcGblEnv -- Usages, deprecations, etc
178 -> IO (ModIface, Bool)
179 mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
180 tc_result@TcGblEnv{ tcg_mod = this_mod,
181 tcg_src = hsc_src,
182 tcg_imports = imports,
183 tcg_rdr_env = rdr_env,
184 tcg_fix_env = fix_env,
185 tcg_merged = merged,
186 tcg_warns = warns,
187 tcg_hpc = other_hpc_info,
188 tcg_th_splice_used = tc_splice_used,
189 tcg_dependent_files = dependent_files
190 }
191 = do
192 let used_names = mkUsedNames tc_result
193 let pluginModules =
194 map lpModule (cachedPlugins (hsc_dflags hsc_env))
195 deps <- mkDependencies
196 (thisInstalledUnitId (hsc_dflags hsc_env))
197 (map mi_module pluginModules) tc_result
198 let hpc_info = emptyHpcInfo other_hpc_info
199 used_th <- readIORef tc_splice_used
200 dep_files <- (readIORef dependent_files)
201 -- Do NOT use semantic module here; this_mod in mkUsageInfo
202 -- is used solely to decide if we should record a dependency
203 -- or not. When we instantiate a signature, the semantic
204 -- module is something we want to record dependencies for,
205 -- but if you pass that in here, we'll decide it's the local
206 -- module and does not need to be recorded as a dependency.
207 -- See Note [Identity versus semantic module]
208 usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names
209 dep_files merged pluginModules
210
211 let (doc_hdr', doc_map, arg_map) = extractDocs tc_result
212
213 mkIface_ hsc_env maybe_old_fingerprint
214 this_mod hsc_src
215 used_th deps rdr_env
216 fix_env warns hpc_info
217 (imp_trust_own_pkg imports) safe_mode usages
218 doc_hdr' doc_map arg_map
219 mod_details
220
221
222
223 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> HscSource
224 -> Bool -> Dependencies -> GlobalRdrEnv
225 -> NameEnv FixItem -> Warnings -> HpcInfo
226 -> Bool
227 -> SafeHaskellMode
228 -> [Usage]
229 -> Maybe HsDocString
230 -> DeclDocMap
231 -> ArgDocMap
232 -> ModDetails
233 -> IO (ModIface, Bool)
234 mkIface_ hsc_env maybe_old_fingerprint
235 this_mod hsc_src used_th deps rdr_env fix_env src_warns
236 hpc_info pkg_trust_req safe_mode usages
237 doc_hdr decl_docs arg_docs
238 ModDetails{ md_insts = insts,
239 md_fam_insts = fam_insts,
240 md_rules = rules,
241 md_anns = anns,
242 md_types = type_env,
243 md_exports = exports,
244 md_complete_sigs = complete_sigs }
245 -- NB: notice that mkIface does not look at the bindings
246 -- only at the TypeEnv. The previous Tidy phase has
247 -- put exactly the info into the TypeEnv that we want
248 -- to expose in the interface
249
250 = do
251 let semantic_mod = canonicalizeHomeModule (hsc_dflags hsc_env) (moduleName this_mod)
252 entities = typeEnvElts type_env
253 decls = [ tyThingToIfaceDecl entity
254 | entity <- entities,
255 let name = getName entity,
256 not (isImplicitTyThing entity),
257 -- No implicit Ids and class tycons in the interface file
258 not (isWiredInName name),
259 -- Nor wired-in things; the compiler knows about them anyhow
260 nameIsLocalOrFrom semantic_mod name ]
261 -- Sigh: see Note [Root-main Id] in TcRnDriver
262 -- NB: ABSOLUTELY need to check against semantic_mod,
263 -- because all of the names in an hsig p[H=<H>]:H
264 -- are going to be for <H>, not the former id!
265 -- See Note [Identity versus semantic module]
266
267 fixities = sortBy (comparing fst)
268 [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
269 -- The order of fixities returned from nameEnvElts is not
270 -- deterministic, so we sort by OccName to canonicalize it.
271 -- See Note [Deterministic UniqFM] in UniqDFM for more details.
272 warns = src_warns
273 iface_rules = map coreRuleToIfaceRule rules
274 iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode insts
275 iface_fam_insts = map famInstToIfaceFamInst fam_insts
276 trust_info = setSafeMode safe_mode
277 annotations = map mkIfaceAnnotation anns
278 icomplete_sigs = map mkIfaceCompleteSig complete_sigs
279
280 intermediate_iface = ModIface {
281 mi_module = this_mod,
282 -- Need to record this because it depends on the -instantiated-with flag
283 -- which could change
284 mi_sig_of = if semantic_mod == this_mod
285 then Nothing
286 else Just semantic_mod,
287 mi_hsc_src = hsc_src,
288 mi_deps = deps,
289 mi_usages = usages,
290 mi_exports = mkIfaceExports exports,
291
292 -- Sort these lexicographically, so that
293 -- the result is stable across compilations
294 mi_insts = sortBy cmp_inst iface_insts,
295 mi_fam_insts = sortBy cmp_fam_inst iface_fam_insts,
296 mi_rules = sortBy cmp_rule iface_rules,
297
298 mi_fixities = fixities,
299 mi_warns = warns,
300 mi_anns = annotations,
301 mi_globals = maybeGlobalRdrEnv rdr_env,
302
303 -- Left out deliberately: filled in by addFingerprints
304 mi_iface_hash = fingerprint0,
305 mi_mod_hash = fingerprint0,
306 mi_flag_hash = fingerprint0,
307 mi_opt_hash = fingerprint0,
308 mi_hpc_hash = fingerprint0,
309 mi_exp_hash = fingerprint0,
310 mi_plugin_hash = fingerprint0,
311 mi_used_th = used_th,
312 mi_orphan_hash = fingerprint0,
313 mi_orphan = False, -- Always set by addFingerprints, but
314 -- it's a strict field, so we can't omit it.
315 mi_finsts = False, -- Ditto
316 mi_decls = deliberatelyOmitted "decls",
317 mi_hash_fn = deliberatelyOmitted "hash_fn",
318 mi_hpc = isHpcUsed hpc_info,
319 mi_trust = trust_info,
320 mi_trust_pkg = pkg_trust_req,
321
322 -- And build the cached values
323 mi_warn_fn = mkIfaceWarnCache warns,
324 mi_fix_fn = mkIfaceFixCache fixities,
325 mi_complete_sigs = icomplete_sigs,
326 mi_doc_hdr = doc_hdr,
327 mi_decl_docs = decl_docs,
328 mi_arg_docs = arg_docs }
329
330 (new_iface, no_change_at_all)
331 <- {-# SCC "versioninfo" #-}
332 addFingerprints hsc_env maybe_old_fingerprint
333 intermediate_iface decls
334
335 -- Debug printing
336 dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
337 (pprModIface new_iface)
338
339 -- bug #1617: on reload we weren't updating the PrintUnqualified
340 -- correctly. This stems from the fact that the interface had
341 -- not changed, so addFingerprints returns the old ModIface
342 -- with the old GlobalRdrEnv (mi_globals).
343 let final_iface = new_iface{ mi_globals = maybeGlobalRdrEnv rdr_env }
344
345 return (final_iface, no_change_at_all)
346 where
347 cmp_rule = comparing ifRuleName
348 -- Compare these lexicographically by OccName, *not* by unique,
349 -- because the latter is not stable across compilations:
350 cmp_inst = comparing (nameOccName . ifDFun)
351 cmp_fam_inst = comparing (nameOccName . ifFamInstTcName)
352
353 dflags = hsc_dflags hsc_env
354
355 -- We only fill in mi_globals if the module was compiled to byte
356 -- code. Otherwise, the compiler may not have retained all the
357 -- top-level bindings and they won't be in the TypeEnv (see
358 -- Desugar.addExportFlagsAndRules). The mi_globals field is used
359 -- by GHCi to decide whether the module has its full top-level
360 -- scope available. (#5534)
361 maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
362 maybeGlobalRdrEnv rdr_env
363 | targetRetainsAllBindings (hscTarget dflags) = Just rdr_env
364 | otherwise = Nothing
365
366 deliberatelyOmitted :: String -> a
367 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
368
369 ifFamInstTcName = ifFamInstFam
370
371 -----------------------------
372 writeIfaceFile :: DynFlags -> FilePath -> ModIface -> IO ()
373 writeIfaceFile dflags hi_file_path new_iface
374 = do createDirectoryIfMissing True (takeDirectory hi_file_path)
375 writeBinIface dflags hi_file_path new_iface
376
377
378 -- -----------------------------------------------------------------------------
379 -- Look up parents and versions of Names
380
381 -- This is like a global version of the mi_hash_fn field in each ModIface.
382 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
383 -- the parent and version info.
384
385 mkHashFun
386 :: HscEnv -- needed to look up versions
387 -> ExternalPackageState -- ditto
388 -> (Name -> IO Fingerprint)
389 mkHashFun hsc_env eps name
390 | isHoleModule orig_mod
391 = lookup (mkModule (thisPackage dflags) (moduleName orig_mod))
392 | otherwise
393 = lookup orig_mod
394 where
395 dflags = hsc_dflags hsc_env
396 hpt = hsc_HPT hsc_env
397 pit = eps_PIT eps
398 occ = nameOccName name
399 orig_mod = nameModule name
400 lookup mod = do
401 MASSERT2( isExternalName name, ppr name )
402 iface <- case lookupIfaceByModule dflags hpt pit mod of
403 Just iface -> return iface
404 Nothing -> do
405 -- This can occur when we're writing out ifaces for
406 -- requirements; we didn't do any /real/ typechecking
407 -- so there's no guarantee everything is loaded.
408 -- Kind of a heinous hack.
409 iface <- initIfaceLoad hsc_env . withException
410 $ loadInterface (text "lookupVers2") mod ImportBySystem
411 return iface
412 return $ snd (mi_hash_fn iface occ `orElse`
413 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
414
415 -- ---------------------------------------------------------------------------
416 -- Compute fingerprints for the interface
417
418 {-
419 Note [Fingerprinting IfaceDecls]
420 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
421
422 The general idea here is that we first examine the 'IfaceDecl's and determine
423 the recursive groups of them. We then walk these groups in dependency order,
424 serializing each contained 'IfaceDecl' to a "Binary" buffer which we then
425 hash using MD5 to produce a fingerprint for the group.
426
427 However, the serialization that we use is a bit funny: we override the @putName@
428 operation with our own which serializes the hash of a 'Name' instead of the
429 'Name' itself. This ensures that the fingerprint of a decl changes if anything
430 in its transitive closure changes. This trick is why we must be careful about
431 traversing in dependency order: we need to ensure that we have hashes for
432 everything referenced by the decl which we are fingerprinting.
433
434 Moreover, we need to be careful to distinguish between serialization of binding
435 Names (e.g. the ifName field of a IfaceDecl) and non-binding (e.g. the ifInstCls
436 field of a IfaceClsInst): only in the non-binding case should we include the
437 fingerprint; in the binding case we shouldn't since it is merely the name of the
438 thing that we are currently fingerprinting.
439 -}
440
441 -- | Add fingerprints for top-level declarations to a 'ModIface'.
442 --
443 -- See Note [Fingerprinting IfaceDecls]
444 addFingerprints
445 :: HscEnv
446 -> Maybe Fingerprint -- the old fingerprint, if any
447 -> ModIface -- The new interface (lacking decls)
448 -> [IfaceDecl] -- The new decls
449 -> IO (ModIface, -- Updated interface
450 Bool) -- True <=> no changes at all;
451 -- no need to write Iface
452
453 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
454 = do
455 eps <- hscEPS hsc_env
456 let
457 -- The ABI of a declaration represents everything that is made
458 -- visible about the declaration that a client can depend on.
459 -- see IfaceDeclABI below.
460 declABI :: IfaceDecl -> IfaceDeclABI
461 -- TODO: I'm not sure if this should be semantic_mod or this_mod.
462 -- See also Note [Identity versus semantic module]
463 declABI decl = (this_mod, decl, extras)
464 where extras = declExtras fix_fn ann_fn non_orph_rules non_orph_insts
465 non_orph_fis top_lvl_name_env decl
466
467 -- This is used for looking up the Name of a default method
468 -- from its OccName. See Note [default method Name]
469 top_lvl_name_env =
470 mkOccEnv [ (nameOccName nm, nm)
471 | IfaceId { ifName = nm } <- new_decls ]
472
473 -- Dependency edges between declarations in the current module.
474 -- This is computed by finding the free external names of each
475 -- declaration, including IfaceDeclExtras (things that a
476 -- declaration implicitly depends on).
477 edges :: [ Node Unique IfaceDeclABI ]
478 edges = [ DigraphNode abi (getUnique (getOccName decl)) out
479 | decl <- new_decls
480 , let abi = declABI decl
481 , let out = localOccs $ freeNamesDeclABI abi
482 ]
483
484 name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
485 localOccs =
486 map (getUnique . getParent . getOccName)
487 -- NB: names always use semantic module, so
488 -- filtering must be on the semantic module!
489 -- See Note [Identity versus semantic module]
490 . filter ((== semantic_mod) . name_module)
491 . nonDetEltsUniqSet
492 -- It's OK to use nonDetEltsUFM as localOccs is only
493 -- used to construct the edges and
494 -- stronglyConnCompFromEdgedVertices is deterministic
495 -- even with non-deterministic order of edges as
496 -- explained in Note [Deterministic SCC] in Digraph.
497 where getParent :: OccName -> OccName
498 getParent occ = lookupOccEnv parent_map occ `orElse` occ
499
500 -- maps OccNames to their parents in the current module.
501 -- e.g. a reference to a constructor must be turned into a reference
502 -- to the TyCon for the purposes of calculating dependencies.
503 parent_map :: OccEnv OccName
504 parent_map = foldl' extend emptyOccEnv new_decls
505 where extend env d =
506 extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ]
507 where n = getOccName d
508
509 -- Strongly-connected groups of declarations, in dependency order
510 groups :: [SCC IfaceDeclABI]
511 groups = stronglyConnCompFromEdgedVerticesUniq edges
512
513 global_hash_fn = mkHashFun hsc_env eps
514
515 -- How to output Names when generating the data to fingerprint.
516 -- Here we want to output the fingerprint for each top-level
517 -- Name, whether it comes from the current module or another
518 -- module. In this way, the fingerprint for a declaration will
519 -- change if the fingerprint for anything it refers to (transitively)
520 -- changes.
521 mk_put_name :: OccEnv (OccName,Fingerprint)
522 -> BinHandle -> Name -> IO ()
523 mk_put_name local_env bh name
524 | isWiredInName name = putNameLiterally bh name
525 -- wired-in names don't have fingerprints
526 | otherwise
527 = ASSERT2( isExternalName name, ppr name )
528 let hash | nameModule name /= semantic_mod = global_hash_fn name
529 -- Get it from the REAL interface!!
530 -- This will trigger when we compile an hsig file
531 -- and we know a backing impl for it.
532 -- See Note [Identity versus semantic module]
533 | semantic_mod /= this_mod
534 , not (isHoleModule semantic_mod) = global_hash_fn name
535 | otherwise = return (snd (lookupOccEnv local_env (getOccName name)
536 `orElse` pprPanic "urk! lookup local fingerprint"
537 (ppr name $$ ppr local_env)))
538 -- This panic indicates that we got the dependency
539 -- analysis wrong, because we needed a fingerprint for
540 -- an entity that wasn't in the environment. To debug
541 -- it, turn the panic into a trace, uncomment the
542 -- pprTraces below, run the compile again, and inspect
543 -- the output and the generated .hi file with
544 -- --show-iface.
545 in hash >>= put_ bh
546
547 -- take a strongly-connected group of declarations and compute
548 -- its fingerprint.
549
550 fingerprint_group :: (OccEnv (OccName,Fingerprint),
551 [(Fingerprint,IfaceDecl)])
552 -> SCC IfaceDeclABI
553 -> IO (OccEnv (OccName,Fingerprint),
554 [(Fingerprint,IfaceDecl)])
555
556 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
557 = do let hash_fn = mk_put_name local_env
558 decl = abiDecl abi
559 --pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
560 hash <- computeFingerprint hash_fn abi
561 env' <- extend_hash_env local_env (hash,decl)
562 return (env', (hash,decl) : decls_w_hashes)
563
564 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
565 = do let decls = map abiDecl abis
566 local_env1 <- foldM extend_hash_env local_env
567 (zip (repeat fingerprint0) decls)
568 let hash_fn = mk_put_name local_env1
569 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
570 let stable_abis = sortBy cmp_abiNames abis
571 -- put the cycle in a canonical order
572 hash <- computeFingerprint hash_fn stable_abis
573 let pairs = zip (repeat hash) decls
574 local_env2 <- foldM extend_hash_env local_env pairs
575 return (local_env2, pairs ++ decls_w_hashes)
576
577 -- we have fingerprinted the whole declaration, but we now need
578 -- to assign fingerprints to all the OccNames that it binds, to
579 -- use when referencing those OccNames in later declarations.
580 --
581 extend_hash_env :: OccEnv (OccName,Fingerprint)
582 -> (Fingerprint,IfaceDecl)
583 -> IO (OccEnv (OccName,Fingerprint))
584 extend_hash_env env0 (hash,d) = do
585 return (foldr (\(b,fp) env -> extendOccEnv env b (b,fp)) env0
586 (ifaceDeclFingerprints hash d))
587
588 --
589 (local_env, decls_w_hashes) <-
590 foldM fingerprint_group (emptyOccEnv, []) groups
591
592 -- when calculating fingerprints, we always need to use canonical
593 -- ordering for lists of things. In particular, the mi_deps has various
594 -- lists of modules and suchlike, so put these all in canonical order:
595 let sorted_deps = sortDependencies (mi_deps iface0)
596
597 -- The export hash of a module depends on the orphan hashes of the
598 -- orphan modules below us in the dependency tree. This is the way
599 -- that changes in orphans get propagated all the way up the
600 -- dependency tree.
601 --
602 -- Note [A bad dep_orphs optimization]
603 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
604 -- In a previous version of this code, we filtered out orphan modules which
605 -- were not from the home package, justifying it by saying that "we'd
606 -- pick up the ABI hashes of the external module instead". This is wrong.
607 -- Suppose that we have:
608 --
609 -- module External where
610 -- instance Show (a -> b)
611 --
612 -- module Home1 where
613 -- import External
614 --
615 -- module Home2 where
616 -- import Home1
617 --
618 -- The export hash of Home1 needs to reflect the orphan instances of
619 -- External. It's true that Home1 will get rebuilt if the orphans
620 -- of External, but we also need to make sure Home2 gets rebuilt
621 -- as well. See #12733 for more details.
622 let orph_mods
623 = filter (/= this_mod) -- Note [Do not update EPS with your own hi-boot]
624 $ dep_orphs sorted_deps
625 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
626
627 -- Note [Do not update EPS with your own hi-boot]
628 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
629 -- (See also #10182). When your hs-boot file includes an orphan
630 -- instance declaration, you may find that the dep_orphs of a module you
631 -- import contains reference to yourself. DO NOT actually load this module
632 -- or add it to the orphan hashes: you're going to provide the orphan
633 -- instances yourself, no need to consult hs-boot; if you do load the
634 -- interface into EPS, you will see a duplicate orphan instance.
635
636 orphan_hash <- computeFingerprint (mk_put_name local_env)
637 (map ifDFun orph_insts, orph_rules, orph_fis)
638
639 -- the export list hash doesn't depend on the fingerprints of
640 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
641 export_hash <- computeFingerprint putNameLiterally
642 (mi_exports iface0,
643 orphan_hash,
644 dep_orphan_hashes,
645 dep_pkgs (mi_deps iface0),
646 -- See Note [Export hash depends on non-orphan family instances]
647 dep_finsts (mi_deps iface0),
648 -- dep_pkgs: see "Package Version Changes" on
649 -- wiki/commentary/compiler/recompilation-avoidance
650 mi_trust iface0)
651 -- Make sure change of Safe Haskell mode causes recomp.
652
653 -- Note [Export hash depends on non-orphan family instances]
654 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
655 --
656 -- Suppose we have:
657 --
658 -- module A where
659 -- type instance F Int = Bool
660 --
661 -- module B where
662 -- import A
663 --
664 -- module C where
665 -- import B
666 --
667 -- The family instance consistency check for C depends on the dep_finsts of
668 -- B. If we rename module A to A2, when the dep_finsts of B changes, we need
669 -- to make sure that C gets rebuilt. Effectively, the dep_finsts are part of
670 -- the exports of B, because C always considers them when checking
671 -- consistency.
672 --
673 -- A full discussion is in #12723.
674 --
675 -- We do NOT need to hash dep_orphs, because this is implied by
676 -- dep_orphan_hashes, and we do not need to hash ordinary class instances,
677 -- because there is no eager consistency check as there is with type families
678 -- (also we didn't store it anywhere!)
679 --
680
681 -- put the declarations in a canonical order, sorted by OccName
682 let sorted_decls = Map.elems $ Map.fromList $
683 [(getOccName d, e) | e@(_, d) <- decls_w_hashes]
684
685 -- the flag hash depends on:
686 -- - (some of) dflags
687 -- it returns two hashes, one that shouldn't change
688 -- the abi hash and one that should
689 flag_hash <- fingerprintDynFlags dflags this_mod putNameLiterally
690
691 opt_hash <- fingerprintOptFlags dflags putNameLiterally
692
693 hpc_hash <- fingerprintHpcFlags dflags putNameLiterally
694
695 plugin_hash <- fingerprintPlugins hsc_env
696
697 -- the ABI hash depends on:
698 -- - decls
699 -- - export list
700 -- - orphans
701 -- - deprecations
702 -- - flag abi hash
703 mod_hash <- computeFingerprint putNameLiterally
704 (map fst sorted_decls,
705 export_hash, -- includes orphan_hash
706 mi_warns iface0)
707
708 -- The interface hash depends on:
709 -- - the ABI hash, plus
710 -- - the module level annotations,
711 -- - usages
712 -- - deps (home and external packages, dependent files)
713 -- - hpc
714 iface_hash <- computeFingerprint putNameLiterally
715 (mod_hash,
716 ann_fn (mkVarOcc "module"), -- See mkIfaceAnnCache
717 mi_usages iface0,
718 sorted_deps,
719 mi_hpc iface0)
720
721 let
722 no_change_at_all = Just iface_hash == mb_old_fingerprint
723
724 final_iface = iface0 {
725 mi_mod_hash = mod_hash,
726 mi_iface_hash = iface_hash,
727 mi_exp_hash = export_hash,
728 mi_orphan_hash = orphan_hash,
729 mi_flag_hash = flag_hash,
730 mi_opt_hash = opt_hash,
731 mi_hpc_hash = hpc_hash,
732 mi_plugin_hash = plugin_hash,
733 mi_orphan = not ( all ifRuleAuto orph_rules
734 -- See Note [Orphans and auto-generated rules]
735 && null orph_insts
736 && null orph_fis),
737 mi_finsts = not . null $ mi_fam_insts iface0,
738 mi_decls = sorted_decls,
739 mi_hash_fn = lookupOccEnv local_env }
740 --
741 return (final_iface, no_change_at_all)
742
743 where
744 this_mod = mi_module iface0
745 semantic_mod = mi_semantic_module iface0
746 dflags = hsc_dflags hsc_env
747 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
748 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
749 (non_orph_fis, orph_fis) = mkOrphMap ifFamInstOrph (mi_fam_insts iface0)
750 fix_fn = mi_fix_fn iface0
751 ann_fn = mkIfaceAnnCache (mi_anns iface0)
752
753 -- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules
754 -- (in particular, the orphan modules which are transitively imported by the
755 -- current module).
756 --
757 -- Q: Why do we need the hash at all, doesn't the list of transitively
758 -- imported orphan modules suffice?
759 --
760 -- A: If one of our transitive imports adds a new orphan instance, our
761 -- export hash must change so that modules which import us rebuild. If we just
762 -- hashed the [Module], the hash would not change even when a new instance was
763 -- added to a module that already had an orphan instance.
764 --
765 -- Q: Why don't we just hash the orphan hashes of our direct dependencies?
766 -- Why the full transitive closure?
767 --
768 -- A: Suppose we have these modules:
769 --
770 -- module A where
771 -- instance Show (a -> b) where
772 -- module B where
773 -- import A -- **
774 -- module C where
775 -- import A
776 -- import B
777 --
778 -- Whether or not we add or remove the import to A in B affects the
779 -- orphan hash of B. But it shouldn't really affect the orphan hash
780 -- of C. If we hashed only direct dependencies, there would be no
781 -- way to tell that the net effect was a wash, and we'd be forced
782 -- to recompile C and everything else.
783 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
784 getOrphanHashes hsc_env mods = do
785 eps <- hscEPS hsc_env
786 let
787 hpt = hsc_HPT hsc_env
788 pit = eps_PIT eps
789 dflags = hsc_dflags hsc_env
790 get_orph_hash mod =
791 case lookupIfaceByModule dflags hpt pit mod of
792 Just iface -> return (mi_orphan_hash iface)
793 Nothing -> do -- similar to 'mkHashFun'
794 iface <- initIfaceLoad hsc_env . withException
795 $ loadInterface (text "getOrphanHashes") mod ImportBySystem
796 return (mi_orphan_hash iface)
797
798 --
799 mapM get_orph_hash mods
800
801
802 sortDependencies :: Dependencies -> Dependencies
803 sortDependencies d
804 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
805 dep_pkgs = sortBy (compare `on` fst) (dep_pkgs d),
806 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
807 dep_finsts = sortBy stableModuleCmp (dep_finsts d),
808 dep_plgins = sortBy (compare `on` moduleNameFS) (dep_plgins d) }
809
810 -- | Creates cached lookup for the 'mi_anns' field of ModIface
811 -- Hackily, we use "module" as the OccName for any module-level annotations
812 mkIfaceAnnCache :: [IfaceAnnotation] -> OccName -> [AnnPayload]
813 mkIfaceAnnCache anns
814 = \n -> lookupOccEnv env n `orElse` []
815 where
816 pair (IfaceAnnotation target value) =
817 (case target of
818 NamedTarget occn -> occn
819 ModuleTarget _ -> mkVarOcc "module"
820 , [value])
821 -- flipping (++), so the first argument is always short
822 env = mkOccEnv_C (flip (++)) (map pair anns)
823
824 {-
825 ************************************************************************
826 * *
827 The ABI of an IfaceDecl
828 * *
829 ************************************************************************
830
831 Note [The ABI of an IfaceDecl]
832 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
833 The ABI of a declaration consists of:
834
835 (a) the full name of the identifier (inc. module and package,
836 because these are used to construct the symbol name by which
837 the identifier is known externally).
838
839 (b) the declaration itself, as exposed to clients. That is, the
840 definition of an Id is included in the fingerprint only if
841 it is made available as an unfolding in the interface.
842
843 (c) the fixity of the identifier (if it exists)
844 (d) for Ids: rules
845 (e) for classes: instances, fixity & rules for methods
846 (f) for datatypes: instances, fixity & rules for constrs
847
848 Items (c)-(f) are not stored in the IfaceDecl, but instead appear
849 elsewhere in the interface file. But they are *fingerprinted* with
850 the declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
851 and fingerprinting that as part of the declaration.
852 -}
853
854 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
855
856 data IfaceDeclExtras
857 = IfaceIdExtras IfaceIdExtras
858
859 | IfaceDataExtras
860 (Maybe Fixity) -- Fixity of the tycon itself (if it exists)
861 [IfaceInstABI] -- Local class and family instances of this tycon
862 -- See Note [Orphans] in InstEnv
863 [AnnPayload] -- Annotations of the type itself
864 [IfaceIdExtras] -- For each constructor: fixity, RULES and annotations
865
866 | IfaceClassExtras
867 (Maybe Fixity) -- Fixity of the class itself (if it exists)
868 [IfaceInstABI] -- Local instances of this class *or*
869 -- of its associated data types
870 -- See Note [Orphans] in InstEnv
871 [AnnPayload] -- Annotations of the type itself
872 [IfaceIdExtras] -- For each class method: fixity, RULES and annotations
873 [IfExtName] -- Default methods. If a module
874 -- mentions a class, then it can
875 -- instantiate the class and thereby
876 -- use the default methods, so we must
877 -- include these in the fingerprint of
878 -- a class.
879
880 | IfaceSynonymExtras (Maybe Fixity) [AnnPayload]
881
882 | IfaceFamilyExtras (Maybe Fixity) [IfaceInstABI] [AnnPayload]
883
884 | IfaceOtherDeclExtras
885
886 data IfaceIdExtras
887 = IdExtras
888 (Maybe Fixity) -- Fixity of the Id (if it exists)
889 [IfaceRule] -- Rules for the Id
890 [AnnPayload] -- Annotations for the Id
891
892 -- When hashing a class or family instance, we hash only the
893 -- DFunId or CoAxiom, because that depends on all the
894 -- information about the instance.
895 --
896 type IfaceInstABI = IfExtName -- Name of DFunId or CoAxiom that is evidence for the instance
897
898 abiDecl :: IfaceDeclABI -> IfaceDecl
899 abiDecl (_, decl, _) = decl
900
901 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
902 cmp_abiNames abi1 abi2 = getOccName (abiDecl abi1) `compare`
903 getOccName (abiDecl abi2)
904
905 freeNamesDeclABI :: IfaceDeclABI -> NameSet
906 freeNamesDeclABI (_mod, decl, extras) =
907 freeNamesIfDecl decl `unionNameSet` freeNamesDeclExtras extras
908
909 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
910 freeNamesDeclExtras (IfaceIdExtras id_extras)
911 = freeNamesIdExtras id_extras
912 freeNamesDeclExtras (IfaceDataExtras _ insts _ subs)
913 = unionNameSets (mkNameSet insts : map freeNamesIdExtras subs)
914 freeNamesDeclExtras (IfaceClassExtras _ insts _ subs defms)
915 = unionNameSets $
916 mkNameSet insts : mkNameSet defms : map freeNamesIdExtras subs
917 freeNamesDeclExtras (IfaceSynonymExtras _ _)
918 = emptyNameSet
919 freeNamesDeclExtras (IfaceFamilyExtras _ insts _)
920 = mkNameSet insts
921 freeNamesDeclExtras IfaceOtherDeclExtras
922 = emptyNameSet
923
924 freeNamesIdExtras :: IfaceIdExtras -> NameSet
925 freeNamesIdExtras (IdExtras _ rules _) = unionNameSets (map freeNamesIfRule rules)
926
927 instance Outputable IfaceDeclExtras where
928 ppr IfaceOtherDeclExtras = Outputable.empty
929 ppr (IfaceIdExtras extras) = ppr_id_extras extras
930 ppr (IfaceSynonymExtras fix anns) = vcat [ppr fix, ppr anns]
931 ppr (IfaceFamilyExtras fix finsts anns) = vcat [ppr fix, ppr finsts, ppr anns]
932 ppr (IfaceDataExtras fix insts anns stuff) = vcat [ppr fix, ppr_insts insts, ppr anns,
933 ppr_id_extras_s stuff]
934 ppr (IfaceClassExtras fix insts anns stuff defms) =
935 vcat [ppr fix, ppr_insts insts, ppr anns,
936 ppr_id_extras_s stuff, ppr defms]
937
938 ppr_insts :: [IfaceInstABI] -> SDoc
939 ppr_insts _ = text "<insts>"
940
941 ppr_id_extras_s :: [IfaceIdExtras] -> SDoc
942 ppr_id_extras_s stuff = vcat (map ppr_id_extras stuff)
943
944 ppr_id_extras :: IfaceIdExtras -> SDoc
945 ppr_id_extras (IdExtras fix rules anns) = ppr fix $$ vcat (map ppr rules) $$ vcat (map ppr anns)
946
947 -- This instance is used only to compute fingerprints
948 instance Binary IfaceDeclExtras where
949 get _bh = panic "no get for IfaceDeclExtras"
950 put_ bh (IfaceIdExtras extras) = do
951 putByte bh 1; put_ bh extras
952 put_ bh (IfaceDataExtras fix insts anns cons) = do
953 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh anns; put_ bh cons
954 put_ bh (IfaceClassExtras fix insts anns methods defms) = do
955 putByte bh 3
956 put_ bh fix
957 put_ bh insts
958 put_ bh anns
959 put_ bh methods
960 put_ bh defms
961 put_ bh (IfaceSynonymExtras fix anns) = do
962 putByte bh 4; put_ bh fix; put_ bh anns
963 put_ bh (IfaceFamilyExtras fix finsts anns) = do
964 putByte bh 5; put_ bh fix; put_ bh finsts; put_ bh anns
965 put_ bh IfaceOtherDeclExtras = putByte bh 6
966
967 instance Binary IfaceIdExtras where
968 get _bh = panic "no get for IfaceIdExtras"
969 put_ bh (IdExtras fix rules anns)= do { put_ bh fix; put_ bh rules; put_ bh anns }
970
971 declExtras :: (OccName -> Maybe Fixity)
972 -> (OccName -> [AnnPayload])
973 -> OccEnv [IfaceRule]
974 -> OccEnv [IfaceClsInst]
975 -> OccEnv [IfaceFamInst]
976 -> OccEnv IfExtName -- lookup default method names
977 -> IfaceDecl
978 -> IfaceDeclExtras
979
980 declExtras fix_fn ann_fn rule_env inst_env fi_env dm_env decl
981 = case decl of
982 IfaceId{} -> IfaceIdExtras (id_extras n)
983 IfaceData{ifCons=cons} ->
984 IfaceDataExtras (fix_fn n)
985 (map ifFamInstAxiom (lookupOccEnvL fi_env n) ++
986 map ifDFun (lookupOccEnvL inst_env n))
987 (ann_fn n)
988 (map (id_extras . occName . ifConName) (visibleIfConDecls cons))
989 IfaceClass{ifBody = IfConcreteClass { ifSigs=sigs, ifATs=ats }} ->
990 IfaceClassExtras (fix_fn n) insts (ann_fn n) meths defms
991 where
992 insts = (map ifDFun $ (concatMap at_extras ats)
993 ++ lookupOccEnvL inst_env n)
994 -- Include instances of the associated types
995 -- as well as instances of the class (#5147)
996 meths = [id_extras (getOccName op) | IfaceClassOp op _ _ <- sigs]
997 -- Names of all the default methods (see Note [default method Name])
998 defms = [ dmName
999 | IfaceClassOp bndr _ (Just _) <- sigs
1000 , let dmOcc = mkDefaultMethodOcc (nameOccName bndr)
1001 , Just dmName <- [lookupOccEnv dm_env dmOcc] ]
1002 IfaceSynonym{} -> IfaceSynonymExtras (fix_fn n)
1003 (ann_fn n)
1004 IfaceFamily{} -> IfaceFamilyExtras (fix_fn n)
1005 (map ifFamInstAxiom (lookupOccEnvL fi_env n))
1006 (ann_fn n)
1007 _other -> IfaceOtherDeclExtras
1008 where
1009 n = getOccName decl
1010 id_extras occ = IdExtras (fix_fn occ) (lookupOccEnvL rule_env occ) (ann_fn occ)
1011 at_extras (IfaceAT decl _) = lookupOccEnvL inst_env (getOccName decl)
1012
1013
1014 {- Note [default method Name] (see also #15970)
1015
1016 The Names for the default methods aren't available in the IfaceSyn.
1017
1018 * We originally start with a DefMethInfo from the class, contain a
1019 Name for the default method
1020
1021 * We turn that into IfaceSyn as a DefMethSpec which lacks a Name
1022 entirely. Why? Because the Name can be derived from the method name
1023 (in TcIface), so doesn't need to be serialised into the interface
1024 file.
1025
1026 But now we have to get the Name back, because the class declaration's
1027 fingerprint needs to depend on it (this was the bug in #15970). This
1028 is done in a slightly convoluted way:
1029
1030 * Then, in addFingerprints we build a map that maps OccNames to Names
1031
1032 * We pass that map to declExtras which laboriously looks up in the map
1033 (using the derived occurrence name) to recover the Name we have just
1034 thrown away.
1035 -}
1036
1037 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
1038 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
1039
1040 {-
1041 -- for testing: use the md5sum command to generate fingerprints and
1042 -- compare the results against our built-in version.
1043 fp' <- oldMD5 dflags bh
1044 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
1045 else return fp
1046
1047 oldMD5 dflags bh = do
1048 tmp <- newTempName dflags CurrentModule "bin"
1049 writeBinMem bh tmp
1050 tmp2 <- newTempName dflags CurrentModule "md5"
1051 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
1052 r <- system cmd
1053 case r of
1054 ExitFailure _ -> throwGhcExceptionIO (PhaseFailed cmd r)
1055 ExitSuccess -> do
1056 hash_str <- readFile tmp2
1057 return $! readHexFingerprint hash_str
1058 -}
1059
1060 ----------------------
1061 -- mkOrphMap partitions instance decls or rules into
1062 -- (a) an OccEnv for ones that are not orphans,
1063 -- mapping the local OccName to a list of its decls
1064 -- (b) a list of orphan decls
1065 mkOrphMap :: (decl -> IsOrphan) -- Extract orphan status from decl
1066 -> [decl] -- Sorted into canonical order
1067 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
1068 -- each sublist in canonical order
1069 [decl]) -- Orphan decls; in canonical order
1070 mkOrphMap get_key decls
1071 = foldl' go (emptyOccEnv, []) decls
1072 where
1073 go (non_orphs, orphs) d
1074 | NotOrphan occ <- get_key d
1075 = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
1076 | otherwise = (non_orphs, d:orphs)
1077
1078 {-
1079 ************************************************************************
1080 * *
1081 COMPLETE Pragmas
1082 * *
1083 ************************************************************************
1084 -}
1085
1086 mkIfaceCompleteSig :: CompleteMatch -> IfaceCompleteMatch
1087 mkIfaceCompleteSig (CompleteMatch cls tc) = IfaceCompleteMatch cls tc
1088
1089
1090 {-
1091 ************************************************************************
1092 * *
1093 Keeping track of what we've slurped, and fingerprints
1094 * *
1095 ************************************************************************
1096 -}
1097
1098
1099 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
1100 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = payload })
1101 = IfaceAnnotation {
1102 ifAnnotatedTarget = fmap nameOccName target,
1103 ifAnnotatedValue = payload
1104 }
1105
1106 mkIfaceExports :: [AvailInfo] -> [IfaceExport] -- Sort to make canonical
1107 mkIfaceExports exports
1108 = sortBy stableAvailCmp (map sort_subs exports)
1109 where
1110 sort_subs :: AvailInfo -> AvailInfo
1111 sort_subs (Avail n) = Avail n
1112 sort_subs (AvailTC n [] fs) = AvailTC n [] (sort_flds fs)
1113 sort_subs (AvailTC n (m:ms) fs)
1114 | n==m = AvailTC n (m:sortBy stableNameCmp ms) (sort_flds fs)
1115 | otherwise = AvailTC n (sortBy stableNameCmp (m:ms)) (sort_flds fs)
1116 -- Maintain the AvailTC Invariant
1117
1118 sort_flds = sortBy (stableNameCmp `on` flSelector)
1119
1120 {-
1121 Note [Original module]
1122 ~~~~~~~~~~~~~~~~~~~~~
1123 Consider this:
1124 module X where { data family T }
1125 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
1126 The exported Avail from Y will look like
1127 X.T{X.T, Y.MkT}
1128 That is, in Y,
1129 - only MkT is brought into scope by the data instance;
1130 - but the parent (used for grouping and naming in T(..) exports) is X.T
1131 - and in this case we export X.T too
1132
1133 In the result of MkIfaceExports, the names are grouped by defining module,
1134 so we may need to split up a single Avail into multiple ones.
1135
1136 Note [Internal used_names]
1137 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1138 Most of the used_names are External Names, but we can have Internal
1139 Names too: see Note [Binders in Template Haskell] in Convert, and
1140 #5362 for an example. Such Names are always
1141 - Such Names are always for locally-defined things, for which we
1142 don't gather usage info, so we can just ignore them in ent_map
1143 - They are always System Names, hence the assert, just as a double check.
1144
1145
1146 ************************************************************************
1147 * *
1148 Load the old interface file for this module (unless
1149 we have it already), and check whether it is up to date
1150 * *
1151 ************************************************************************
1152 -}
1153
1154 data RecompileRequired
1155 = UpToDate
1156 -- ^ everything is up to date, recompilation is not required
1157 | MustCompile
1158 -- ^ The .hs file has been touched, or the .o/.hi file does not exist
1159 | RecompBecause String
1160 -- ^ The .o/.hi files are up to date, but something else has changed
1161 -- to force recompilation; the String says what (one-line summary)
1162 deriving Eq
1163
1164 instance Semigroup RecompileRequired where
1165 UpToDate <> r = r
1166 mc <> _ = mc
1167
1168 instance Monoid RecompileRequired where
1169 mempty = UpToDate
1170
1171 recompileRequired :: RecompileRequired -> Bool
1172 recompileRequired UpToDate = False
1173 recompileRequired _ = True
1174
1175
1176
1177 -- | Top level function to check if the version of an old interface file
1178 -- is equivalent to the current source file the user asked us to compile.
1179 -- If the same, we can avoid recompilation. We return a tuple where the
1180 -- first element is a bool saying if we should recompile the object file
1181 -- and the second is maybe the interface file, where Nothing means to
1182 -- rebuild the interface file and not use the existing one.
1183 checkOldIface
1184 :: HscEnv
1185 -> ModSummary
1186 -> SourceModified
1187 -> Maybe ModIface -- Old interface from compilation manager, if any
1188 -> IO (RecompileRequired, Maybe ModIface)
1189
1190 checkOldIface hsc_env mod_summary source_modified maybe_iface
1191 = do let dflags = hsc_dflags hsc_env
1192 showPass dflags $
1193 "Checking old interface for " ++
1194 (showPpr dflags $ ms_mod mod_summary) ++
1195 " (use -ddump-hi-diffs for more details)"
1196 initIfaceCheck (text "checkOldIface") hsc_env $
1197 check_old_iface hsc_env mod_summary source_modified maybe_iface
1198
1199 check_old_iface
1200 :: HscEnv
1201 -> ModSummary
1202 -> SourceModified
1203 -> Maybe ModIface
1204 -> IfG (RecompileRequired, Maybe ModIface)
1205
1206 check_old_iface hsc_env mod_summary src_modified maybe_iface
1207 = let dflags = hsc_dflags hsc_env
1208 getIface =
1209 case maybe_iface of
1210 Just _ -> do
1211 traceIf (text "We already have the old interface for" <+>
1212 ppr (ms_mod mod_summary))
1213 return maybe_iface
1214 Nothing -> loadIface
1215
1216 loadIface = do
1217 let iface_path = msHiFilePath mod_summary
1218 read_result <- readIface (ms_mod mod_summary) iface_path
1219 case read_result of
1220 Failed err -> do
1221 traceIf (text "FYI: cannot read old interface file:" $$ nest 4 err)
1222 traceHiDiffs (text "Old interface file was invalid:" $$ nest 4 err)
1223 return Nothing
1224 Succeeded iface -> do
1225 traceIf (text "Read the interface file" <+> text iface_path)
1226 return $ Just iface
1227
1228 src_changed
1229 | gopt Opt_ForceRecomp (hsc_dflags hsc_env) = True
1230 | SourceModified <- src_modified = True
1231 | otherwise = False
1232 in do
1233 when src_changed $
1234 traceHiDiffs (nest 4 $ text "Source file changed or recompilation check turned off")
1235
1236 case src_changed of
1237 -- If the source has changed and we're in interactive mode,
1238 -- avoid reading an interface; just return the one we might
1239 -- have been supplied with.
1240 True | not (isObjectTarget $ hscTarget dflags) ->
1241 return (MustCompile, maybe_iface)
1242
1243 -- Try and read the old interface for the current module
1244 -- from the .hi file left from the last time we compiled it
1245 True -> do
1246 maybe_iface' <- getIface
1247 return (MustCompile, maybe_iface')
1248
1249 False -> do
1250 maybe_iface' <- getIface
1251 case maybe_iface' of
1252 -- We can't retrieve the iface
1253 Nothing -> return (MustCompile, Nothing)
1254
1255 -- We have got the old iface; check its versions
1256 -- even in the SourceUnmodifiedAndStable case we
1257 -- should check versions because some packages
1258 -- might have changed or gone away.
1259 Just iface -> checkVersions hsc_env mod_summary iface
1260
1261 -- | Check if a module is still the same 'version'.
1262 --
1263 -- This function is called in the recompilation checker after we have
1264 -- determined that the module M being checked hasn't had any changes
1265 -- to its source file since we last compiled M. So at this point in general
1266 -- two things may have changed that mean we should recompile M:
1267 -- * The interface export by a dependency of M has changed.
1268 -- * The compiler flags specified this time for M have changed
1269 -- in a manner that is significant for recompilation.
1270 -- We return not just if we should recompile the object file but also
1271 -- if we should rebuild the interface file.
1272 checkVersions :: HscEnv
1273 -> ModSummary
1274 -> ModIface -- Old interface
1275 -> IfG (RecompileRequired, Maybe ModIface)
1276 checkVersions hsc_env mod_summary iface
1277 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1278 ppr (mi_module iface) <> colon)
1279
1280 -- readIface will have verified that the InstalledUnitId matches,
1281 -- but we ALSO must make sure the instantiation matches up. See
1282 -- test case bkpcabal04!
1283 ; if moduleUnitId (mi_module iface) /= thisPackage (hsc_dflags hsc_env)
1284 then return (RecompBecause "-this-unit-id changed", Nothing) else do {
1285 ; recomp <- checkFlagHash hsc_env iface
1286 ; if recompileRequired recomp then return (recomp, Nothing) else do {
1287 ; recomp <- checkOptimHash hsc_env iface
1288 ; if recompileRequired recomp then return (recomp, Nothing) else do {
1289 ; recomp <- checkHpcHash hsc_env iface
1290 ; if recompileRequired recomp then return (recomp, Nothing) else do {
1291 ; recomp <- checkMergedSignatures mod_summary iface
1292 ; if recompileRequired recomp then return (recomp, Nothing) else do {
1293 ; recomp <- checkHsig mod_summary iface
1294 ; if recompileRequired recomp then return (recomp, Nothing) else do {
1295 ; recomp <- checkHie mod_summary
1296 ; if recompileRequired recomp then return (recomp, Nothing) else do {
1297 ; recomp <- checkDependencies hsc_env mod_summary iface
1298 ; if recompileRequired recomp then return (recomp, Just iface) else do {
1299 ; recomp <- checkPlugins hsc_env iface
1300 ; if recompileRequired recomp then return (recomp, Nothing) else do {
1301
1302
1303 -- Source code unchanged and no errors yet... carry on
1304 --
1305 -- First put the dependent-module info, read from the old
1306 -- interface, into the envt, so that when we look for
1307 -- interfaces we look for the right one (.hi or .hi-boot)
1308 --
1309 -- It's just temporary because either the usage check will succeed
1310 -- (in which case we are done with this module) or it'll fail (in which
1311 -- case we'll compile the module from scratch anyhow).
1312 --
1313 -- We do this regardless of compilation mode, although in --make mode
1314 -- all the dependent modules should be in the HPT already, so it's
1315 -- quite redundant
1316 ; updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1317 ; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1318 ; return (recomp, Just iface)
1319 }}}}}}}}}}
1320 where
1321 this_pkg = thisPackage (hsc_dflags hsc_env)
1322 -- This is a bit of a hack really
1323 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1324 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1325
1326 -- | Check if any plugins are requesting recompilation
1327 checkPlugins :: HscEnv -> ModIface -> IfG RecompileRequired
1328 checkPlugins hsc iface = liftIO $ do
1329 new_fingerprint <- fingerprintPlugins hsc
1330 let old_fingerprint = mi_plugin_hash iface
1331 pr <- mconcat <$> mapM pluginRecompile' (plugins (hsc_dflags hsc))
1332 return $
1333 pluginRecompileToRecompileRequired old_fingerprint new_fingerprint pr
1334
1335 fingerprintPlugins :: HscEnv -> IO Fingerprint
1336 fingerprintPlugins hsc_env = do
1337 fingerprintPlugins' $ plugins (hsc_dflags hsc_env)
1338
1339 fingerprintPlugins' :: [PluginWithArgs] -> IO Fingerprint
1340 fingerprintPlugins' plugins = do
1341 res <- mconcat <$> mapM pluginRecompile' plugins
1342 return $ case res of
1343 NoForceRecompile -> fingerprintString "NoForceRecompile"
1344 ForceRecompile -> fingerprintString "ForceRecompile"
1345 -- is the chance of collision worth worrying about?
1346 -- An alternative is to fingerprintFingerprints [fingerprintString
1347 -- "maybeRecompile", fp]
1348 (MaybeRecompile fp) -> fp
1349
1350
1351 pluginRecompileToRecompileRequired
1352 :: Fingerprint -> Fingerprint -> PluginRecompile -> RecompileRequired
1353 pluginRecompileToRecompileRequired old_fp new_fp pr
1354 | old_fp == new_fp =
1355 case pr of
1356 NoForceRecompile -> UpToDate
1357
1358 -- we already checked the fingerprint above so a mismatch is not possible
1359 -- here, remember that: `fingerprint (MaybeRecomp x) == x`.
1360 MaybeRecompile _ -> UpToDate
1361
1362 -- when we have an impure plugin in the stack we have to unconditionally
1363 -- recompile since it might integrate all sorts of crazy IO results into
1364 -- its compilation output.
1365 ForceRecompile -> RecompBecause "Impure plugin forced recompilation"
1366
1367 | old_fp `elem` magic_fingerprints ||
1368 new_fp `elem` magic_fingerprints
1369 -- The fingerprints do not match either the old or new one is a magic
1370 -- fingerprint. This happens when non-pure plugins are added for the first
1371 -- time or when we go from one recompilation strategy to another: (force ->
1372 -- no-force, maybe-recomp -> no-force, no-force -> maybe-recomp etc.)
1373 --
1374 -- For example when we go from from ForceRecomp to NoForceRecomp
1375 -- recompilation is triggered since the old impure plugins could have
1376 -- changed the build output which is now back to normal.
1377 = RecompBecause "Plugins changed"
1378
1379 | otherwise =
1380 let reason = "Plugin fingerprint changed" in
1381 case pr of
1382 -- even though a plugin is forcing recompilation the fingerprint changed
1383 -- which would cause recompilation anyways so we report the fingerprint
1384 -- change instead.
1385 ForceRecompile -> RecompBecause reason
1386
1387 _ -> RecompBecause reason
1388
1389 where
1390 magic_fingerprints =
1391 [ fingerprintString "NoForceRecompile"
1392 , fingerprintString "ForceRecompile"
1393 ]
1394
1395
1396 -- | Check if an hsig file needs recompilation because its
1397 -- implementing module has changed.
1398 checkHsig :: ModSummary -> ModIface -> IfG RecompileRequired
1399 checkHsig mod_summary iface = do
1400 dflags <- getDynFlags
1401 let outer_mod = ms_mod mod_summary
1402 inner_mod = canonicalizeHomeModule dflags (moduleName outer_mod)
1403 MASSERT( moduleUnitId outer_mod == thisPackage dflags )
1404 case inner_mod == mi_semantic_module iface of
1405 True -> up_to_date (text "implementing module unchanged")
1406 False -> return (RecompBecause "implementing module changed")
1407
1408 -- | Check if @.hie@ file is out of date or missing.
1409 checkHie :: ModSummary -> IfG RecompileRequired
1410 checkHie mod_summary = do
1411 dflags <- getDynFlags
1412 let hie_date_opt = ms_hie_date mod_summary
1413 hs_date = ms_hs_date mod_summary
1414 pure $ case gopt Opt_WriteHie dflags of
1415 False -> UpToDate
1416 True -> case hie_date_opt of
1417 Nothing -> RecompBecause "HIE file is missing"
1418 Just hie_date
1419 | hie_date < hs_date
1420 -> RecompBecause "HIE file is out of date"
1421 | otherwise
1422 -> UpToDate
1423
1424 -- | Check the flags haven't changed
1425 checkFlagHash :: HscEnv -> ModIface -> IfG RecompileRequired
1426 checkFlagHash hsc_env iface = do
1427 let old_hash = mi_flag_hash iface
1428 new_hash <- liftIO $ fingerprintDynFlags (hsc_dflags hsc_env)
1429 (mi_module iface)
1430 putNameLiterally
1431 case old_hash == new_hash of
1432 True -> up_to_date (text "Module flags unchanged")
1433 False -> out_of_date_hash "flags changed"
1434 (text " Module flags have changed")
1435 old_hash new_hash
1436
1437 -- | Check the optimisation flags haven't changed
1438 checkOptimHash :: HscEnv -> ModIface -> IfG RecompileRequired
1439 checkOptimHash hsc_env iface = do
1440 let old_hash = mi_opt_hash iface
1441 new_hash <- liftIO $ fingerprintOptFlags (hsc_dflags hsc_env)
1442 putNameLiterally
1443 if | old_hash == new_hash
1444 -> up_to_date (text "Optimisation flags unchanged")
1445 | gopt Opt_IgnoreOptimChanges (hsc_dflags hsc_env)
1446 -> up_to_date (text "Optimisation flags changed; ignoring")
1447 | otherwise
1448 -> out_of_date_hash "Optimisation flags changed"
1449 (text " Optimisation flags have changed")
1450 old_hash new_hash
1451
1452 -- | Check the HPC flags haven't changed
1453 checkHpcHash :: HscEnv -> ModIface -> IfG RecompileRequired
1454 checkHpcHash hsc_env iface = do
1455 let old_hash = mi_hpc_hash iface
1456 new_hash <- liftIO $ fingerprintHpcFlags (hsc_dflags hsc_env)
1457 putNameLiterally
1458 if | old_hash == new_hash
1459 -> up_to_date (text "HPC flags unchanged")
1460 | gopt Opt_IgnoreHpcChanges (hsc_dflags hsc_env)
1461 -> up_to_date (text "HPC flags changed; ignoring")
1462 | otherwise
1463 -> out_of_date_hash "HPC flags changed"
1464 (text " HPC flags have changed")
1465 old_hash new_hash
1466
1467 -- Check that the set of signatures we are merging in match.
1468 -- If the -unit-id flags change, this can change too.
1469 checkMergedSignatures :: ModSummary -> ModIface -> IfG RecompileRequired
1470 checkMergedSignatures mod_summary iface = do
1471 dflags <- getDynFlags
1472 let old_merged = sort [ mod | UsageMergedRequirement{ usg_mod = mod } <- mi_usages iface ]
1473 new_merged = case Map.lookup (ms_mod_name mod_summary)
1474 (requirementContext (pkgState dflags)) of
1475 Nothing -> []
1476 Just r -> sort $ map (indefModuleToModule dflags) r
1477 if old_merged == new_merged
1478 then up_to_date (text "signatures to merge in unchanged" $$ ppr new_merged)
1479 else return (RecompBecause "signatures to merge in changed")
1480
1481 -- If the direct imports of this module are resolved to targets that
1482 -- are not among the dependencies of the previous interface file,
1483 -- then we definitely need to recompile. This catches cases like
1484 -- - an exposed package has been upgraded
1485 -- - we are compiling with different package flags
1486 -- - a home module that was shadowing a package module has been removed
1487 -- - a new home module has been added that shadows a package module
1488 -- See bug #1372.
1489 --
1490 -- In addition, we also check if the union of dependencies of the imported
1491 -- modules has any difference to the previous set of dependencies. We would need
1492 -- to recompile in that case also since the `mi_deps` field of ModIface needs
1493 -- to be updated to match that information. This is one of the invariants
1494 -- of interface files (see https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance#interface-file-invariants).
1495 -- See bug #16511.
1496 --
1497 -- Returns (RecompBecause <textual reason>) if recompilation is required.
1498 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1499 checkDependencies hsc_env summary iface
1500 = do
1501 checkList $
1502 [ checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1503 , do
1504 (recomp, mnames_seen) <- runUntilRecompRequired $ map
1505 checkForNewHomeDependency
1506 (ms_home_imps summary)
1507 case recomp of
1508 UpToDate -> do
1509 let
1510 seen_home_deps = Set.unions $ map Set.fromList mnames_seen
1511 checkIfAllOldHomeDependenciesAreSeen seen_home_deps
1512 _ -> return recomp]
1513 where
1514 prev_dep_mods = dep_mods (mi_deps iface)
1515 prev_dep_plgn = dep_plgins (mi_deps iface)
1516 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1517
1518 this_pkg = thisPackage (hsc_dflags hsc_env)
1519
1520 dep_missing (mb_pkg, L _ mod) = do
1521 find_res <- liftIO $ findImportedModule hsc_env mod (mb_pkg)
1522 let reason = moduleNameString mod ++ " changed"
1523 case find_res of
1524 Found _ mod
1525 | pkg == this_pkg
1526 -> if moduleName mod `notElem` map fst prev_dep_mods ++ prev_dep_plgn
1527 then do traceHiDiffs $
1528 text "imported module " <> quotes (ppr mod) <>
1529 text " not among previous dependencies"
1530 return (RecompBecause reason)
1531 else
1532 return UpToDate
1533 | otherwise
1534 -> if toInstalledUnitId pkg `notElem` (map fst prev_dep_pkgs)
1535 then do traceHiDiffs $
1536 text "imported module " <> quotes (ppr mod) <>
1537 text " is from package " <> quotes (ppr pkg) <>
1538 text ", which is not among previous dependencies"
1539 return (RecompBecause reason)
1540 else
1541 return UpToDate
1542 where pkg = moduleUnitId mod
1543 _otherwise -> return (RecompBecause reason)
1544
1545 old_deps = Set.fromList $ map fst $ filter (not . snd) prev_dep_mods
1546 isOldHomeDeps = flip Set.member old_deps
1547 checkForNewHomeDependency (L _ mname) = do
1548 let
1549 mod = mkModule this_pkg mname
1550 str_mname = moduleNameString mname
1551 reason = str_mname ++ " changed"
1552 -- We only want to look at home modules to check if any new home dependency
1553 -- pops in and thus here, skip modules that are not home. Checking
1554 -- membership in old home dependencies suffice because the `dep_missing`
1555 -- check already verified that all imported home modules are present there.
1556 if not (isOldHomeDeps mname)
1557 then return (UpToDate, [])
1558 else do
1559 mb_result <- getFromModIface "need mi_deps for" mod $ \imported_iface -> do
1560 let mnames = mname:(map fst $ filter (not . snd) $
1561 dep_mods $ mi_deps imported_iface)
1562 case find (not . isOldHomeDeps) mnames of
1563 Nothing -> return (UpToDate, mnames)
1564 Just new_dep_mname -> do
1565 traceHiDiffs $
1566 text "imported home module " <> quotes (ppr mod) <>
1567 text " has a new dependency " <> quotes (ppr new_dep_mname)
1568 return (RecompBecause reason, [])
1569 return $ fromMaybe (MustCompile, []) mb_result
1570
1571 -- Performs all recompilation checks in the list until a check that yields
1572 -- recompile required is encountered. Returns the list of the results of
1573 -- all UpToDate checks.
1574 runUntilRecompRequired [] = return (UpToDate, [])
1575 runUntilRecompRequired (check:checks) = do
1576 (recompile, value) <- check
1577 if recompileRequired recompile
1578 then return (recompile, [])
1579 else do
1580 (recomp, values) <- runUntilRecompRequired checks
1581 return (recomp, value:values)
1582
1583 checkIfAllOldHomeDependenciesAreSeen seen_deps = do
1584 let unseen_old_deps = Set.difference
1585 old_deps
1586 seen_deps
1587 if not (null unseen_old_deps)
1588 then do
1589 let missing_dep = Set.elemAt 0 unseen_old_deps
1590 traceHiDiffs $
1591 text "missing old home dependency " <> quotes (ppr missing_dep)
1592 return $ RecompBecause "missing old dependency"
1593 else return UpToDate
1594
1595 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1596 -> IfG RecompileRequired
1597 needInterface mod continue
1598 = do
1599 mb_recomp <- getFromModIface
1600 "need version info for"
1601 mod
1602 continue
1603 case mb_recomp of
1604 Nothing -> return MustCompile
1605 Just recomp -> return recomp
1606
1607 getFromModIface :: String -> Module -> (ModIface -> IfG a)
1608 -> IfG (Maybe a)
1609 getFromModIface doc_msg mod getter
1610 = do -- Load the imported interface if possible
1611 let doc_str = sep [text doc_msg, ppr mod]
1612 traceHiDiffs (text "Checking innterface for module" <+> ppr mod)
1613
1614 mb_iface <- loadInterface doc_str mod ImportBySystem
1615 -- Load the interface, but don't complain on failure;
1616 -- Instead, get an Either back which we can test
1617
1618 case mb_iface of
1619 Failed _ -> do
1620 traceHiDiffs (sep [text "Couldn't load interface for module",
1621 ppr mod])
1622 return Nothing
1623 -- Couldn't find or parse a module mentioned in the
1624 -- old interface file. Don't complain: it might
1625 -- just be that the current module doesn't need that
1626 -- import and it's been deleted
1627 Succeeded iface -> Just <$> getter iface
1628
1629 -- | Given the usage information extracted from the old
1630 -- M.hi file for the module being compiled, figure out
1631 -- whether M needs to be recompiled.
1632 checkModUsage :: UnitId -> Usage -> IfG RecompileRequired
1633 checkModUsage _this_pkg UsagePackageModule{
1634 usg_mod = mod,
1635 usg_mod_hash = old_mod_hash }
1636 = needInterface mod $ \iface -> do
1637 let reason = moduleNameString (moduleName mod) ++ " changed"
1638 checkModuleFingerprint reason old_mod_hash (mi_mod_hash iface)
1639 -- We only track the ABI hash of package modules, rather than
1640 -- individual entity usages, so if the ABI hash changes we must
1641 -- recompile. This is safe but may entail more recompilation when
1642 -- a dependent package has changed.
1643
1644 checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash }
1645 = needInterface mod $ \iface -> do
1646 let reason = moduleNameString (moduleName mod) ++ " changed (raw)"
1647 checkModuleFingerprint reason old_mod_hash (mi_mod_hash iface)
1648
1649 checkModUsage this_pkg UsageHomeModule{
1650 usg_mod_name = mod_name,
1651 usg_mod_hash = old_mod_hash,
1652 usg_exports = maybe_old_export_hash,
1653 usg_entities = old_decl_hash }
1654 = do
1655 let mod = mkModule this_pkg mod_name
1656 needInterface mod $ \iface -> do
1657
1658 let
1659 new_mod_hash = mi_mod_hash iface
1660 new_decl_hash = mi_hash_fn iface
1661 new_export_hash = mi_exp_hash iface
1662
1663 reason = moduleNameString mod_name ++ " changed"
1664
1665 -- CHECK MODULE
1666 recompile <- checkModuleFingerprint reason old_mod_hash new_mod_hash
1667 if not (recompileRequired recompile)
1668 then return UpToDate
1669 else do
1670
1671 -- CHECK EXPORT LIST
1672 checkMaybeHash reason maybe_old_export_hash new_export_hash
1673 (text " Export list changed") $ do
1674
1675 -- CHECK ITEMS ONE BY ONE
1676 recompile <- checkList [ checkEntityUsage reason new_decl_hash u
1677 | u <- old_decl_hash]
1678 if recompileRequired recompile
1679 then return recompile -- This one failed, so just bail out now
1680 else up_to_date (text " Great! The bits I use are up to date")
1681
1682
1683 checkModUsage _this_pkg UsageFile{ usg_file_path = file,
1684 usg_file_hash = old_hash } =
1685 liftIO $
1686 handleIO handle $ do
1687 new_hash <- getFileHash file
1688 if (old_hash /= new_hash)
1689 then return recomp
1690 else return UpToDate
1691 where
1692 recomp = RecompBecause (file ++ " changed")
1693 handle =
1694 #if defined(DEBUG)
1695 \e -> pprTrace "UsageFile" (text (show e)) $ return recomp
1696 #else
1697 \_ -> return recomp -- if we can't find the file, just recompile, don't fail
1698 #endif
1699
1700 ------------------------
1701 checkModuleFingerprint :: String -> Fingerprint -> Fingerprint
1702 -> IfG RecompileRequired
1703 checkModuleFingerprint reason old_mod_hash new_mod_hash
1704 | new_mod_hash == old_mod_hash
1705 = up_to_date (text "Module fingerprint unchanged")
1706
1707 | otherwise
1708 = out_of_date_hash reason (text " Module fingerprint has changed")
1709 old_mod_hash new_mod_hash
1710
1711 ------------------------
1712 checkMaybeHash :: String -> Maybe Fingerprint -> Fingerprint -> SDoc
1713 -> IfG RecompileRequired -> IfG RecompileRequired
1714 checkMaybeHash reason maybe_old_hash new_hash doc continue
1715 | Just hash <- maybe_old_hash, hash /= new_hash
1716 = out_of_date_hash reason doc hash new_hash
1717 | otherwise
1718 = continue
1719
1720 ------------------------
1721 checkEntityUsage :: String
1722 -> (OccName -> Maybe (OccName, Fingerprint))
1723 -> (OccName, Fingerprint)
1724 -> IfG RecompileRequired
1725 checkEntityUsage reason new_hash (name,old_hash)
1726 = case new_hash name of
1727
1728 Nothing -> -- We used it before, but it ain't there now
1729 out_of_date reason (sep [text "No longer exported:", ppr name])
1730
1731 Just (_, new_hash) -- It's there, but is it up to date?
1732 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1733 return UpToDate
1734 | otherwise -> out_of_date_hash reason (text " Out of date:" <+> ppr name)
1735 old_hash new_hash
1736
1737 up_to_date :: SDoc -> IfG RecompileRequired
1738 up_to_date msg = traceHiDiffs msg >> return UpToDate
1739
1740 out_of_date :: String -> SDoc -> IfG RecompileRequired
1741 out_of_date reason msg = traceHiDiffs msg >> return (RecompBecause reason)
1742
1743 out_of_date_hash :: String -> SDoc -> Fingerprint -> Fingerprint -> IfG RecompileRequired
1744 out_of_date_hash reason msg old_hash new_hash
1745 = out_of_date reason (hsep [msg, ppr old_hash, text "->", ppr new_hash])
1746
1747 ----------------------
1748 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1749 -- This helper is used in two places
1750 checkList [] = return UpToDate
1751 checkList (check:checks) = do recompile <- check
1752 if recompileRequired recompile
1753 then return recompile
1754 else checkList checks
1755
1756 {-
1757 ************************************************************************
1758 * *
1759 Converting things to their Iface equivalents
1760 * *
1761 ************************************************************************
1762 -}
1763
1764 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1765 tyThingToIfaceDecl (AnId id) = idToIfaceDecl id
1766 tyThingToIfaceDecl (ATyCon tycon) = snd (tyConToIfaceDecl emptyTidyEnv tycon)
1767 tyThingToIfaceDecl (ACoAxiom ax) = coAxiomToIfaceDecl ax
1768 tyThingToIfaceDecl (AConLike cl) = case cl of
1769 RealDataCon dc -> dataConToIfaceDecl dc -- for ppr purposes only
1770 PatSynCon ps -> patSynToIfaceDecl ps
1771
1772 --------------------------
1773 idToIfaceDecl :: Id -> IfaceDecl
1774 -- The Id is already tidied, so that locally-bound names
1775 -- (lambdas, for-alls) already have non-clashing OccNames
1776 -- We can't tidy it here, locally, because it may have
1777 -- free variables in its type or IdInfo
1778 idToIfaceDecl id
1779 = IfaceId { ifName = getName id,
1780 ifType = toIfaceType (idType id),
1781 ifIdDetails = toIfaceIdDetails (idDetails id),
1782 ifIdInfo = toIfaceIdInfo (idInfo id) }
1783
1784 --------------------------
1785 dataConToIfaceDecl :: DataCon -> IfaceDecl
1786 dataConToIfaceDecl dataCon
1787 = IfaceId { ifName = getName dataCon,
1788 ifType = toIfaceType (dataConUserType dataCon),
1789 ifIdDetails = IfVanillaId,
1790 ifIdInfo = NoInfo }
1791
1792 --------------------------
1793 coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
1794 -- We *do* tidy Axioms, because they are not (and cannot
1795 -- conveniently be) built in tidy form
1796 coAxiomToIfaceDecl ax@(CoAxiom { co_ax_tc = tycon, co_ax_branches = branches
1797 , co_ax_role = role })
1798 = IfaceAxiom { ifName = getName ax
1799 , ifTyCon = toIfaceTyCon tycon
1800 , ifRole = role
1801 , ifAxBranches = map (coAxBranchToIfaceBranch tycon
1802 (map coAxBranchLHS branch_list))
1803 branch_list }
1804 where
1805 branch_list = fromBranches branches
1806
1807 -- 2nd parameter is the list of branch LHSs, in case of a closed type family,
1808 -- for conversion from incompatible branches to incompatible indices.
1809 -- For an open type family the list should be empty.
1810 -- See Note [Storing compatibility] in CoAxiom
1811 coAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
1812 coAxBranchToIfaceBranch tc lhs_s
1813 (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs
1814 , cab_eta_tvs = eta_tvs
1815 , cab_lhs = lhs, cab_roles = roles
1816 , cab_rhs = rhs, cab_incomps = incomps })
1817
1818 = IfaceAxBranch { ifaxbTyVars = toIfaceTvBndrs tvs
1819 , ifaxbCoVars = map toIfaceIdBndr cvs
1820 , ifaxbEtaTyVars = toIfaceTvBndrs eta_tvs
1821 , ifaxbLHS = toIfaceTcArgs tc lhs
1822 , ifaxbRoles = roles
1823 , ifaxbRHS = toIfaceType rhs
1824 , ifaxbIncomps = iface_incomps }
1825 where
1826 iface_incomps = map (expectJust "iface_incomps"
1827 . flip findIndex lhs_s
1828 . eqTypes
1829 . coAxBranchLHS) incomps
1830
1831 -----------------
1832 tyConToIfaceDecl :: TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
1833 -- We *do* tidy TyCons, because they are not (and cannot
1834 -- conveniently be) built in tidy form
1835 -- The returned TidyEnv is the one after tidying the tyConTyVars
1836 tyConToIfaceDecl env tycon
1837 | Just clas <- tyConClass_maybe tycon
1838 = classToIfaceDecl env clas
1839
1840 | Just syn_rhs <- synTyConRhs_maybe tycon
1841 = ( tc_env1
1842 , IfaceSynonym { ifName = getName tycon,
1843 ifRoles = tyConRoles tycon,
1844 ifSynRhs = if_syn_type syn_rhs,
1845 ifBinders = if_binders,
1846 ifResKind = if_res_kind
1847 })
1848
1849 | Just fam_flav <- famTyConFlav_maybe tycon
1850 = ( tc_env1
1851 , IfaceFamily { ifName = getName tycon,
1852 ifResVar = if_res_var,
1853 ifFamFlav = to_if_fam_flav fam_flav,
1854 ifBinders = if_binders,
1855 ifResKind = if_res_kind,
1856 ifFamInj = tyConInjectivityInfo tycon
1857 })
1858
1859 | isAlgTyCon tycon
1860 = ( tc_env1
1861 , IfaceData { ifName = getName tycon,
1862 ifBinders = if_binders,
1863 ifResKind = if_res_kind,
1864 ifCType = tyConCType tycon,
1865 ifRoles = tyConRoles tycon,
1866 ifCtxt = tidyToIfaceContext tc_env1 (tyConStupidTheta tycon),
1867 ifCons = ifaceConDecls (algTyConRhs tycon),
1868 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1869 ifParent = parent })
1870
1871 | otherwise -- FunTyCon, PrimTyCon, promoted TyCon/DataCon
1872 -- We only convert these TyCons to IfaceTyCons when we are
1873 -- just about to pretty-print them, not because we are going
1874 -- to put them into interface files
1875 = ( env
1876 , IfaceData { ifName = getName tycon,
1877 ifBinders = if_binders,
1878 ifResKind = if_res_kind,
1879 ifCType = Nothing,
1880 ifRoles = tyConRoles tycon,
1881 ifCtxt = [],
1882 ifCons = IfDataTyCon [],
1883 ifGadtSyntax = False,
1884 ifParent = IfNoParent })
1885 where
1886 -- NOTE: Not all TyCons have `tyConTyVars` field. Forcing this when `tycon`
1887 -- is one of these TyCons (FunTyCon, PrimTyCon, PromotedDataCon) will cause
1888 -- an error.
1889 (tc_env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
1890 tc_tyvars = binderVars tc_binders
1891 if_binders = toIfaceTyCoVarBinders tc_binders
1892 -- No tidying of the binders; they are already tidy
1893 if_res_kind = tidyToIfaceType tc_env1 (tyConResKind tycon)
1894 if_syn_type ty = tidyToIfaceType tc_env1 ty
1895 if_res_var = getOccFS `fmap` tyConFamilyResVar_maybe tycon
1896
1897 parent = case tyConFamInstSig_maybe tycon of
1898 Just (tc, ty, ax) -> IfDataInstance (coAxiomName ax)
1899 (toIfaceTyCon tc)
1900 (tidyToIfaceTcArgs tc_env1 tc ty)
1901 Nothing -> IfNoParent
1902
1903 to_if_fam_flav OpenSynFamilyTyCon = IfaceOpenSynFamilyTyCon
1904 to_if_fam_flav AbstractClosedSynFamilyTyCon = IfaceAbstractClosedSynFamilyTyCon
1905 to_if_fam_flav (DataFamilyTyCon {}) = IfaceDataFamilyTyCon
1906 to_if_fam_flav (BuiltInSynFamTyCon {}) = IfaceBuiltInSynFamTyCon
1907 to_if_fam_flav (ClosedSynFamilyTyCon Nothing) = IfaceClosedSynFamilyTyCon Nothing
1908 to_if_fam_flav (ClosedSynFamilyTyCon (Just ax))
1909 = IfaceClosedSynFamilyTyCon (Just (axn, ibr))
1910 where defs = fromBranches $ coAxiomBranches ax
1911 lhss = map coAxBranchLHS defs
1912 ibr = map (coAxBranchToIfaceBranch tycon lhss) defs
1913 axn = coAxiomName ax
1914
1915 ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con)
1916 ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
1917 ifaceConDecls (TupleTyCon { data_con = con }) = IfDataTyCon [ifaceConDecl con]
1918 ifaceConDecls (SumTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
1919 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1920 -- The AbstractTyCon case happens when a TyCon has been trimmed
1921 -- during tidying.
1922 -- Furthermore, tyThingToIfaceDecl is also used in TcRnDriver
1923 -- for GHCi, when browsing a module, in which case the
1924 -- AbstractTyCon and TupleTyCon cases are perfectly sensible.
1925 -- (Tuple declarations are not serialised into interface files.)
1926
1927 ifaceConDecl data_con
1928 = IfCon { ifConName = dataConName data_con,
1929 ifConInfix = dataConIsInfix data_con,
1930 ifConWrapper = isJust (dataConWrapId_maybe data_con),
1931 ifConExTCvs = map toIfaceBndr ex_tvs',
1932 ifConUserTvBinders = map toIfaceForAllBndr user_bndrs',
1933 ifConEqSpec = map (to_eq_spec . eqSpecPair) eq_spec,
1934 ifConCtxt = tidyToIfaceContext con_env2 theta,
1935 ifConArgTys = map (tidyToIfaceType con_env2) arg_tys,
1936 ifConFields = dataConFieldLabels data_con,
1937 ifConStricts = map (toIfaceBang con_env2)
1938 (dataConImplBangs data_con),
1939 ifConSrcStricts = map toIfaceSrcBang
1940 (dataConSrcBangs data_con)}
1941 where
1942 (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _)
1943 = dataConFullSig data_con
1944 user_bndrs = dataConUserTyVarBinders data_con
1945
1946 -- Tidy the univ_tvs of the data constructor to be identical
1947 -- to the tyConTyVars of the type constructor. This means
1948 -- (a) we don't need to redundantly put them into the interface file
1949 -- (b) when pretty-printing an Iface data declaration in H98-style syntax,
1950 -- we know that the type variables will line up
1951 -- The latter (b) is important because we pretty-print type constructors
1952 -- by converting to IfaceSyn and pretty-printing that
1953 con_env1 = (fst tc_env1, mkVarEnv (zipEqual "ifaceConDecl" univ_tvs tc_tyvars))
1954 -- A bit grimy, perhaps, but it's simple!
1955
1956 (con_env2, ex_tvs') = tidyVarBndrs con_env1 ex_tvs
1957 user_bndrs' = map (tidyUserTyCoVarBinder con_env2) user_bndrs
1958 to_eq_spec (tv,ty) = (tidyTyVar con_env2 tv, tidyToIfaceType con_env2 ty)
1959
1960 -- By this point, we have tidied every universal and existential
1961 -- tyvar. Because of the dcUserTyCoVarBinders invariant
1962 -- (see Note [DataCon user type variable binders]), *every*
1963 -- user-written tyvar must be contained in the substitution that
1964 -- tidying produced. Therefore, tidying the user-written tyvars is a
1965 -- simple matter of looking up each variable in the substitution,
1966 -- which tidyTyCoVarOcc accomplishes.
1967 tidyUserTyCoVarBinder :: TidyEnv -> TyCoVarBinder -> TyCoVarBinder
1968 tidyUserTyCoVarBinder env (Bndr tv vis) =
1969 Bndr (tidyTyCoVarOcc env tv) vis
1970
1971 classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
1972 classToIfaceDecl env clas
1973 = ( env1
1974 , IfaceClass { ifName = getName tycon,
1975 ifRoles = tyConRoles (classTyCon clas),
1976 ifBinders = toIfaceTyCoVarBinders tc_binders,
1977 ifBody = body,
1978 ifFDs = map toIfaceFD clas_fds })
1979 where
1980 (_, clas_fds, sc_theta, _, clas_ats, op_stuff)
1981 = classExtraBigSig clas
1982 tycon = classTyCon clas
1983
1984 body | isAbstractTyCon tycon = IfAbstractClass
1985 | otherwise
1986 = IfConcreteClass {
1987 ifClassCtxt = tidyToIfaceContext env1 sc_theta,
1988 ifATs = map toIfaceAT clas_ats,
1989 ifSigs = map toIfaceClassOp op_stuff,
1990 ifMinDef = fmap getOccFS (classMinimalDef clas)
1991 }
1992
1993 (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
1994
1995 toIfaceAT :: ClassATItem -> IfaceAT
1996 toIfaceAT (ATI tc def)
1997 = IfaceAT if_decl (fmap (tidyToIfaceType env2 . fst) def)
1998 where
1999 (env2, if_decl) = tyConToIfaceDecl env1 tc
2000
2001 toIfaceClassOp (sel_id, def_meth)
2002 = ASSERT( sel_tyvars == binderVars tc_binders )
2003 IfaceClassOp (getName sel_id)
2004 (tidyToIfaceType env1 op_ty)
2005 (fmap toDmSpec def_meth)
2006 where
2007 -- Be careful when splitting the type, because of things
2008 -- like class Foo a where
2009 -- op :: (?x :: String) => a -> a
2010 -- and class Baz a where
2011 -- op :: (Ord a) => a -> a
2012 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
2013 op_ty = funResultTy rho_ty
2014
2015 toDmSpec :: (Name, DefMethSpec Type) -> DefMethSpec IfaceType
2016 toDmSpec (_, VanillaDM) = VanillaDM
2017 toDmSpec (_, GenericDM dm_ty) = GenericDM (tidyToIfaceType env1 dm_ty)
2018
2019 toIfaceFD (tvs1, tvs2) = (map (tidyTyVar env1) tvs1
2020 ,map (tidyTyVar env1) tvs2)
2021
2022 --------------------------
2023
2024 tidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
2025 -- If the type variable "binder" is in scope, don't re-bind it
2026 -- In a class decl, for example, the ATD binders mention
2027 -- (amd must mention) the class tyvars
2028 tidyTyConBinder env@(_, subst) tvb@(Bndr tv vis)
2029 = case lookupVarEnv subst tv of
2030 Just tv' -> (env, Bndr tv' vis)
2031 Nothing -> tidyTyCoVarBinder env tvb
2032
2033 tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
2034 tidyTyConBinders = mapAccumL tidyTyConBinder
2035
2036 tidyTyVar :: TidyEnv -> TyVar -> FastString
2037 tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv)
2038
2039 --------------------------
2040 instanceToIfaceInst :: ClsInst -> IfaceClsInst
2041 instanceToIfaceInst (ClsInst { is_dfun = dfun_id, is_flag = oflag
2042 , is_cls_nm = cls_name, is_cls = cls
2043 , is_tcs = mb_tcs
2044 , is_orphan = orph })
2045 = ASSERT( cls_name == className cls )
2046 IfaceClsInst { ifDFun = dfun_name,
2047 ifOFlag = oflag,
2048 ifInstCls = cls_name,
2049 ifInstTys = map do_rough mb_tcs,
2050 ifInstOrph = orph }
2051 where
2052 do_rough Nothing = Nothing
2053 do_rough (Just n) = Just (toIfaceTyCon_name n)
2054
2055 dfun_name = idName dfun_id
2056
2057
2058 --------------------------
2059 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
2060 famInstToIfaceFamInst (FamInst { fi_axiom = axiom,
2061 fi_fam = fam,
2062 fi_tcs = roughs })
2063 = IfaceFamInst { ifFamInstAxiom = coAxiomName axiom
2064 , ifFamInstFam = fam
2065 , ifFamInstTys = map do_rough roughs
2066 , ifFamInstOrph = orph }
2067 where
2068 do_rough Nothing = Nothing
2069 do_rough (Just n) = Just (toIfaceTyCon_name n)
2070
2071 fam_decl = tyConName $ coAxiomTyCon axiom
2072 mod = ASSERT( isExternalName (coAxiomName axiom) )
2073 nameModule (coAxiomName axiom)
2074 is_local name = nameIsLocalOrFrom mod name
2075
2076 lhs_names = filterNameSet is_local (orphNamesOfCoCon axiom)
2077
2078 orph | is_local fam_decl
2079 = NotOrphan (nameOccName fam_decl)
2080 | otherwise
2081 = chooseOrphanAnchor lhs_names
2082
2083 --------------------------
2084 coreRuleToIfaceRule :: CoreRule -> IfaceRule
2085 coreRuleToIfaceRule (BuiltinRule { ru_fn = fn})
2086 = pprTrace "toHsRule: builtin" (ppr fn) $
2087 bogusIfaceRule fn
2088
2089 coreRuleToIfaceRule (Rule { ru_name = name, ru_fn = fn,
2090 ru_act = act, ru_bndrs = bndrs,
2091 ru_args = args, ru_rhs = rhs,
2092 ru_orphan = orph, ru_auto = auto })
2093 = IfaceRule { ifRuleName = name, ifActivation = act,
2094 ifRuleBndrs = map toIfaceBndr bndrs,
2095 ifRuleHead = fn,
2096 ifRuleArgs = map do_arg args,
2097 ifRuleRhs = toIfaceExpr rhs,
2098 ifRuleAuto = auto,
2099 ifRuleOrph = orph }
2100 where
2101 -- For type args we must remove synonyms from the outermost
2102 -- level. Reason: so that when we read it back in we'll
2103 -- construct the same ru_rough field as we have right now;
2104 -- see tcIfaceRule
2105 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
2106 do_arg (Coercion co) = IfaceCo (toIfaceCoercion co)
2107 do_arg arg = toIfaceExpr arg
2108
2109 bogusIfaceRule :: Name -> IfaceRule
2110 bogusIfaceRule id_name
2111 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
2112 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
2113 ifRuleRhs = IfaceExt id_name, ifRuleOrph = IsOrphan,
2114 ifRuleAuto = True }