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