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