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