2 % (c) The University of Glasgow 2006-2008
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 Recompilation checking
26 -----------------------------------------------
28 A complete description of how recompilation checking works can be
29 found in the wiki commentary:
31 http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
33 Please read the above page for a top-down description of how this all
34 works. Notes below cover specific issues related to the implementation.
38 * In the mi_usages information in an interface, we record the
39 fingerprint of each free variable of the module
41 * In mkIface, we compute the fingerprint of each exported thing A.f.
42 For each external thing that A.f refers to, we include the fingerprint
43 of the external reference when computing the fingerprint of A.f. So
44 if anything that A.f depends on changes, then A.f's fingerprint will
47 * In checkOldIface we compare the mi_usages for the module with
48 the actual fingerprint for all each thing recorded in mi_usages
51 #include "HsVersions.h"
85 import BasicTypes hiding ( SuccessFlag(..) )
88 import Util hiding ( eqListBy )
101 import System.FilePath
102 import System.Exit ( exitWith, ExitCode(..) )
107 %************************************************************************
109 \subsection{Completing an interface}
111 %************************************************************************
115 -> Maybe Fingerprint -- The old fingerprint, if we have it
116 -> ModDetails -- The trimmed, tidied interface
117 -> ModGuts -- Usages, deprecations, etc
118 -> IO (ModIface, -- The new one
119 Bool) -- True <=> there was an old Iface, and the
120 -- new one is identical, so no need
123 mkIface hsc_env maybe_old_fingerprint mod_details
124 ModGuts{ mg_module = this_mod,
126 mg_used_names = used_names,
128 mg_dir_imps = dir_imp_mods,
129 mg_rdr_env = rdr_env,
130 mg_fix_env = fix_env,
132 mg_hpc_info = hpc_info }
133 = mkIface_ hsc_env maybe_old_fingerprint
134 this_mod is_boot used_names deps rdr_env
135 fix_env warns hpc_info dir_imp_mods mod_details
137 -- | make an interface from the results of typechecking only. Useful
138 -- for non-optimising compilation, or where we aren't generating any
139 -- object code at all ('HscNothing').
141 -> Maybe Fingerprint -- The old fingerprint, if we have it
142 -> ModDetails -- gotten from mkBootModDetails, probably
143 -> TcGblEnv -- Usages, deprecations, etc
146 mkIfaceTc hsc_env maybe_old_fingerprint mod_details
147 tc_result@TcGblEnv{ tcg_mod = this_mod,
149 tcg_imports = imports,
150 tcg_rdr_env = rdr_env,
151 tcg_fix_env = fix_env,
153 tcg_hpc = other_hpc_info
156 used_names <- mkUsedNames tc_result
157 deps <- mkDependencies tc_result
158 let hpc_info = emptyHpcInfo other_hpc_info
159 mkIface_ hsc_env maybe_old_fingerprint
160 this_mod (isHsBoot hsc_src) used_names deps rdr_env
161 fix_env warns hpc_info (imp_mods imports) mod_details
164 mkUsedNames :: TcGblEnv -> IO NameSet
166 TcGblEnv{ tcg_inst_uses = dfun_uses_var,
170 dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
171 return (allUses dus `unionNameSets` dfun_uses)
173 mkDependencies :: TcGblEnv -> IO Dependencies
175 TcGblEnv{ tcg_mod = mod,
176 tcg_imports = imports,
180 th_used <- readIORef th_var -- Whether TH is used
182 dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
183 -- M.hi-boot can be in the imp_dep_mods, but we must remove
184 -- it before recording the modules on which this one depends!
185 -- (We want to retain M.hi-boot in imp_dep_mods so that
186 -- loadHiBootInterface can see if M's direct imports depend
187 -- on M.hi-boot, and hence that we should do the hi-boot consistency
190 -- Modules don't compare lexicographically usually,
191 -- but we want them to do so here.
192 le_mod :: Module -> Module -> Bool
193 le_mod m1 m2 = moduleNameFS (moduleName m1)
194 <= moduleNameFS (moduleName m2)
196 le_dep_mod :: (ModuleName, IsBootInterface)
197 -> (ModuleName, IsBootInterface) -> Bool
198 le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
201 pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
202 | otherwise = imp_dep_pkgs imports
204 return Deps { dep_mods = sortLe le_dep_mod dep_mods,
205 dep_pkgs = sortLe (<=) pkgs,
206 dep_orphs = sortLe le_mod (imp_orphs imports),
207 dep_finsts = sortLe le_mod (imp_finsts imports) }
208 -- sort to get into canonical order
211 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
212 -> NameSet -> Dependencies -> GlobalRdrEnv
213 -> NameEnv FixItem -> Warnings -> HpcInfo
216 -> IO (ModIface, Bool)
217 mkIface_ hsc_env maybe_old_fingerprint
218 this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
220 ModDetails{ md_insts = insts,
221 md_fam_insts = fam_insts,
223 md_vect_info = vect_info,
225 md_exports = exports }
226 -- NB: notice that mkIface does not look at the bindings
227 -- only at the TypeEnv. The previous Tidy phase has
228 -- put exactly the info into the TypeEnv that we want
229 -- to expose in the interface
231 = do { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
233 ; let { entities = typeEnvElts type_env ;
234 decls = [ tyThingToIfaceDecl entity
235 | entity <- entities,
236 let name = getName entity,
237 not (isImplicitTyThing entity),
238 -- No implicit Ids and class tycons in the interface file
239 not (isWiredInName name),
240 -- Nor wired-in things; the compiler knows about them anyhow
241 nameIsLocalOrFrom this_mod name ]
242 -- Sigh: see Note [Root-main Id] in TcRnDriver
244 ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
246 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
247 ; iface_insts = map instanceToIfaceInst insts
248 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
249 ; iface_vect_info = flattenVectInfo vect_info
251 ; intermediate_iface = ModIface {
252 mi_module = this_mod,
256 mi_exports = mkIfaceExports exports,
258 -- Sort these lexicographically, so that
259 -- the result is stable across compilations
260 mi_insts = sortLe le_inst iface_insts,
261 mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
262 mi_rules = sortLe le_rule iface_rules,
264 mi_vect_info = iface_vect_info,
266 mi_fixities = fixities,
268 mi_globals = Just rdr_env,
270 -- Left out deliberately: filled in by addVersionInfo
271 mi_iface_hash = fingerprint0,
272 mi_mod_hash = fingerprint0,
273 mi_exp_hash = fingerprint0,
274 mi_orphan_hash = fingerprint0,
275 mi_orphan = False, -- Always set by addVersionInfo, but
276 -- it's a strict field, so we can't omit it.
277 mi_finsts = False, -- Ditto
278 mi_decls = deliberatelyOmitted "decls",
279 mi_hash_fn = deliberatelyOmitted "hash_fn",
280 mi_hpc = isHpcUsed hpc_info,
282 -- And build the cached values
283 mi_warn_fn = mkIfaceWarnCache warns,
284 mi_fix_fn = mkIfaceFixCache fixities }
287 ; (new_iface, no_change_at_all)
288 <- {-# SCC "versioninfo" #-}
289 addFingerprints hsc_env maybe_old_fingerprint
290 intermediate_iface decls
292 -- Warn about orphans
293 ; let orph_warnings --- Laziness means no work done unless -fwarn-orphans
294 | dopt Opt_WarnOrphans dflags = rule_warns `unionBags` inst_warns
295 | otherwise = emptyBag
296 errs_and_warns = (orph_warnings, emptyBag)
297 unqual = mkPrintUnqualified dflags rdr_env
298 inst_warns = listToBag [ instOrphWarn unqual d
299 | (d,i) <- insts `zip` iface_insts
300 , isNothing (ifInstOrph i) ]
301 rule_warns = listToBag [ ruleOrphWarn unqual this_mod r
303 , isNothing (ifRuleOrph r) ]
305 ; when (not (isEmptyBag orph_warnings))
306 (do { printErrorsAndWarnings dflags errs_and_warns -- XXX
307 ; when (errorsFound dflags errs_and_warns)
308 (exitWith (ExitFailure 1)) })
310 -- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
313 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
314 (pprModIface new_iface)
316 -- bug #1617: on reload we weren't updating the PrintUnqualified
317 -- correctly. This stems from the fact that the interface had
318 -- not changed, so addVersionInfo returns the old ModIface
319 -- with the old GlobalRdrEnv (mi_globals).
320 ; let final_iface = new_iface{ mi_globals = Just rdr_env }
322 ; return (final_iface, no_change_at_all) }
324 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
325 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
326 i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
328 le_occ :: Name -> Name -> Bool
329 -- Compare lexicographically by OccName, *not* by unique, because
330 -- the latter is not stable across compilations
331 le_occ n1 n2 = nameOccName n1 <= nameOccName n2
333 dflags = hsc_dflags hsc_env
334 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
335 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
337 flattenVectInfo (VectInfo { vectInfoVar = vVar
338 , vectInfoTyCon = vTyCon
341 ifaceVectInfoVar = [ Var.varName v
342 | (v, _) <- varEnvElts vVar],
343 ifaceVectInfoTyCon = [ tyConName t
344 | (t, t_v) <- nameEnvElts vTyCon
346 ifaceVectInfoTyConReuse = [ tyConName t
347 | (t, t_v) <- nameEnvElts vTyCon
351 -----------------------------
352 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
353 writeIfaceFile dflags location new_iface
354 = do createDirectoryHierarchy (takeDirectory hi_file_path)
355 writeBinIface dflags hi_file_path new_iface
356 where hi_file_path = ml_hi_file location
359 -- -----------------------------------------------------------------------------
360 -- Look up parents and versions of Names
362 -- This is like a global version of the mi_hash_fn field in each ModIface.
363 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
364 -- the parent and version info.
367 :: HscEnv -- needed to look up versions
368 -> ExternalPackageState -- ditto
369 -> (Name -> Fingerprint)
370 mkHashFun hsc_env eps
373 mod = ASSERT2( isExternalName name, ppr name ) nameModule name
374 occ = nameOccName name
375 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
376 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
378 snd (mi_hash_fn iface occ `orElse`
379 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
381 hpt = hsc_HPT hsc_env
384 -- ---------------------------------------------------------------------------
385 -- Compute fingerprints for the interface
389 -> Maybe Fingerprint -- the old fingerprint, if any
390 -> ModIface -- The new interface (lacking decls)
391 -> [IfaceDecl] -- The new decls
392 -> IO (ModIface, -- Updated interface
393 Bool) -- True <=> no changes at all;
394 -- no need to write Iface
396 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
398 eps <- hscEPS hsc_env
400 -- the ABI of a declaration represents everything that is made
401 -- visible about the declaration that a client can depend on.
402 -- see IfaceDeclABI below.
403 declABI :: IfaceDecl -> IfaceDeclABI
404 declABI decl = (this_mod, decl, extras)
405 where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
407 edges :: [(IfaceDeclABI, Unique, [Unique])]
408 edges = [ (abi, getUnique (ifName decl), out)
410 , let abi = declABI decl
411 , let out = localOccs $ freeNamesDeclABI abi
414 name_module n = ASSERT( isExternalName n ) nameModule n
415 localOccs = map (getUnique . getParent . getOccName)
416 . filter ((== this_mod) . name_module)
418 where getParent occ = lookupOccEnv parent_map occ `orElse` occ
420 -- maps OccNames to their parents in the current module.
421 -- e.g. a reference to a constructor must be turned into a reference
422 -- to the TyCon for the purposes of calculating dependencies.
423 parent_map :: OccEnv OccName
424 parent_map = foldr extend emptyOccEnv new_decls
426 extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
429 -- strongly-connected groups of declarations, in dependency order
430 groups = stronglyConnCompFromEdgedVertices edges
432 global_hash_fn = mkHashFun hsc_env eps
434 -- how to output Names when generating the data to fingerprint.
435 -- Here we want to output the fingerprint for each top-level
436 -- Name, whether it comes from the current module or another
437 -- module. In this way, the fingerprint for a declaration will
438 -- change if the fingerprint for anything it refers to (transitively)
440 mk_put_name :: (OccEnv (OccName,Fingerprint))
441 -> BinHandle -> Name -> IO ()
442 mk_put_name local_env bh name
443 | isWiredInName name = putNameLiterally bh name
444 -- wired-in names don't have fingerprints
446 = ASSERT( isExternalName name )
447 let hash | nameModule name /= this_mod = global_hash_fn name
449 snd (lookupOccEnv local_env (getOccName name)
450 `orElse` pprPanic "urk! lookup local fingerprint"
451 (ppr name)) -- (undefined,fingerprint0))
452 -- This panic indicates that we got the dependency
453 -- analysis wrong, because we needed a fingerprint for
454 -- an entity that wasn't in the environment. To debug
455 -- it, turn the panic into a trace, uncomment the
456 -- pprTraces below, run the compile again, and inspect
457 -- the output and the generated .hi file with
462 -- take a strongly-connected group of declarations and compute
465 fingerprint_group :: (OccEnv (OccName,Fingerprint),
466 [(Fingerprint,IfaceDecl)])
468 -> IO (OccEnv (OccName,Fingerprint),
469 [(Fingerprint,IfaceDecl)])
471 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
472 = do let hash_fn = mk_put_name local_env
474 -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
475 hash <- computeFingerprint dflags hash_fn abi
476 return (extend_hash_env (hash,decl) local_env,
477 (hash,decl) : decls_w_hashes)
479 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
480 = do let decls = map abiDecl abis
481 local_env' = foldr extend_hash_env local_env
482 (zip (repeat fingerprint0) decls)
483 hash_fn = mk_put_name local_env'
484 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
485 let stable_abis = sortBy cmp_abiNames abis
486 -- put the cycle in a canonical order
487 hash <- computeFingerprint dflags hash_fn stable_abis
488 let pairs = zip (repeat hash) decls
489 return (foldr extend_hash_env local_env pairs,
490 pairs ++ decls_w_hashes)
492 extend_hash_env :: (Fingerprint,IfaceDecl)
493 -> OccEnv (OccName,Fingerprint)
494 -> OccEnv (OccName,Fingerprint)
495 extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
498 item = (decl_name, hash)
499 env1 = extendOccEnv env0 decl_name item
500 add_imp bndr env = extendOccEnv env bndr item
503 (local_env, decls_w_hashes) <-
504 foldM fingerprint_group (emptyOccEnv, []) groups
506 -- when calculating fingerprints, we always need to use canonical
507 -- ordering for lists of things. In particular, the mi_deps has various
508 -- lists of modules and suchlike, so put these all in canonical order:
509 let sorted_deps = sortDependencies (mi_deps iface0)
511 -- the export hash of a module depends on the orphan hashes of the
512 -- orphan modules below us in the dependeny tree. This is the way
513 -- that changes in orphans get propagated all the way up the
514 -- dependency tree. We only care about orphan modules in the current
515 -- package, because changes to orphans outside this package will be
516 -- tracked by the usage on the ABI hash of package modules that we import.
517 let orph_mods = filter ((== this_pkg) . modulePackageId)
518 $ dep_orphs sorted_deps
519 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
521 orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
522 (map IfaceInstABI orph_insts, orph_rules, fam_insts)
524 -- the export list hash doesn't depend on the fingerprints of
525 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
526 export_hash <- computeFingerprint dflags putNameLiterally
527 (mi_exports iface0, orphan_hash, dep_orphan_hashes)
529 -- put the declarations in a canonical order, sorted by OccName
530 let sorted_decls = eltsFM $ listToFM $
531 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
533 -- the ABI hash depends on:
539 mod_hash <- computeFingerprint dflags putNameLiterally
540 (map fst sorted_decls,
545 -- The interface hash depends on:
546 -- - the ABI hash, plus
550 iface_hash <- computeFingerprint dflags putNameLiterally
557 no_change_at_all = Just iface_hash == mb_old_fingerprint
559 final_iface = iface0 {
560 mi_mod_hash = mod_hash,
561 mi_iface_hash = iface_hash,
562 mi_exp_hash = export_hash,
563 mi_orphan_hash = orphan_hash,
564 mi_orphan = not (null orph_rules && null orph_insts),
565 mi_finsts = not . null $ mi_fam_insts iface0,
566 mi_decls = sorted_decls,
567 mi_hash_fn = lookupOccEnv local_env }
569 return (final_iface, no_change_at_all)
572 this_mod = mi_module iface0
573 dflags = hsc_dflags hsc_env
574 this_pkg = thisPackage dflags
575 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
576 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
577 -- ToDo: shouldn't we be splitting fam_insts into orphans and
579 fam_insts = mi_fam_insts iface0
580 fix_fn = mi_fix_fn iface0
583 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
584 getOrphanHashes hsc_env mods = do
585 eps <- hscEPS hsc_env
587 hpt = hsc_HPT hsc_env
589 dflags = hsc_dflags hsc_env
591 case lookupIfaceByModule dflags hpt pit mod of
592 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
593 Just iface -> mi_orphan_hash iface
595 return (map get_orph_hash mods)
598 sortDependencies :: Dependencies -> Dependencies
600 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
601 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
602 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
603 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
605 -- The ABI of a declaration consists of:
606 -- the full name of the identifier (inc. module and package, because
607 -- these are used to construct the symbol name by which the
608 -- identifier is known externally).
609 -- the fixity of the identifier
610 -- the declaration itself, as exposed to clients. That is, the
611 -- definition of an Id is included in the fingerprint only if
612 -- it is made available as as unfolding in the interface.
614 -- for classes: instances, fixity & rules for methods
615 -- for datatypes: instances, fixity & rules for constrs
616 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
618 abiDecl :: IfaceDeclABI -> IfaceDecl
619 abiDecl (_, decl, _) = decl
621 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
622 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
623 ifName (abiDecl abi2)
625 freeNamesDeclABI :: IfaceDeclABI -> NameSet
626 freeNamesDeclABI (_mod, decl, extras) =
627 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
630 = IfaceIdExtras Fixity [IfaceRule]
631 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
632 | IfaceClassExtras [IfaceInstABI] [(Fixity,[IfaceRule])]
633 | IfaceOtherDeclExtras
635 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
636 freeNamesDeclExtras (IfaceIdExtras _ rules)
637 = unionManyNameSets (map freeNamesIfRule rules)
638 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
639 = unionManyNameSets (map freeNamesSub subs)
640 freeNamesDeclExtras (IfaceClassExtras _insts subs)
641 = unionManyNameSets (map freeNamesSub subs)
642 freeNamesDeclExtras IfaceOtherDeclExtras
645 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
646 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
648 instance Binary IfaceDeclExtras where
649 get _bh = panic "no get for IfaceDeclExtras"
650 put_ bh (IfaceIdExtras fix rules) = do
651 putByte bh 1; put_ bh fix; put_ bh rules
652 put_ bh (IfaceDataExtras fix insts cons) = do
653 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
654 put_ bh (IfaceClassExtras insts methods) = do
655 putByte bh 3; put_ bh insts; put_ bh methods
656 put_ bh IfaceOtherDeclExtras = do
659 declExtras :: (OccName -> Fixity)
660 -> OccEnv [IfaceRule]
661 -> OccEnv [IfaceInst]
665 declExtras fix_fn rule_env inst_env decl
667 IfaceId{} -> IfaceIdExtras (fix_fn n)
668 (lookupOccEnvL rule_env n)
669 IfaceData{ifCons=cons} ->
670 IfaceDataExtras (fix_fn n)
671 (map IfaceInstABI $ lookupOccEnvL inst_env n)
672 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
673 IfaceClass{ifSigs=sigs} ->
675 (map IfaceInstABI $ lookupOccEnvL inst_env n)
676 [id_extras op | IfaceClassOp op _ _ <- sigs]
677 _other -> IfaceOtherDeclExtras
680 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
683 -- When hashing an instance, we hash only its structure, not the
684 -- fingerprints of the things it mentions. See the section on instances
685 -- in the commentary,
686 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
688 newtype IfaceInstABI = IfaceInstABI IfaceInst
690 instance Binary IfaceInstABI where
691 get = panic "no get for IfaceInstABI"
692 put_ bh (IfaceInstABI inst) = do
693 let ud = getUserData bh
694 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
697 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
698 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
700 -- used when we want to fingerprint a structure without depending on the
701 -- fingerprints of external Names that it refers to.
702 putNameLiterally :: BinHandle -> Name -> IO ()
703 putNameLiterally bh name = ASSERT( isExternalName name )
704 do { put_ bh $! nameModule name
705 ; put_ bh $! nameOccName name }
707 computeFingerprint :: Binary a
709 -> (BinHandle -> Name -> IO ())
713 computeFingerprint _dflags put_name a = do
714 bh <- openBinMem (3*1024) -- just less than a block
715 ud <- newWriteState put_name putFS
716 bh <- return $ setUserData bh ud
721 -- for testing: use the md5sum command to generate fingerprints and
722 -- compare the results against our built-in version.
723 fp' <- oldMD5 dflags bh
724 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
727 oldMD5 dflags bh = do
728 tmp <- newTempName dflags "bin"
730 tmp2 <- newTempName dflags "md5"
731 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
734 ExitFailure _ -> ghcError (PhaseFailed cmd r)
736 hash_str <- readFile tmp2
737 return $! readHexFingerprint hash_str
740 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
741 instOrphWarn unqual inst
742 = mkWarnMsg (getSrcSpan inst) unqual $
743 hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
745 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
746 ruleOrphWarn unqual mod rule
747 = mkWarnMsg silly_loc unqual $
748 ptext (sLit "Orphan rule:") <+> ppr rule
750 silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 0)
751 -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
752 -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
754 ----------------------
755 -- mkOrphMap partitions instance decls or rules into
756 -- (a) an OccEnv for ones that are not orphans,
757 -- mapping the local OccName to a list of its decls
758 -- (b) a list of orphan decls
759 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
760 -- Nothing for an orphan decl
761 -> [decl] -- Sorted into canonical order
762 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
763 -- each sublist in canonical order
764 [decl]) -- Orphan decls; in canonical order
765 mkOrphMap get_key decls
766 = foldl go (emptyOccEnv, []) decls
768 go (non_orphs, orphs) d
769 | Just occ <- get_key d
770 = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
771 | otherwise = (non_orphs, d:orphs)
775 %*********************************************************
777 \subsection{Keeping track of what we've slurped, and fingerprints}
779 %*********************************************************
783 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
784 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
785 = do { eps <- hscEPS hsc_env
786 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
787 dir_imp_mods used_names
788 ; usages `seqList` return usages }
789 -- seq the list of Usages returned: occasionally these
790 -- don't get evaluated for a while and we can end up hanging on to
791 -- the entire collection of Ifaces.
793 mk_usage_info :: PackageIfaceTable
799 mk_usage_info pit hsc_env this_mod direct_imports used_names
800 = mapCatMaybes mkUsage usage_mods
802 hpt = hsc_HPT hsc_env
803 dflags = hsc_dflags hsc_env
804 this_pkg = thisPackage dflags
806 used_mods = moduleEnvKeys ent_map
807 dir_imp_mods = (moduleEnvKeys direct_imports)
808 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
809 usage_mods = sortBy stableModuleCmp all_mods
810 -- canonical order is imported, to avoid interface-file
813 -- ent_map groups together all the things imported and used
814 -- from a particular module
815 ent_map :: ModuleEnv [OccName]
816 ent_map = foldNameSet add_mv emptyModuleEnv used_names
819 | isWiredInName name = mv_map -- ignore wired-in names
821 = case nameModule_maybe name of
822 Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
823 Just mod -> -- We use this fiddly lambda function rather than
824 -- (++) as the argument to extendModuleEnv_C to
825 -- avoid quadratic behaviour (trac #2680)
826 extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
827 where occ = nameOccName name
829 -- We want to create a Usage for a home module if
830 -- a) we used something from it; has something in used_names
831 -- b) we imported it, even if we used nothing from it
832 -- (need to recompile if its export list changes: export_fprint)
833 mkUsage :: Module -> Maybe Usage
835 | isNothing maybe_iface -- We can't depend on it if we didn't
836 -- load its interface.
837 || mod == this_mod -- We don't care about usages of
838 -- things in *this* module
841 | modulePackageId mod /= this_pkg
842 = Just UsagePackageModule{ usg_mod = mod,
843 usg_mod_hash = mod_hash }
844 -- for package modules, we record the module hash only
847 && isNothing export_hash
848 && not is_direct_import
850 = Nothing -- Record no usage info
851 -- for directly-imported modules, we always want to record a usage
852 -- on the orphan hash. This is what triggers a recompilation if
853 -- an orphan is added or removed somewhere below us in the future.
856 = Just UsageHomeModule {
857 usg_mod_name = moduleName mod,
858 usg_mod_hash = mod_hash,
859 usg_exports = export_hash,
860 usg_entities = fmToList ent_hashs }
862 maybe_iface = lookupIfaceByModule dflags hpt pit mod
863 -- In one-shot mode, the interfaces for home-package
864 -- modules accumulate in the PIT not HPT. Sigh.
866 is_direct_import = mod `elemModuleEnv` direct_imports
868 Just iface = maybe_iface
869 finsts_mod = mi_finsts iface
870 hash_env = mi_hash_fn iface
871 mod_hash = mi_mod_hash iface
872 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
873 | otherwise = Nothing
875 used_occs = lookupModuleEnv ent_map mod `orElse` []
877 -- Making a FiniteMap here ensures that (a) we remove duplicates
878 -- when we have usages on several subordinates of a single parent,
879 -- and (b) that the usages emerge in a canonical order, which
880 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
881 -- using Ord on the OccNames, which is a lexicographic ordering.
882 ent_hashs :: FiniteMap OccName Fingerprint
883 ent_hashs = listToFM (map lookup_occ used_occs)
887 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
890 depend_on_exports mod =
891 case lookupModuleEnv direct_imports mod of
893 -- Even if we used 'import M ()', we have to register a
894 -- usage on the export list because we are sensitive to
895 -- changes in orphan instances/rules.
897 -- In GHC 6.8.x the above line read "True", and in
898 -- fact it recorded a dependency on *all* the
899 -- modules underneath in the dependency tree. This
900 -- happens to make orphans work right, but is too
901 -- expensive: it'll read too many interface files.
902 -- The 'isNothing maybe_iface' check above saved us
903 -- from generating many of these usages (at least in
904 -- one-shot mode), but that's even more bogus!
908 mkIfaceExports :: [AvailInfo]
909 -> [(Module, [GenAvailInfo OccName])]
910 -- Group by module and sort by occurrence
911 -- This keeps the list in canonical order
912 mkIfaceExports exports
913 = [ (mod, eltsFM avails)
914 | (mod, avails) <- fmToList groupFM
917 -- Group by the module where the exported entities are defined
918 -- (which may not be the same for all Names in an Avail)
919 -- Deliberately use FiniteMap rather than UniqFM so we
920 -- get a canonical ordering
921 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
922 groupFM = foldl add emptyModuleEnv exports
924 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
925 -> Module -> GenAvailInfo OccName
926 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
927 add_one env mod avail
928 = extendModuleEnv_C plusFM env mod
929 (unitFM (occNameFS (availName avail)) avail)
931 -- NB: we should not get T(X) and T(Y) in the export list
932 -- else the plusFM will simply discard one! They
933 -- should have been combined by now.
935 = ASSERT( isExternalName n )
936 add_one env (nameModule n) (Avail (nameOccName n))
938 add env (AvailTC tc ns)
939 = ASSERT( all isExternalName ns )
940 foldl add_for_mod env mods
942 tc_occ = nameOccName tc
943 mods = nub (map nameModule ns)
944 -- Usually just one, but see Note [Original module]
947 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
948 -- NB. sort the children, we need a canonical order
950 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
953 Note [Orignal module]
954 ~~~~~~~~~~~~~~~~~~~~~
956 module X where { data family T }
957 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
958 The exported Avail from Y will look like
961 - only MkT is brought into scope by the data instance;
962 - but the parent (used for grouping and naming in T(..) exports) is X.T
963 - and in this case we export X.T too
965 In the result of MkIfaceExports, the names are grouped by defining module,
966 so we may need to split up a single Avail into multiple ones.
969 %************************************************************************
971 Load the old interface file for this module (unless
972 we have it aleady), and check whether it is up to date
975 %************************************************************************
978 checkOldIface :: HscEnv
980 -> Bool -- Source unchanged
981 -> Maybe ModIface -- Old interface from compilation manager, if any
982 -> IO (RecompileRequired, Maybe ModIface)
984 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
985 = do { showPass (hsc_dflags hsc_env)
986 ("Checking old interface for " ++
987 showSDoc (ppr (ms_mod mod_summary))) ;
989 ; initIfaceCheck hsc_env $
990 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
993 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
994 -> IfG (Bool, Maybe ModIface)
995 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
996 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
997 { when (not source_unchanged)
998 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1000 -- If the source has changed and we're in interactive mode, avoid reading
1001 -- an interface; just return the one we might have been supplied with.
1002 ; let dflags = hsc_dflags hsc_env
1003 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1004 return (outOfDate, maybe_iface)
1006 case maybe_iface of {
1007 Just old_iface -> do -- Use the one we already have
1008 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1009 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1010 ; return (recomp, Just old_iface) }
1014 -- Try and read the old interface for the current module
1015 -- from the .hi file left from the last time we compiled it
1016 { let iface_path = msHiFilePath mod_summary
1017 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1018 ; case read_result of {
1019 Failed err -> do -- Old interface file not found, or garbled; give up
1020 { traceIf (text "FYI: cannot read old interface file:"
1022 ; return (outOfDate, Nothing) }
1024 ; Succeeded iface -> do
1026 -- We have got the old iface; check its versions
1027 { traceIf (text "Read the interface file" <+> text iface_path)
1028 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1029 ; return (recomp, Just iface)
1034 @recompileRequired@ is called from the HscMain. It checks whether
1035 a recompilation is required. It needs access to the persistent state,
1036 finder, etc, because it may have to load lots of interface files to
1037 check their versions.
1040 type RecompileRequired = Bool
1041 upToDate, outOfDate :: Bool
1042 upToDate = False -- Recompile not required
1043 outOfDate = True -- Recompile required
1045 checkVersions :: HscEnv
1046 -> Bool -- True <=> source unchanged
1048 -> ModIface -- Old interface
1049 -> IfG RecompileRequired
1050 checkVersions hsc_env source_unchanged mod_summary iface
1051 | not source_unchanged
1054 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1055 ppr (mi_module iface) <> colon)
1057 ; recomp <- checkDependencies hsc_env mod_summary iface
1058 ; if recomp then return outOfDate else do {
1060 -- Source code unchanged and no errors yet... carry on
1062 -- First put the dependent-module info, read from the old
1063 -- interface, into the envt, so that when we look for
1064 -- interfaces we look for the right one (.hi or .hi-boot)
1066 -- It's just temporary because either the usage check will succeed
1067 -- (in which case we are done with this module) or it'll fail (in which
1068 -- case we'll compile the module from scratch anyhow).
1070 -- We do this regardless of compilation mode, although in --make mode
1071 -- all the dependent modules should be in the HPT already, so it's
1073 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1075 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1076 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1079 -- This is a bit of a hack really
1080 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1081 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1084 -- If the direct imports of this module are resolved to targets that
1085 -- are not among the dependencies of the previous interface file,
1086 -- then we definitely need to recompile. This catches cases like
1087 -- - an exposed package has been upgraded
1088 -- - we are compiling with different package flags
1089 -- - a home module that was shadowing a package module has been removed
1090 -- - a new home module has been added that shadows a package module
1093 -- Returns True if recompilation is required.
1094 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1095 checkDependencies hsc_env summary iface
1096 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1098 prev_dep_mods = dep_mods (mi_deps iface)
1099 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1101 this_pkg = thisPackage (hsc_dflags hsc_env)
1103 orM = foldr f (return False)
1104 where f m rest = do b <- m; if b then return True else rest
1106 dep_missing (L _ mod) = do
1107 find_res <- liftIO $ findImportedModule hsc_env mod Nothing
1111 -> if moduleName mod `notElem` map fst prev_dep_mods
1112 then do traceHiDiffs $
1113 text "imported module " <> quotes (ppr mod) <>
1114 text " not among previous dependencies"
1119 -> if pkg `notElem` prev_dep_pkgs
1120 then do traceHiDiffs $
1121 text "imported module " <> quotes (ppr mod) <>
1122 text " is from package " <> quotes (ppr pkg) <>
1123 text ", which is not among previous dependencies"
1127 where pkg = modulePackageId mod
1128 _otherwise -> return outOfDate
1130 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1131 -> IfG RecompileRequired
1132 needInterface mod continue
1133 = do -- Load the imported interface if possible
1134 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1135 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1137 mb_iface <- loadInterface doc_str mod ImportBySystem
1138 -- Load the interface, but don't complain on failure;
1139 -- Instead, get an Either back which we can test
1142 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1144 -- Couldn't find or parse a module mentioned in the
1145 -- old interface file. Don't complain: it might
1146 -- just be that the current module doesn't need that
1147 -- import and it's been deleted
1148 Succeeded iface -> continue iface
1151 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1152 -- Given the usage information extracted from the old
1153 -- M.hi file for the module being compiled, figure out
1154 -- whether M needs to be recompiled.
1156 checkModUsage _this_pkg UsagePackageModule{
1158 usg_mod_hash = old_mod_hash }
1159 = needInterface mod $ \iface -> do
1160 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1161 -- We only track the ABI hash of package modules, rather than
1162 -- individual entity usages, so if the ABI hash changes we must
1163 -- recompile. This is safe but may entail more recompilation when
1164 -- a dependent package has changed.
1166 checkModUsage this_pkg UsageHomeModule{
1167 usg_mod_name = mod_name,
1168 usg_mod_hash = old_mod_hash,
1169 usg_exports = maybe_old_export_hash,
1170 usg_entities = old_decl_hash }
1172 let mod = mkModule this_pkg mod_name
1173 needInterface mod $ \iface -> do
1176 new_mod_hash = mi_mod_hash iface
1177 new_decl_hash = mi_hash_fn iface
1178 new_export_hash = mi_exp_hash iface
1181 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1182 if not recompile then return upToDate else do
1184 -- CHECK EXPORT LIST
1185 checkMaybeHash maybe_old_export_hash new_export_hash
1186 (ptext (sLit " Export list changed")) $ do
1188 -- CHECK ITEMS ONE BY ONE
1189 recompile <- checkList [ checkEntityUsage new_decl_hash u
1190 | u <- old_decl_hash]
1192 then return outOfDate -- This one failed, so just bail out now
1193 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1195 ------------------------
1196 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1197 checkModuleFingerprint old_mod_hash new_mod_hash
1198 | new_mod_hash == old_mod_hash
1199 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1202 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1203 old_mod_hash new_mod_hash
1205 ------------------------
1206 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1207 -> IfG RecompileRequired -> IfG RecompileRequired
1208 checkMaybeHash maybe_old_hash new_hash doc continue
1209 | Just hash <- maybe_old_hash, hash /= new_hash
1210 = out_of_date_hash doc hash new_hash
1214 ------------------------
1215 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1216 -> (OccName, Fingerprint)
1218 checkEntityUsage new_hash (name,old_hash)
1219 = case new_hash name of
1221 Nothing -> -- We used it before, but it ain't there now
1222 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1224 Just (_, new_hash) -- It's there, but is it up to date?
1225 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1227 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1230 up_to_date, out_of_date :: SDoc -> IfG Bool
1231 up_to_date msg = traceHiDiffs msg >> return upToDate
1232 out_of_date msg = traceHiDiffs msg >> return outOfDate
1234 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1235 out_of_date_hash msg old_hash new_hash
1236 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1238 ----------------------
1239 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1240 -- This helper is used in two places
1241 checkList [] = return upToDate
1242 checkList (check:checks) = do recompile <- check
1244 then return outOfDate
1245 else checkList checks
1248 %************************************************************************
1250 Converting things to their Iface equivalents
1252 %************************************************************************
1255 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1256 -- Assumption: the thing is already tidied, so that locally-bound names
1257 -- (lambdas, for-alls) already have non-clashing OccNames
1258 -- Reason: Iface stuff uses OccNames, and the conversion here does
1259 -- not do tidying on the way
1260 tyThingToIfaceDecl (AnId id)
1261 = IfaceId { ifName = getOccName id,
1262 ifType = toIfaceType (idType id),
1265 info = case toIfaceIdInfo (idInfo id) of
1267 items -> HasInfo items
1269 tyThingToIfaceDecl (AClass clas)
1270 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1271 ifName = getOccName clas,
1272 ifTyVars = toIfaceTvBndrs clas_tyvars,
1273 ifFDs = map toIfaceFD clas_fds,
1274 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1275 ifSigs = map toIfaceClassOp op_stuff,
1276 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1278 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1279 = classExtraBigSig clas
1280 tycon = classTyCon clas
1282 toIfaceClassOp (sel_id, def_meth)
1283 = ASSERT(sel_tyvars == clas_tyvars)
1284 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1286 -- Be careful when splitting the type, because of things
1287 -- like class Foo a where
1288 -- op :: (?x :: String) => a -> a
1289 -- and class Baz a where
1290 -- op :: (Ord a) => a -> a
1291 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1292 op_ty = funResultTy rho_ty
1294 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1296 tyThingToIfaceDecl (ATyCon tycon)
1298 = IfaceSyn { ifName = getOccName tycon,
1299 ifTyVars = toIfaceTvBndrs tyvars,
1302 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1306 = IfaceData { ifName = getOccName tycon,
1307 ifTyVars = toIfaceTvBndrs tyvars,
1308 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1309 ifCons = ifaceConDecls (algTyConRhs tycon),
1310 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1311 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1312 ifGeneric = tyConHasGenerics tycon,
1313 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1315 | isForeignTyCon tycon
1316 = IfaceForeign { ifName = getOccName tycon,
1317 ifExtName = tyConExtName tycon }
1319 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1321 tyvars = tyConTyVars tycon
1323 = case synTyConRhs tycon of
1324 OpenSynTyCon ki _ -> (Nothing, toIfaceType ki)
1325 SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1327 ifaceConDecls (NewTyCon { data_con = con }) =
1328 IfNewTyCon (ifaceConDecl con)
1329 ifaceConDecls (DataTyCon { data_cons = cons }) =
1330 IfDataTyCon (map ifaceConDecl cons)
1331 ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
1332 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1333 -- The last case happens when a TyCon has been trimmed during tidying
1334 -- Furthermore, tyThingToIfaceDecl is also used
1335 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1336 -- AbstractTyCon case is perfectly sensible.
1338 ifaceConDecl data_con
1339 = IfCon { ifConOcc = getOccName (dataConName data_con),
1340 ifConInfix = dataConIsInfix data_con,
1341 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1342 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1343 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1344 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1345 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1346 ifConFields = map getOccName
1347 (dataConFieldLabels data_con),
1348 ifConStricts = dataConStrictMarks data_con }
1350 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1352 famInstToIface Nothing = Nothing
1353 famInstToIface (Just (famTyCon, instTys)) =
1354 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1356 tyThingToIfaceDecl (ADataCon dc)
1357 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1360 getFS :: NamedThing a => a -> FastString
1361 getFS x = occNameFS (getOccName x)
1363 --------------------------
1364 instanceToIfaceInst :: Instance -> IfaceInst
1365 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1366 is_cls = cls_name, is_tcs = mb_tcs })
1367 = ASSERT( cls_name == className cls )
1368 IfaceInst { ifDFun = dfun_name,
1370 ifInstCls = cls_name,
1371 ifInstTys = map do_rough mb_tcs,
1374 do_rough Nothing = Nothing
1375 do_rough (Just n) = Just (toIfaceTyCon_name n)
1377 dfun_name = idName dfun_id
1378 mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1379 is_local name = nameIsLocalOrFrom mod name
1381 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1382 (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1383 -- Slightly awkward: we need the Class to get the fundeps
1384 (tvs, fds) = classTvsFds cls
1385 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1386 orph | is_local cls_name = Just (nameOccName cls_name)
1387 | all isJust mb_ns = head mb_ns
1388 | otherwise = Nothing
1390 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1391 -- that is not in the "determined" arguments
1392 mb_ns | null fds = [choose_one arg_names]
1393 | otherwise = map do_one fds
1394 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1395 , not (tv `elem` rtvs)]
1397 choose_one :: [NameSet] -> Maybe OccName
1398 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1400 (n : _) -> Just (nameOccName n)
1402 --------------------------
1403 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1404 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1407 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1408 , ifFamInstFam = fam
1409 , ifFamInstTys = map do_rough mb_tcs }
1411 do_rough Nothing = Nothing
1412 do_rough (Just n) = Just (toIfaceTyCon_name n)
1414 --------------------------
1415 toIfaceLetBndr :: Id -> IfaceLetBndr
1416 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1417 (toIfaceType (idType id))
1420 -- Stripped-down version of tcIfaceIdInfo
1421 -- Change this if you want to export more IdInfo for
1422 -- non-top-level Ids. Don't forget to change
1423 -- CoreTidy.tidyLetBndr too!
1425 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1427 inline_prag = inlinePragInfo id_info
1428 prag_info | isAlwaysActive inline_prag = NoInfo
1429 | otherwise = HasInfo [HsInline inline_prag]
1431 --------------------------
1432 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1433 toIfaceIdInfo id_info
1434 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1435 inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
1437 ------------ Arity --------------
1438 arity_info = arityInfo id_info
1439 arity_hsinfo | arity_info == 0 = Nothing
1440 | otherwise = Just (HsArity arity_info)
1442 ------------ Caf Info --------------
1443 caf_info = cafInfo id_info
1444 caf_hsinfo = case caf_info of
1445 NoCafRefs -> Just HsNoCafRefs
1448 ------------ Strictness --------------
1449 -- No point in explicitly exporting TopSig
1450 strict_hsinfo = case newStrictnessInfo id_info of
1451 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1454 ------------ Worker --------------
1455 work_info = workerInfo id_info
1456 has_worker = workerExists work_info
1457 wrkr_hsinfo = case work_info of
1458 HasWorker work_id wrap_arity ->
1459 Just (HsWorker ((idName work_id)) wrap_arity)
1462 ------------ Unfolding --------------
1463 -- The unfolding is redundant if there is a worker
1464 unfold_info = unfoldingInfo id_info
1465 rhs = unfoldingTemplate unfold_info
1466 no_unfolding = neverUnfold unfold_info
1467 -- The CoreTidy phase retains unfolding info iff
1468 -- we want to expose the unfolding, taking into account
1469 -- unconditional NOINLINE, etc. See TidyPgm.addExternal
1470 unfold_hsinfo | no_unfolding = Nothing
1471 | has_worker = Nothing -- Unfolding is implicit
1472 | otherwise = Just (HsUnfold (toIfaceExpr rhs))
1474 ------------ Inline prag --------------
1475 inline_prag = inlinePragInfo id_info
1476 inline_hsinfo | isAlwaysActive inline_prag = Nothing
1477 | no_unfolding && not has_worker = Nothing
1478 -- If the iface file give no unfolding info, we
1479 -- don't need to say when inlining is OK!
1480 | otherwise = Just (HsInline inline_prag)
1482 --------------------------
1483 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1484 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1485 = pprTrace "toHsRule: builtin" (ppr fn) $
1488 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1489 ru_act = act, ru_bndrs = bndrs,
1490 ru_args = args, ru_rhs = rhs })
1491 = IfaceRule { ifRuleName = name, ifActivation = act,
1492 ifRuleBndrs = map toIfaceBndr bndrs,
1494 ifRuleArgs = map do_arg args,
1495 ifRuleRhs = toIfaceExpr rhs,
1498 -- For type args we must remove synonyms from the outermost
1499 -- level. Reason: so that when we read it back in we'll
1500 -- construct the same ru_rough field as we have right now;
1502 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1503 do_arg arg = toIfaceExpr arg
1505 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1506 -- A rule is an orphan only if none of the variables
1507 -- mentioned on its left-hand side are locally defined
1508 lhs_names = fn : nameSetToList (exprsFreeNames args)
1509 -- No need to delete bndrs, because
1510 -- exprsFreeNames finds only External names
1512 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1513 (n : _) -> Just (nameOccName n)
1516 bogusIfaceRule :: Name -> IfaceRule
1517 bogusIfaceRule id_name
1518 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1519 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1520 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1522 ---------------------
1523 toIfaceExpr :: CoreExpr -> IfaceExpr
1524 toIfaceExpr (Var v) = toIfaceVar v
1525 toIfaceExpr (Lit l) = IfaceLit l
1526 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1527 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1528 toIfaceExpr (App f a) = toIfaceApp f [a]
1529 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1530 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1531 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1532 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1534 ---------------------
1535 toIfaceNote :: Note -> IfaceNote
1536 toIfaceNote (SCC cc) = IfaceSCC cc
1537 toIfaceNote InlineMe = IfaceInlineMe
1538 toIfaceNote (CoreNote s) = IfaceCoreNote s
1540 ---------------------
1541 toIfaceBind :: Bind Id -> IfaceBinding
1542 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1543 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1545 ---------------------
1546 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1547 -> (IfaceConAlt, [FastString], IfaceExpr)
1548 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1550 ---------------------
1551 toIfaceCon :: AltCon -> IfaceConAlt
1552 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1553 | otherwise = IfaceDataAlt (getName dc)
1555 tc = dataConTyCon dc
1557 toIfaceCon (LitAlt l) = IfaceLitAlt l
1558 toIfaceCon DEFAULT = IfaceDefault
1560 ---------------------
1561 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1562 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1563 toIfaceApp (Var v) as
1564 = case isDataConWorkId_maybe v of
1565 -- We convert the *worker* for tuples into IfaceTuples
1566 Just dc | isTupleTyCon tc && saturated
1567 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1569 val_args = dropWhile isTypeArg as
1570 saturated = val_args `lengthIs` idArity v
1571 tup_args = map toIfaceExpr val_args
1572 tc = dataConTyCon dc
1574 _ -> mkIfaceApps (toIfaceVar v) as
1576 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1578 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1579 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1581 ---------------------
1582 toIfaceVar :: Id -> IfaceExpr
1584 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1585 -- Foreign calls have special syntax
1586 | isExternalName name = IfaceExt name
1587 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1589 | otherwise = IfaceLcl (getFS name)