2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
10 mkIface, -- Build a ModIface from a ModGuts,
11 -- including computing version information
15 writeIfaceFile, -- Write the interface file
17 checkOldIface, -- See if recompilation is required, by
18 -- comparing version information
20 tyThingToIfaceDecl -- Converting things to their Iface equivalents
24 -----------------------------------------------
25 MkIface.lhs deals with versioning
26 -----------------------------------------------
28 Here's the fingerprint-related info in an interface file
30 module Foo xxxxxxxxxxxxxxxx -- module fingerprint
31 yyyyyyyyyyyyyyyy -- export list fingerprint
32 zzzzzzzzzzzzzzzz -- rule fingerprint
33 Usages: -- Version info for what this compilation of Foo imported
34 Baz xxxxxxxxxxxxxxxx -- Module version
35 [yyyyyyyyyyyyyyyy] -- The export-list version
36 -- ( if Foo depended on it)
37 (g,zzzzzzzzzzzzzzzz) -- Function and its version
38 (T,wwwwwwwwwwwwwwww) -- Type and its version
40 <fingerprint> f :: Int -> Int {- Unfolding: \x -> Wib.t x -}
42 -----------------------------------------------
44 -----------------------------------------------
47 * In the mi_usages information in an interface, we record the
48 fingerprint of each free variable of the module
50 * In mkIface, we compute the fingerprint of each exported thing A.f.
51 For each external thing that A.f refers to, we include the fingerprint
52 of the external reference when computing the fingerprint of A.f. So
53 if anything that A.f depends on changes, then A.f's fingerprint will
56 * In checkOldIface we compare the mi_usages for the module with
57 the actual fingerprint for all each thing recorded in mi_usages
61 We count A.f as changing if its fixity changes
65 If a rule changes, we want to recompile any module that might be
66 affected by that rule. For non-orphan rules, this is relatively easy.
67 If module M defines f, and a rule for f, just arrange that the fingerprint
68 for M.f changes if any of the rules for M.f change. Any module
69 that does not depend on M.f can't be affected by the rule-change
72 Orphan rules (ones whose 'head function' is not defined in M) are
73 harder. Here's what we do.
75 * We have a per-module orphan-rule fingerprint which changes if
76 any orphan rule changes. (It's unaffected by non-orphan rules.)
78 * We record usage info for any orphan module 'below' this one,
79 giving the orphan-rule fingerprint. We recompile if this
82 The net effect is that if an orphan rule changes, we recompile every
83 module above it. That's very conservative, but it's devilishly hard
84 to know what it might affect, so we just have to be conservative.
88 In an iface file we have
90 instance Eq a => Eq [a] = dfun29
93 We have a fingerprint for dfun29, covering its unfolding
94 etc. Suppose we are compiling a module M that imports A only
95 indirectly. If typechecking M uses this instance decl, we record the
96 dependency on A.dfun29 as if it were a free variable of the module
97 (via the tcg_inst_usages accumulator). That means that A will appear
98 in M's usage list. If the shape of the instance declaration changes,
99 then so will dfun29's fingerprint, triggering a recompilation.
101 Adding an instance declaration, or changing an instance decl that is
102 not currently used, is more tricky. (This really only makes a
103 difference when we have overlapping instance decls, because then the
104 new instance decl might kick in to override the old one.) We handle
105 this in a very similar way that we handle rules above.
107 * For non-orphan instance decls, identify one locally-defined tycon/class
108 mentioned in the decl. Treat the instance decl as part of the defn of that
109 tycon/class, so that if the shape of the instance decl changes, so does the
110 tycon/class; that in turn will force recompilation of anything that uses
113 * For orphan instance decls, act the same way as for orphan rules.
114 Indeed, we use the same global orphan-rule version number.
118 mkUsageInfo figures out what the ``usage information'' for this
119 moudule is; that is, what it must record in its interface file as the
122 We produce a line for every module B below the module, A, currently being
125 to record the fact that A does import B indirectly. This is used to decide
126 to look for B.hi rather than B.hi-boot when compiling a module that
127 imports A. This line says that A imports B, but uses nothing in it.
128 So we'll get an early bale-out when compiling A if B's fingerprint changes.
130 The usage information records:
133 \item (a) anything reachable from its body code
134 \item (b) any module exported with a @module Foo@
135 \item (c) anything reachable from an exported item
138 Why (b)? Because if @Foo@ changes then this module's export list
139 will change, so we must recompile this module at least as far as
140 making a new interface file --- but in practice that means complete
143 Why (c)? Consider this:
145 module A( f, g ) where | module B( f ) where
146 import B( f ) | f = h 3
150 Here, @B.f@ isn't used in A. Should we nevertheless record @B.f@ in
151 @A@'s usages? Our idea is that we aren't going to touch A.hi if it is
152 *identical* to what it was before. If anything about @B.f@ changes
153 than anyone who imports @A@ should be recompiled in case they use
154 @B.f@ (they'll get an early exit if they don't). So, if anything
155 about @B.f@ changes we'd better make sure that something in A.hi
156 changes, and the convenient way to do that is to record the version
157 number @B.f@ in A.hi in the usage list. If B.f changes that'll force a
158 complete recompiation of A, which is overkill but it's the only way to
159 write a new, slightly different, A.hi.
161 But the example is tricker. Even if @B.f@ doesn't change at all,
162 @B.h@ may do so, and this change may not be reflected in @f@'s version
163 number. But with -O, a module that imports A must be recompiled if
164 @B.h@ changes! So A must record a dependency on @B.h@. So we treat
165 the occurrence of @B.f@ in the export list *just as if* it were in the
166 code of A, and thereby haul in all the stuff reachable from it.
168 *** Conclusion: if A mentions B.f in its export list,
169 behave just as if A mentioned B.f in its source code,
170 and slurp in B.f and all its transitive closure ***
172 [NB: If B was compiled with -O, but A isn't, we should really *still*
173 haul in all the unfoldings for B, in case the module that imports A *is*
174 compiled with -O. I think this is the case.]
176 SimonM [30/11/2007]: I believe the above is all out of date; the
177 current implementation doesn't do it this way. Instead, when any of
178 the dependencies of a declaration changes, the version of the
179 declaration itself changes.
182 #include "HsVersions.h"
216 import BasicTypes hiding ( SuccessFlag(..) )
219 import Util hiding ( eqListBy )
231 import System.FilePath
236 %************************************************************************
238 \subsection{Completing an interface}
240 %************************************************************************
244 -> Maybe Fingerprint -- The old fingerprint, if we have it
245 -> ModDetails -- The trimmed, tidied interface
246 -> ModGuts -- Usages, deprecations, etc
247 -> IO (ModIface, -- The new one
248 Bool) -- True <=> there was an old Iface, and the
249 -- new one is identical, so no need
252 mkIface hsc_env maybe_old_fingerprint mod_details
253 ModGuts{ mg_module = this_mod,
255 mg_used_names = used_names,
257 mg_dir_imps = dir_imp_mods,
258 mg_rdr_env = rdr_env,
259 mg_fix_env = fix_env,
260 mg_deprecs = deprecs,
261 mg_hpc_info = hpc_info }
262 = mkIface_ hsc_env maybe_old_fingerprint
263 this_mod is_boot used_names deps rdr_env
264 fix_env deprecs hpc_info dir_imp_mods mod_details
266 -- | make an interface from the results of typechecking only. Useful
267 -- for non-optimising compilation, or where we aren't generating any
268 -- object code at all ('HscNothing').
270 -> Maybe Fingerprint -- The old fingerprint, if we have it
271 -> ModDetails -- gotten from mkBootModDetails, probably
272 -> TcGblEnv -- Usages, deprecations, etc
275 mkIfaceTc hsc_env maybe_old_fingerprint mod_details
276 tc_result@TcGblEnv{ tcg_mod = this_mod,
278 tcg_imports = imports,
279 tcg_rdr_env = rdr_env,
280 tcg_fix_env = fix_env,
281 tcg_deprecs = deprecs,
282 tcg_hpc = other_hpc_info
285 used_names <- mkUsedNames tc_result
286 deps <- mkDependencies tc_result
287 let hpc_info = emptyHpcInfo other_hpc_info
288 mkIface_ hsc_env maybe_old_fingerprint
289 this_mod (isHsBoot hsc_src) used_names deps rdr_env
290 fix_env deprecs hpc_info (imp_mods imports) mod_details
293 mkUsedNames :: TcGblEnv -> IO NameSet
295 TcGblEnv{ tcg_inst_uses = dfun_uses_var,
299 dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
300 return (allUses dus `unionNameSets` dfun_uses)
302 mkDependencies :: TcGblEnv -> IO Dependencies
304 TcGblEnv{ tcg_mod = mod,
305 tcg_imports = imports,
309 th_used <- readIORef th_var -- Whether TH is used
311 dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
312 -- M.hi-boot can be in the imp_dep_mods, but we must remove
313 -- it before recording the modules on which this one depends!
314 -- (We want to retain M.hi-boot in imp_dep_mods so that
315 -- loadHiBootInterface can see if M's direct imports depend
316 -- on M.hi-boot, and hence that we should do the hi-boot consistency
319 -- Modules don't compare lexicographically usually,
320 -- but we want them to do so here.
321 le_mod :: Module -> Module -> Bool
322 le_mod m1 m2 = moduleNameFS (moduleName m1)
323 <= moduleNameFS (moduleName m2)
325 le_dep_mod :: (ModuleName, IsBootInterface)
326 -> (ModuleName, IsBootInterface) -> Bool
327 le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
330 pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
331 | otherwise = imp_dep_pkgs imports
333 return Deps { dep_mods = sortLe le_dep_mod dep_mods,
334 dep_pkgs = sortLe (<=) pkgs,
335 dep_orphs = sortLe le_mod (imp_orphs imports),
336 dep_finsts = sortLe le_mod (imp_finsts imports) }
337 -- sort to get into canonical order
340 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
341 -> NameSet -> Dependencies -> GlobalRdrEnv
342 -> NameEnv FixItem -> Deprecations -> HpcInfo
345 -> IO (ModIface, Bool)
346 mkIface_ hsc_env maybe_old_fingerprint
347 this_mod is_boot used_names deps rdr_env fix_env src_deprecs hpc_info
349 ModDetails{ md_insts = insts,
350 md_fam_insts = fam_insts,
352 md_vect_info = vect_info,
354 md_exports = exports }
355 -- NB: notice that mkIface does not look at the bindings
356 -- only at the TypeEnv. The previous Tidy phase has
357 -- put exactly the info into the TypeEnv that we want
358 -- to expose in the interface
360 = do { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
362 ; let { entities = typeEnvElts type_env ;
363 decls = [ tyThingToIfaceDecl entity
364 | entity <- entities,
365 let name = getName entity,
366 not (isImplicitTyThing entity),
367 -- No implicit Ids and class tycons in the interface file
368 not (isWiredInName name),
369 -- Nor wired-in things; the compiler knows about them anyhow
370 nameIsLocalOrFrom this_mod name ]
371 -- Sigh: see Note [Root-main Id] in TcRnDriver
373 ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
374 ; deprecs = src_deprecs
375 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
376 ; iface_insts = map instanceToIfaceInst insts
377 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
378 ; iface_vect_info = flattenVectInfo vect_info
380 ; intermediate_iface = ModIface {
381 mi_module = this_mod,
385 mi_exports = mkIfaceExports exports,
387 -- Sort these lexicographically, so that
388 -- the result is stable across compilations
389 mi_insts = sortLe le_inst iface_insts,
390 mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
391 mi_rules = sortLe le_rule iface_rules,
393 mi_vect_info = iface_vect_info,
395 mi_fixities = fixities,
396 mi_deprecs = deprecs,
397 mi_globals = Just rdr_env,
399 -- Left out deliberately: filled in by addVersionInfo
400 mi_iface_hash = fingerprint0,
401 mi_mod_hash = fingerprint0,
402 mi_exp_hash = fingerprint0,
403 mi_orphan_hash = fingerprint0,
404 mi_orphan = False, -- Always set by addVersionInfo, but
405 -- it's a strict field, so we can't omit it.
406 mi_finsts = False, -- Ditto
407 mi_decls = deliberatelyOmitted "decls",
408 mi_hash_fn = deliberatelyOmitted "hash_fn",
409 mi_hpc = isHpcUsed hpc_info,
411 -- And build the cached values
412 mi_dep_fn = mkIfaceDepCache deprecs,
413 mi_fix_fn = mkIfaceFixCache fixities }
416 ; (new_iface, no_change_at_all, pp_orphs)
417 <- {-# SCC "versioninfo" #-}
418 addFingerprints hsc_env maybe_old_fingerprint
419 intermediate_iface decls
422 ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags)
423 (printDump (expectJust "mkIface" pp_orphs))
425 -- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
427 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
428 (pprModIface new_iface)
430 -- bug #1617: on reload we weren't updating the PrintUnqualified
431 -- correctly. This stems from the fact that the interface had
432 -- not changed, so addVersionInfo returns the old ModIface
433 -- with the old GlobalRdrEnv (mi_globals).
434 ; let final_iface = new_iface{ mi_globals = Just rdr_env }
436 ; return (final_iface, no_change_at_all) }
438 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
439 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
440 i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
442 le_occ :: Name -> Name -> Bool
443 -- Compare lexicographically by OccName, *not* by unique, because
444 -- the latter is not stable across compilations
445 le_occ n1 n2 = nameOccName n1 <= nameOccName n2
447 dflags = hsc_dflags hsc_env
448 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
449 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
451 flattenVectInfo (VectInfo { vectInfoVar = vVar
452 , vectInfoTyCon = vTyCon
455 ifaceVectInfoVar = [ Var.varName v
456 | (v, _) <- varEnvElts vVar],
457 ifaceVectInfoTyCon = [ tyConName t
458 | (t, t_v) <- nameEnvElts vTyCon
460 ifaceVectInfoTyConReuse = [ tyConName t
461 | (t, t_v) <- nameEnvElts vTyCon
465 -----------------------------
466 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
467 writeIfaceFile dflags location new_iface
468 = do createDirectoryHierarchy (takeDirectory hi_file_path)
469 writeBinIface dflags hi_file_path new_iface
470 where hi_file_path = ml_hi_file location
473 -- -----------------------------------------------------------------------------
474 -- Look up parents and versions of Names
476 -- This is like a global version of the mi_hash_fn field in each ModIface.
477 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
478 -- the parent and version info.
481 :: HscEnv -- needed to look up versions
482 -> ExternalPackageState -- ditto
483 -> (Name -> Fingerprint)
484 mkHashFun hsc_env eps
487 mod = nameModule name
488 occ = nameOccName name
489 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
490 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
492 snd (mi_hash_fn iface occ `orElse`
493 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
495 hpt = hsc_HPT hsc_env
498 -- ---------------------------------------------------------------------------
499 -- Compute fingerprints for the interface
503 -> Maybe Fingerprint -- the old fingerprint, if any
504 -> ModIface -- The new interface (lacking decls)
505 -> [IfaceDecl] -- The new decls
506 -> IO (ModIface, -- Updated interface
507 Bool, -- True <=> no changes at all;
508 -- no need to write Iface
509 Maybe SDoc) -- Warnings about orphans
511 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
513 eps <- hscEPS hsc_env
515 -- the ABI of a declaration represents everything that is made
516 -- visible about the declaration that a client can depend on.
517 -- see IfaceDeclABI below.
518 declABI :: IfaceDecl -> IfaceDeclABI
519 declABI decl = (this_mod, decl, extras)
520 where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
522 edges :: [(IfaceDeclABI, Unique, [Unique])]
523 edges = [ (abi, getUnique (ifName decl), out)
525 , let abi = declABI decl
526 , let out = localOccs $ freeNamesDeclABI abi
529 localOccs = map (getUnique . getParent . getOccName)
530 . filter ((== this_mod) . nameModule)
532 where getParent occ = lookupOccEnv parent_map occ `orElse` occ
534 -- maps OccNames to their parents in the current module.
535 -- e.g. a reference to a constructor must be turned into a reference
536 -- to the TyCon for the purposes of calculating dependencies.
537 parent_map :: OccEnv OccName
538 parent_map = foldr extend emptyOccEnv new_decls
540 extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
543 -- strongly-connected groups of declarations, in dependency order
544 groups = stronglyConnComp edges
546 global_hash_fn = mkHashFun hsc_env eps
548 -- how to output Names when generating the data to fingerprint.
549 -- Here we want to output the fingerprint for each top-level
550 -- Name, whether it comes from the current module or another
551 -- module. In this way, the fingerprint for a declaration will
552 -- change if the fingerprint for anything it refers to (transitively)
554 mk_put_name :: (OccEnv (OccName,Fingerprint))
555 -> BinHandle -> Name -> IO ()
556 mk_put_name local_env bh name
557 | isWiredInName name = putNameLiterally bh name
558 -- wired-in names don't have fingerprints
560 = let hash | nameModule name /= this_mod = global_hash_fn name
562 snd (lookupOccEnv local_env (getOccName name)
563 `orElse` pprPanic "urk! lookup local fingerprint"
564 (ppr name)) -- (undefined,fingerprint0))
565 -- This panic indicates that we got the dependency
566 -- analysis wrong, because we needed a fingerprint for
567 -- an entity that wasn't in the environment. To debug
568 -- it, turn the panic into a trace, uncomment the
569 -- pprTraces below, run the compile again, and inspect
570 -- the output and the generated .hi file with
575 -- take a strongly-connected group of declarations and compute
578 fingerprint_group :: (OccEnv (OccName,Fingerprint),
579 [(Fingerprint,IfaceDecl)])
581 -> IO (OccEnv (OccName,Fingerprint),
582 [(Fingerprint,IfaceDecl)])
584 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
585 = do let hash_fn = mk_put_name local_env
587 -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
588 hash <- computeFingerprint dflags hash_fn abi
589 return (extend_hash_env (hash,decl) local_env,
590 (hash,decl) : decls_w_hashes)
592 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
593 = do let decls = map abiDecl abis
594 local_env' = foldr extend_hash_env local_env
595 (zip (repeat fingerprint0) decls)
596 hash_fn = mk_put_name local_env'
597 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
598 let stable_abis = sortBy cmp_abiNames abis
599 -- put the cycle in a canonical order
600 hash <- computeFingerprint dflags hash_fn stable_abis
601 let pairs = zip (repeat hash) decls
602 return (foldr extend_hash_env local_env pairs,
603 pairs ++ decls_w_hashes)
605 extend_hash_env :: (Fingerprint,IfaceDecl)
606 -> OccEnv (OccName,Fingerprint)
607 -> OccEnv (OccName,Fingerprint)
608 extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
611 item = (decl_name, hash)
612 env1 = extendOccEnv env0 decl_name item
613 add_imp bndr env = extendOccEnv env bndr item
616 (local_env, decls_w_hashes) <-
617 foldM fingerprint_group (emptyOccEnv, []) groups
619 -- when calculating fingerprints, we always need to use canonical
620 -- ordering for lists of things. In particular, the mi_deps has various
621 -- lists of modules and suchlike, so put these all in canonical order:
622 let sorted_deps = sortDependencies (mi_deps iface0)
624 -- the export hash of a module depends on the orphan hashes of the
625 -- orphan modules below us in the dependeny tree. This is the way
626 -- that changes in orphans get propagated all the way up the
627 -- dependency tree. We only care about orphan modules in the current
628 -- package, because changes to orphans outside this package will be
629 -- tracked by the usage on the ABI hash of package modules that we import.
630 let orph_mods = filter ((== this_pkg) . modulePackageId)
631 $ dep_orphs sorted_deps
632 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
634 orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
635 (map IfaceInstABI orph_insts, orph_rules, fam_insts)
637 -- the export list hash doesn't depend on the fingerprints of
638 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
639 export_hash <- computeFingerprint dflags putNameLiterally
640 (mi_exports iface0, orphan_hash, dep_orphan_hashes)
642 -- put the declarations in a canonical order, sorted by OccName
643 let sorted_decls = eltsFM $ listToFM $
644 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
646 -- the ABI hash depends on:
652 mod_hash <- computeFingerprint dflags putNameLiterally
653 (map fst sorted_decls,
658 -- The interface hash depends on:
659 -- - the ABI hash, plus
663 iface_hash <- computeFingerprint dflags putNameLiterally
670 no_change_at_all = Just iface_hash == mb_old_fingerprint
672 final_iface = iface0 {
673 mi_mod_hash = mod_hash,
674 mi_iface_hash = iface_hash,
675 mi_exp_hash = export_hash,
676 mi_orphan_hash = orphan_hash,
677 mi_orphan = not (null orph_rules && null orph_insts),
678 mi_finsts = not . null $ mi_fam_insts iface0,
679 mi_decls = sorted_decls,
680 mi_hash_fn = lookupOccEnv local_env }
682 return (final_iface, no_change_at_all, pp_orphs)
685 this_mod = mi_module iface0
686 dflags = hsc_dflags hsc_env
687 this_pkg = thisPackage dflags
688 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
689 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
690 -- ToDo: shouldn't we be splitting fam_insts into orphans and
692 fam_insts = mi_fam_insts iface0
693 fix_fn = mi_fix_fn iface0
694 pp_orphs = pprOrphans orph_insts orph_rules
697 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
698 getOrphanHashes hsc_env mods = do
699 eps <- hscEPS hsc_env
701 hpt = hsc_HPT hsc_env
703 dflags = hsc_dflags hsc_env
705 case lookupIfaceByModule dflags hpt pit mod of
706 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
707 Just iface -> mi_orphan_hash iface
709 return (map get_orph_hash mods)
712 sortDependencies :: Dependencies -> Dependencies
714 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
715 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
716 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
717 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
719 -- The ABI of a declaration consists of:
720 -- the full name of the identifier (inc. module and package, because
721 -- these are used to construct the symbol name by which the
722 -- identifier is known externally).
723 -- the fixity of the identifier
724 -- the declaration itself, as exposed to clients. That is, the
725 -- definition of an Id is included in the fingerprint only if
726 -- it is made available as as unfolding in the interface.
728 -- for classes: instances, fixity & rules for methods
729 -- for datatypes: instances, fixity & rules for constrs
730 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
732 abiDecl :: IfaceDeclABI -> IfaceDecl
733 abiDecl (_, decl, _) = decl
735 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
736 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
737 ifName (abiDecl abi2)
739 freeNamesDeclABI :: IfaceDeclABI -> NameSet
740 freeNamesDeclABI (_mod, decl, extras) =
741 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
744 = IfaceIdExtras Fixity [IfaceRule]
745 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
746 | IfaceClassExtras [IfaceInstABI] [(Fixity,[IfaceRule])]
747 | IfaceOtherDeclExtras
749 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
750 freeNamesDeclExtras (IfaceIdExtras _ rules)
751 = unionManyNameSets (map freeNamesIfRule rules)
752 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
753 = unionManyNameSets (map freeNamesSub subs)
754 freeNamesDeclExtras (IfaceClassExtras _insts subs)
755 = unionManyNameSets (map freeNamesSub subs)
756 freeNamesDeclExtras IfaceOtherDeclExtras
759 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
760 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
762 instance Binary IfaceDeclExtras where
763 get _bh = panic "no get for IfaceDeclExtras"
764 put_ bh (IfaceIdExtras fix rules) = do
765 putByte bh 1; put_ bh fix; put_ bh rules
766 put_ bh (IfaceDataExtras fix insts cons) = do
767 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
768 put_ bh (IfaceClassExtras insts methods) = do
769 putByte bh 3; put_ bh insts; put_ bh methods
770 put_ bh IfaceOtherDeclExtras = do
773 declExtras :: (OccName -> Fixity)
774 -> OccEnv [IfaceRule]
775 -> OccEnv [IfaceInst]
779 declExtras fix_fn rule_env inst_env decl
781 IfaceId{} -> IfaceIdExtras (fix_fn n)
782 (lookupOccEnvL rule_env n)
783 IfaceData{ifCons=cons} ->
784 IfaceDataExtras (fix_fn n)
785 (map IfaceInstABI $ lookupOccEnvL inst_env n)
786 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
787 IfaceClass{ifSigs=sigs} ->
789 (map IfaceInstABI $ lookupOccEnvL inst_env n)
790 [id_extras op | IfaceClassOp op _ _ <- sigs]
791 _other -> IfaceOtherDeclExtras
794 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
796 -- When hashing an instance, we omit the DFun. This is because if a
797 -- DFun is used it will already have a separate entry in the usages
798 -- list, and we don't want changes to the DFun to cause the hash of
799 -- the instnace to change - that would cause unnecessary changes to
800 -- orphans, for example.
801 newtype IfaceInstABI = IfaceInstABI IfaceInst
803 instance Binary IfaceInstABI where
804 get = panic "no get for IfaceInstABI"
805 put_ bh (IfaceInstABI inst) = do
806 let ud = getUserData bh
807 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
810 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
811 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
813 -- used when we want to fingerprint a structure without depending on the
814 -- fingerprints of external Names that it refers to.
815 putNameLiterally :: BinHandle -> Name -> IO ()
816 putNameLiterally bh name = do
817 put_ bh $! nameModule name
818 put_ bh $! nameOccName name
820 computeFingerprint :: Binary a
822 -> (BinHandle -> Name -> IO ())
826 computeFingerprint _dflags put_name a = do
827 bh <- openBinMem (3*1024) -- just less than a block
828 ud <- newWriteState put_name putFS
829 bh <- return $ setUserData bh ud
834 -- for testing: use the md5sum command to generate fingerprints and
835 -- compare the results against our built-in version.
836 fp' <- oldMD5 dflags bh
837 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
840 oldMD5 dflags bh = do
841 tmp <- newTempName dflags "bin"
843 tmp2 <- newTempName dflags "md5"
844 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
847 ExitFailure _ -> ghcError (PhaseFailed cmd r)
849 hash_str <- readFile tmp2
850 return $! readHexFingerprint hash_str
853 pprOrphans :: [IfaceInst] -> [IfaceRule] -> Maybe SDoc
854 pprOrphans insts rules
855 | null insts && null rules = Nothing
858 if null insts then empty else
859 hang (ptext (sLit "Warning: orphan instances:"))
860 2 (vcat (map ppr insts)),
861 if null rules then empty else
862 hang (ptext (sLit "Warning: orphan rules:"))
863 2 (vcat (map ppr rules))
866 ----------------------
867 -- mkOrphMap partitions instance decls or rules into
868 -- (a) an OccEnv for ones that are not orphans,
869 -- mapping the local OccName to a list of its decls
870 -- (b) a list of orphan decls
871 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
872 -- Nothing for an orphan decl
873 -> [decl] -- Sorted into canonical order
874 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
875 -- each sublist in canonical order
876 [decl]) -- Orphan decls; in canonical order
877 mkOrphMap get_key decls
878 = foldl go (emptyOccEnv, []) decls
880 go (non_orphs, orphs) d
881 | Just occ <- get_key d
882 = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
883 | otherwise = (non_orphs, d:orphs)
887 %*********************************************************
889 \subsection{Keeping track of what we've slurped, and fingerprints}
891 %*********************************************************
895 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
896 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
897 = do { eps <- hscEPS hsc_env
898 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
899 dir_imp_mods used_names
900 ; usages `seqList` return usages }
901 -- seq the list of Usages returned: occasionally these
902 -- don't get evaluated for a while and we can end up hanging on to
903 -- the entire collection of Ifaces.
905 mk_usage_info :: PackageIfaceTable
911 mk_usage_info pit hsc_env this_mod direct_imports used_names
912 = mapCatMaybes mkUsage usage_mods
914 hpt = hsc_HPT hsc_env
915 dflags = hsc_dflags hsc_env
916 this_pkg = thisPackage dflags
918 used_mods = moduleEnvKeys ent_map
919 dir_imp_mods = (moduleEnvKeys direct_imports)
920 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
921 usage_mods = sortBy stableModuleCmp all_mods
922 -- canonical order is imported, to avoid interface-file
925 -- ent_map groups together all the things imported and used
926 -- from a particular module
927 ent_map :: ModuleEnv [OccName]
928 ent_map = foldNameSet add_mv emptyModuleEnv used_names
931 | isWiredInName name = mv_map -- ignore wired-in names
933 = case nameModule_maybe name of
934 Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
935 Just mod -> extendModuleEnv_C (++) mv_map mod [occ]
936 where occ = nameOccName name
938 -- We want to create a Usage for a home module if
939 -- a) we used something from it; has something in used_names
940 -- b) we imported it, even if we used nothing from it
941 -- (need to recompile if its export list changes: export_fprint)
942 mkUsage :: Module -> Maybe Usage
944 | isNothing maybe_iface -- We can't depend on it if we didn't
945 -- load its interface.
946 || mod == this_mod -- We don't care about usages of
947 -- things in *this* module
950 | modulePackageId mod /= this_pkg
951 = Just UsagePackageModule{ usg_mod = mod,
952 usg_mod_hash = mod_hash }
953 -- for package modules, we record the module hash only
956 && isNothing export_hash
957 && not is_direct_import
959 = Nothing -- Record no usage info
960 -- for directly-imported modules, we always want to record a usage
961 -- on the orphan hash. This is what triggers a recompilation if
962 -- an orphan is added or removed somewhere below us in the future.
965 = Just UsageHomeModule {
966 usg_mod_name = moduleName mod,
967 usg_mod_hash = mod_hash,
968 usg_exports = export_hash,
969 usg_entities = fmToList ent_hashs }
971 maybe_iface = lookupIfaceByModule dflags hpt pit mod
972 -- In one-shot mode, the interfaces for home-package
973 -- modules accumulate in the PIT not HPT. Sigh.
975 is_direct_import = mod `elemModuleEnv` direct_imports
977 Just iface = maybe_iface
978 finsts_mod = mi_finsts iface
979 hash_env = mi_hash_fn iface
980 mod_hash = mi_mod_hash iface
981 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
982 | otherwise = Nothing
984 used_occs = lookupModuleEnv ent_map mod `orElse` []
986 -- Making a FiniteMap here ensures that (a) we remove duplicates
987 -- when we have usages on several subordinates of a single parent,
988 -- and (b) that the usages emerge in a canonical order, which
989 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
990 -- using Ord on the OccNames, which is a lexicographic ordering.
991 ent_hashs :: FiniteMap OccName Fingerprint
992 ent_hashs = listToFM (map lookup_occ used_occs)
996 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
999 depend_on_exports mod =
1000 case lookupModuleEnv direct_imports mod of
1002 -- Even if we used 'import M ()', we have to register a
1003 -- usage on the export list because we are sensitive to
1004 -- changes in orphan instances/rules.
1006 -- In GHC 6.8.x the above line read "True", and in
1007 -- fact it recorded a dependency on *all* the
1008 -- modules underneath in the dependency tree. This
1009 -- happens to make orphans work right, but is too
1010 -- expensive: it'll read too many interface files.
1011 -- The 'isNothing maybe_iface' check above saved us
1012 -- from generating many of these usages (at least in
1013 -- one-shot mode), but that's even more bogus!
1017 mkIfaceExports :: [AvailInfo]
1018 -> [(Module, [GenAvailInfo OccName])]
1019 -- Group by module and sort by occurrence
1020 -- This keeps the list in canonical order
1021 mkIfaceExports exports
1022 = [ (mod, eltsFM avails)
1023 | (mod, avails) <- fmToList groupFM
1026 -- Group by the module where the exported entities are defined
1027 -- (which may not be the same for all Names in an Avail)
1028 -- Deliberately use FiniteMap rather than UniqFM so we
1029 -- get a canonical ordering
1030 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
1031 groupFM = foldl add emptyModuleEnv exports
1033 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
1034 -> Module -> GenAvailInfo OccName
1035 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
1036 add_one env mod avail
1037 = extendModuleEnv_C plusFM env mod
1038 (unitFM (occNameFS (availName avail)) avail)
1040 -- NB: we should not get T(X) and T(Y) in the export list
1041 -- else the plusFM will simply discard one! They
1042 -- should have been combined by now.
1044 = add_one env (nameModule n) (Avail (nameOccName n))
1046 add env (AvailTC tc ns)
1047 = foldl add_for_mod env mods
1049 tc_occ = nameOccName tc
1050 mods = nub (map nameModule ns)
1051 -- Usually just one, but see Note [Original module]
1054 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
1055 -- NB. sort the children, we need a canonical order
1057 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
1060 Note [Orignal module]
1061 ~~~~~~~~~~~~~~~~~~~~~
1063 module X where { data family T }
1064 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
1065 The exported Avail from Y will look like
1068 - only MkT is brought into scope by the data instance;
1069 - but the parent (used for grouping and naming in T(..) exports) is X.T
1070 - and in this case we export X.T too
1072 In the result of MkIfaceExports, the names are grouped by defining module,
1073 so we may need to split up a single Avail into multiple ones.
1076 %************************************************************************
1078 Load the old interface file for this module (unless
1079 we have it aleady), and check whether it is up to date
1082 %************************************************************************
1085 checkOldIface :: HscEnv
1087 -> Bool -- Source unchanged
1088 -> Maybe ModIface -- Old interface from compilation manager, if any
1089 -> IO (RecompileRequired, Maybe ModIface)
1091 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1092 = do { showPass (hsc_dflags hsc_env)
1093 ("Checking old interface for " ++
1094 showSDoc (ppr (ms_mod mod_summary))) ;
1096 ; initIfaceCheck hsc_env $
1097 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1100 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1101 -> IfG (Bool, Maybe ModIface)
1102 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1103 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
1104 { when (not source_unchanged)
1105 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1107 -- If the source has changed and we're in interactive mode, avoid reading
1108 -- an interface; just return the one we might have been supplied with.
1109 ; let dflags = hsc_dflags hsc_env
1110 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1111 return (outOfDate, maybe_iface)
1113 case maybe_iface of {
1114 Just old_iface -> do -- Use the one we already have
1115 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1116 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1117 ; return (recomp, Just old_iface) }
1121 -- Try and read the old interface for the current module
1122 -- from the .hi file left from the last time we compiled it
1123 { let iface_path = msHiFilePath mod_summary
1124 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1125 ; case read_result of {
1126 Failed err -> do -- Old interface file not found, or garbled; give up
1127 { traceIf (text "FYI: cannot read old interface file:"
1129 ; return (outOfDate, Nothing) }
1131 ; Succeeded iface -> do
1133 -- We have got the old iface; check its versions
1134 { traceIf (text "Read the interface file" <+> text iface_path)
1135 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1136 ; return (recomp, Just iface)
1141 @recompileRequired@ is called from the HscMain. It checks whether
1142 a recompilation is required. It needs access to the persistent state,
1143 finder, etc, because it may have to load lots of interface files to
1144 check their versions.
1147 type RecompileRequired = Bool
1148 upToDate, outOfDate :: Bool
1149 upToDate = False -- Recompile not required
1150 outOfDate = True -- Recompile required
1152 checkVersions :: HscEnv
1153 -> Bool -- True <=> source unchanged
1155 -> ModIface -- Old interface
1156 -> IfG RecompileRequired
1157 checkVersions hsc_env source_unchanged mod_summary iface
1158 | not source_unchanged
1161 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1162 ppr (mi_module iface) <> colon)
1164 ; recomp <- checkDependencies hsc_env mod_summary iface
1165 ; if recomp then return outOfDate else do {
1167 -- Source code unchanged and no errors yet... carry on
1169 -- First put the dependent-module info, read from the old
1170 -- interface, into the envt, so that when we look for
1171 -- interfaces we look for the right one (.hi or .hi-boot)
1173 -- It's just temporary because either the usage check will succeed
1174 -- (in which case we are done with this module) or it'll fail (in which
1175 -- case we'll compile the module from scratch anyhow).
1177 -- We do this regardless of compilation mode, although in --make mode
1178 -- all the dependent modules should be in the HPT already, so it's
1180 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1182 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1183 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1186 -- This is a bit of a hack really
1187 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1188 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1191 -- If the direct imports of this module are resolved to targets that
1192 -- are not among the dependencies of the previous interface file,
1193 -- then we definitely need to recompile. This catches cases like
1194 -- - an exposed package has been upgraded
1195 -- - we are compiling with different package flags
1196 -- - a home module that was shadowing a package module has been removed
1197 -- - a new home module has been added that shadows a package module
1200 -- Returns True if recompilation is required.
1201 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1202 checkDependencies hsc_env summary iface
1203 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1205 prev_dep_mods = dep_mods (mi_deps iface)
1206 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1208 this_pkg = thisPackage (hsc_dflags hsc_env)
1210 orM = foldr f (return False)
1211 where f m rest = do b <- m; if b then return True else rest
1213 dep_missing (L _ mod) = do
1214 find_res <- liftIO $ findImportedModule hsc_env mod Nothing
1218 -> if moduleName mod `notElem` map fst prev_dep_mods
1219 then do traceHiDiffs $
1220 text "imported module " <> quotes (ppr mod) <>
1221 text " not among previous dependencies"
1226 -> if pkg `notElem` prev_dep_pkgs
1227 then do traceHiDiffs $
1228 text "imported module " <> quotes (ppr mod) <>
1229 text " is from package " <> quotes (ppr pkg) <>
1230 text ", which is not among previous dependencies"
1234 where pkg = modulePackageId mod
1235 _otherwise -> return outOfDate
1237 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1238 -> IfG RecompileRequired
1239 needInterface mod continue
1240 = do -- Load the imported interface if possible
1241 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1242 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1244 mb_iface <- loadInterface doc_str mod ImportBySystem
1245 -- Load the interface, but don't complain on failure;
1246 -- Instead, get an Either back which we can test
1249 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1251 -- Couldn't find or parse a module mentioned in the
1252 -- old interface file. Don't complain: it might
1253 -- just be that the current module doesn't need that
1254 -- import and it's been deleted
1255 Succeeded iface -> continue iface
1258 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1259 -- Given the usage information extracted from the old
1260 -- M.hi file for the module being compiled, figure out
1261 -- whether M needs to be recompiled.
1263 checkModUsage _this_pkg UsagePackageModule{
1265 usg_mod_hash = old_mod_hash }
1266 = needInterface mod $ \iface -> do
1267 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1268 -- We only track the ABI hash of package modules, rather than
1269 -- individual entity usages, so if the ABI hash changes we must
1270 -- recompile. This is safe but may entail more recompilation when
1271 -- a dependent package has changed.
1273 checkModUsage this_pkg UsageHomeModule{
1274 usg_mod_name = mod_name,
1275 usg_mod_hash = old_mod_hash,
1276 usg_exports = maybe_old_export_hash,
1277 usg_entities = old_decl_hash }
1279 let mod = mkModule this_pkg mod_name
1280 needInterface mod $ \iface -> do
1283 new_mod_hash = mi_mod_hash iface
1284 new_decl_hash = mi_hash_fn iface
1285 new_export_hash = mi_exp_hash iface
1288 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1289 if not recompile then return upToDate else do
1291 -- CHECK EXPORT LIST
1292 checkMaybeHash maybe_old_export_hash new_export_hash
1293 (ptext (sLit " Export list changed")) $ do
1295 -- CHECK ITEMS ONE BY ONE
1296 recompile <- checkList [ checkEntityUsage new_decl_hash u
1297 | u <- old_decl_hash]
1299 then return outOfDate -- This one failed, so just bail out now
1300 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1302 ------------------------
1303 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1304 checkModuleFingerprint old_mod_hash new_mod_hash
1305 | new_mod_hash == old_mod_hash
1306 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1309 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1310 old_mod_hash new_mod_hash
1312 ------------------------
1313 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1314 -> IfG RecompileRequired -> IfG RecompileRequired
1315 checkMaybeHash maybe_old_hash new_hash doc continue
1316 | Just hash <- maybe_old_hash, hash /= new_hash
1317 = out_of_date_hash doc hash new_hash
1321 ------------------------
1322 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1323 -> (OccName, Fingerprint)
1325 checkEntityUsage new_hash (name,old_hash)
1326 = case new_hash name of
1328 Nothing -> -- We used it before, but it ain't there now
1329 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1331 Just (_, new_hash) -- It's there, but is it up to date?
1332 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1334 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1337 up_to_date, out_of_date :: SDoc -> IfG Bool
1338 up_to_date msg = traceHiDiffs msg >> return upToDate
1339 out_of_date msg = traceHiDiffs msg >> return outOfDate
1341 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1342 out_of_date_hash msg old_hash new_hash
1343 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1345 ----------------------
1346 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1347 -- This helper is used in two places
1348 checkList [] = return upToDate
1349 checkList (check:checks) = do recompile <- check
1351 then return outOfDate
1352 else checkList checks
1355 %************************************************************************
1357 Converting things to their Iface equivalents
1359 %************************************************************************
1362 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1363 -- Assumption: the thing is already tidied, so that locally-bound names
1364 -- (lambdas, for-alls) already have non-clashing OccNames
1365 -- Reason: Iface stuff uses OccNames, and the conversion here does
1366 -- not do tidying on the way
1367 tyThingToIfaceDecl (AnId id)
1368 = IfaceId { ifName = getOccName id,
1369 ifType = toIfaceType (idType id),
1372 info = case toIfaceIdInfo (idInfo id) of
1374 items -> HasInfo items
1376 tyThingToIfaceDecl (AClass clas)
1377 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1378 ifName = getOccName clas,
1379 ifTyVars = toIfaceTvBndrs clas_tyvars,
1380 ifFDs = map toIfaceFD clas_fds,
1381 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1382 ifSigs = map toIfaceClassOp op_stuff,
1383 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1385 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1386 = classExtraBigSig clas
1387 tycon = classTyCon clas
1389 toIfaceClassOp (sel_id, def_meth)
1390 = ASSERT(sel_tyvars == clas_tyvars)
1391 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1393 -- Be careful when splitting the type, because of things
1394 -- like class Foo a where
1395 -- op :: (?x :: String) => a -> a
1396 -- and class Baz a where
1397 -- op :: (Ord a) => a -> a
1398 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1399 op_ty = funResultTy rho_ty
1401 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1403 tyThingToIfaceDecl (ATyCon tycon)
1405 = IfaceSyn { ifName = getOccName tycon,
1406 ifTyVars = toIfaceTvBndrs tyvars,
1407 ifOpenSyn = syn_isOpen,
1408 ifSynRhs = toIfaceType syn_tyki,
1409 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1413 = IfaceData { ifName = getOccName tycon,
1414 ifTyVars = toIfaceTvBndrs tyvars,
1415 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1416 ifCons = ifaceConDecls (algTyConRhs tycon),
1417 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1418 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1419 ifGeneric = tyConHasGenerics tycon,
1420 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1422 | isForeignTyCon tycon
1423 = IfaceForeign { ifName = getOccName tycon,
1424 ifExtName = tyConExtName tycon }
1426 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1428 tyvars = tyConTyVars tycon
1429 (syn_isOpen, syn_tyki) = case synTyConRhs tycon of
1430 OpenSynTyCon ki _ -> (True , ki)
1431 SynonymTyCon ty -> (False, ty)
1433 ifaceConDecls (NewTyCon { data_con = con }) =
1434 IfNewTyCon (ifaceConDecl con)
1435 ifaceConDecls (DataTyCon { data_cons = cons }) =
1436 IfDataTyCon (map ifaceConDecl cons)
1437 ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
1438 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1439 -- The last case happens when a TyCon has been trimmed during tidying
1440 -- Furthermore, tyThingToIfaceDecl is also used
1441 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1442 -- AbstractTyCon case is perfectly sensible.
1444 ifaceConDecl data_con
1445 = IfCon { ifConOcc = getOccName (dataConName data_con),
1446 ifConInfix = dataConIsInfix data_con,
1447 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1448 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1449 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1450 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1451 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1452 ifConFields = map getOccName
1453 (dataConFieldLabels data_con),
1454 ifConStricts = dataConStrictMarks data_con }
1456 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1458 famInstToIface Nothing = Nothing
1459 famInstToIface (Just (famTyCon, instTys)) =
1460 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1462 tyThingToIfaceDecl (ADataCon dc)
1463 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1466 getFS :: NamedThing a => a -> FastString
1467 getFS x = occNameFS (getOccName x)
1469 --------------------------
1470 instanceToIfaceInst :: Instance -> IfaceInst
1471 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1472 is_cls = cls_name, is_tcs = mb_tcs })
1473 = ASSERT( cls_name == className cls )
1474 IfaceInst { ifDFun = dfun_name,
1476 ifInstCls = cls_name,
1477 ifInstTys = map do_rough mb_tcs,
1480 do_rough Nothing = Nothing
1481 do_rough (Just n) = Just (toIfaceTyCon_name n)
1483 dfun_name = idName dfun_id
1484 mod = nameModule dfun_name
1485 is_local name = nameIsLocalOrFrom mod name
1487 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1488 (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1489 -- Slightly awkward: we need the Class to get the fundeps
1490 (tvs, fds) = classTvsFds cls
1491 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1492 orph | is_local cls_name = Just (nameOccName cls_name)
1493 | all isJust mb_ns = head mb_ns
1494 | otherwise = Nothing
1496 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1497 -- that is not in the "determined" arguments
1498 mb_ns | null fds = [choose_one arg_names]
1499 | otherwise = map do_one fds
1500 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1501 , not (tv `elem` rtvs)]
1503 choose_one :: [NameSet] -> Maybe OccName
1504 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1506 (n : _) -> Just (nameOccName n)
1508 --------------------------
1509 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1510 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1513 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1514 , ifFamInstFam = fam
1515 , ifFamInstTys = map do_rough mb_tcs }
1517 do_rough Nothing = Nothing
1518 do_rough (Just n) = Just (toIfaceTyCon_name n)
1520 --------------------------
1521 toIfaceLetBndr :: Id -> IfaceLetBndr
1522 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1523 (toIfaceType (idType id))
1526 -- Stripped-down version of tcIfaceIdInfo
1527 -- Change this if you want to export more IdInfo for
1528 -- non-top-level Ids. Don't forget to change
1529 -- CoreTidy.tidyLetBndr too!
1531 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1533 inline_prag = inlinePragInfo id_info
1534 prag_info | isAlwaysActive inline_prag = NoInfo
1535 | otherwise = HasInfo [HsInline inline_prag]
1537 --------------------------
1538 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1539 toIfaceIdInfo id_info
1540 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1541 inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
1543 ------------ Arity --------------
1544 arity_info = arityInfo id_info
1545 arity_hsinfo | arity_info == 0 = Nothing
1546 | otherwise = Just (HsArity arity_info)
1548 ------------ Caf Info --------------
1549 caf_info = cafInfo id_info
1550 caf_hsinfo = case caf_info of
1551 NoCafRefs -> Just HsNoCafRefs
1554 ------------ Strictness --------------
1555 -- No point in explicitly exporting TopSig
1556 strict_hsinfo = case newStrictnessInfo id_info of
1557 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1560 ------------ Worker --------------
1561 work_info = workerInfo id_info
1562 has_worker = workerExists work_info
1563 wrkr_hsinfo = case work_info of
1564 HasWorker work_id wrap_arity ->
1565 Just (HsWorker ((idName work_id)) wrap_arity)
1568 ------------ Unfolding --------------
1569 -- The unfolding is redundant if there is a worker
1570 unfold_info = unfoldingInfo id_info
1571 rhs = unfoldingTemplate unfold_info
1572 no_unfolding = neverUnfold unfold_info
1573 -- The CoreTidy phase retains unfolding info iff
1574 -- we want to expose the unfolding, taking into account
1575 -- unconditional NOINLINE, etc. See TidyPgm.addExternal
1576 unfold_hsinfo | no_unfolding = Nothing
1577 | has_worker = Nothing -- Unfolding is implicit
1578 | otherwise = Just (HsUnfold (toIfaceExpr rhs))
1580 ------------ Inline prag --------------
1581 inline_prag = inlinePragInfo id_info
1582 inline_hsinfo | isAlwaysActive inline_prag = Nothing
1583 | no_unfolding && not has_worker = Nothing
1584 -- If the iface file give no unfolding info, we
1585 -- don't need to say when inlining is OK!
1586 | otherwise = Just (HsInline inline_prag)
1588 --------------------------
1589 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1590 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1591 = pprTrace "toHsRule: builtin" (ppr fn) $
1594 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1595 ru_act = act, ru_bndrs = bndrs,
1596 ru_args = args, ru_rhs = rhs })
1597 = IfaceRule { ifRuleName = name, ifActivation = act,
1598 ifRuleBndrs = map toIfaceBndr bndrs,
1600 ifRuleArgs = map do_arg args,
1601 ifRuleRhs = toIfaceExpr rhs,
1604 -- For type args we must remove synonyms from the outermost
1605 -- level. Reason: so that when we read it back in we'll
1606 -- construct the same ru_rough field as we have right now;
1608 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1609 do_arg arg = toIfaceExpr arg
1611 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1612 -- A rule is an orphan only if none of the variables
1613 -- mentioned on its left-hand side are locally defined
1614 lhs_names = fn : nameSetToList (exprsFreeNames args)
1615 -- No need to delete bndrs, because
1616 -- exprsFreeNames finds only External names
1618 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1619 (n : _) -> Just (nameOccName n)
1622 bogusIfaceRule :: Name -> IfaceRule
1623 bogusIfaceRule id_name
1624 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1625 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1626 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1628 ---------------------
1629 toIfaceExpr :: CoreExpr -> IfaceExpr
1630 toIfaceExpr (Var v) = toIfaceVar v
1631 toIfaceExpr (Lit l) = IfaceLit l
1632 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1633 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1634 toIfaceExpr (App f a) = toIfaceApp f [a]
1635 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1636 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1637 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1638 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1640 ---------------------
1641 toIfaceNote :: Note -> IfaceNote
1642 toIfaceNote (SCC cc) = IfaceSCC cc
1643 toIfaceNote InlineMe = IfaceInlineMe
1644 toIfaceNote (CoreNote s) = IfaceCoreNote s
1646 ---------------------
1647 toIfaceBind :: Bind Id -> IfaceBinding
1648 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1649 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1651 ---------------------
1652 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1653 -> (IfaceConAlt, [FastString], IfaceExpr)
1654 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1656 ---------------------
1657 toIfaceCon :: AltCon -> IfaceConAlt
1658 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1659 | otherwise = IfaceDataAlt (getName dc)
1661 tc = dataConTyCon dc
1663 toIfaceCon (LitAlt l) = IfaceLitAlt l
1664 toIfaceCon DEFAULT = IfaceDefault
1666 ---------------------
1667 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1668 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1669 toIfaceApp (Var v) as
1670 = case isDataConWorkId_maybe v of
1671 -- We convert the *worker* for tuples into IfaceTuples
1672 Just dc | isTupleTyCon tc && saturated
1673 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1675 val_args = dropWhile isTypeArg as
1676 saturated = val_args `lengthIs` idArity v
1677 tup_args = map toIfaceExpr val_args
1678 tc = dataConTyCon dc
1680 _ -> mkIfaceApps (toIfaceVar v) as
1682 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1684 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1685 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1687 ---------------------
1688 toIfaceVar :: Id -> IfaceExpr
1690 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1691 -- Foreign calls have special syntax
1692 | isExternalName name = IfaceExt name
1693 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1695 | otherwise = IfaceLcl (getFS name)