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