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