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