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