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