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