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"
86 import BasicTypes hiding ( SuccessFlag(..) )
89 import Util hiding ( eqListBy )
102 import System.FilePath
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
119 Maybe (ModIface, -- The new one
120 Bool)) -- True <=> there was an old Iface, and the
121 -- new one is identical, so no need
124 mkIface hsc_env maybe_old_fingerprint mod_details
125 ModGuts{ mg_module = this_mod,
127 mg_used_names = used_names,
129 mg_dir_imps = dir_imp_mods,
130 mg_rdr_env = rdr_env,
131 mg_fix_env = fix_env,
133 mg_hpc_info = hpc_info }
134 = mkIface_ hsc_env maybe_old_fingerprint
135 this_mod is_boot used_names deps rdr_env
136 fix_env warns hpc_info dir_imp_mods mod_details
138 -- | make an interface from the results of typechecking only. Useful
139 -- for non-optimising compilation, or where we aren't generating any
140 -- object code at all ('HscNothing').
142 -> Maybe Fingerprint -- The old fingerprint, if we have it
143 -> ModDetails -- gotten from mkBootModDetails, probably
144 -> TcGblEnv -- Usages, deprecations, etc
145 -> IO (Messages, Maybe (ModIface, Bool))
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 (Messages, Maybe (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,
224 md_vect_info = vect_info,
226 md_exports = exports }
227 -- NB: notice that mkIface does not look at the bindings
228 -- only at the TypeEnv. The previous Tidy phase has
229 -- put exactly the info into the TypeEnv that we want
230 -- to expose in the interface
232 = do { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
234 ; let { entities = typeEnvElts type_env ;
235 decls = [ tyThingToIfaceDecl entity
236 | entity <- entities,
237 let name = getName entity,
238 not (isImplicitTyThing entity),
239 -- No implicit Ids and class tycons in the interface file
240 not (isWiredInName name),
241 -- Nor wired-in things; the compiler knows about them anyhow
242 nameIsLocalOrFrom this_mod name ]
243 -- Sigh: see Note [Root-main Id] in TcRnDriver
245 ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
247 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
248 ; iface_insts = map instanceToIfaceInst insts
249 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
250 ; iface_vect_info = flattenVectInfo vect_info
252 ; intermediate_iface = ModIface {
253 mi_module = this_mod,
257 mi_exports = mkIfaceExports exports,
259 -- Sort these lexicographically, so that
260 -- the result is stable across compilations
261 mi_insts = sortLe le_inst iface_insts,
262 mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
263 mi_rules = sortLe le_rule iface_rules,
265 mi_vect_info = iface_vect_info,
267 mi_fixities = fixities,
269 mi_anns = mkIfaceAnnotations anns,
270 mi_globals = Just rdr_env,
272 -- Left out deliberately: filled in by addVersionInfo
273 mi_iface_hash = fingerprint0,
274 mi_mod_hash = fingerprint0,
275 mi_exp_hash = fingerprint0,
276 mi_orphan_hash = fingerprint0,
277 mi_orphan = False, -- Always set by addVersionInfo, but
278 -- it's a strict field, so we can't omit it.
279 mi_finsts = False, -- Ditto
280 mi_decls = deliberatelyOmitted "decls",
281 mi_hash_fn = deliberatelyOmitted "hash_fn",
282 mi_hpc = isHpcUsed hpc_info,
284 -- And build the cached values
285 mi_warn_fn = mkIfaceWarnCache warns,
286 mi_fix_fn = mkIfaceFixCache fixities }
289 ; (new_iface, no_change_at_all)
290 <- {-# SCC "versioninfo" #-}
291 addFingerprints hsc_env maybe_old_fingerprint
292 intermediate_iface decls
294 -- Warn about orphans
295 ; let orph_warnings --- Laziness means no work done unless -fwarn-orphans
296 | dopt Opt_WarnOrphans dflags = rule_warns `unionBags` inst_warns
297 | otherwise = emptyBag
298 errs_and_warns = (orph_warnings, emptyBag)
299 unqual = mkPrintUnqualified dflags rdr_env
300 inst_warns = listToBag [ instOrphWarn unqual d
301 | (d,i) <- insts `zip` iface_insts
302 , isNothing (ifInstOrph i) ]
303 rule_warns = listToBag [ ruleOrphWarn unqual this_mod r
305 , isNothing (ifRuleOrph r) ]
307 ; if errorsFound dflags errs_and_warns
308 then return ( errs_and_warns, Nothing )
311 -- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
314 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
315 (pprModIface new_iface)
317 -- bug #1617: on reload we weren't updating the PrintUnqualified
318 -- correctly. This stems from the fact that the interface had
319 -- not changed, so addVersionInfo returns the old ModIface
320 -- with the old GlobalRdrEnv (mi_globals).
321 ; let final_iface = new_iface{ mi_globals = Just rdr_env }
323 ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
325 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
326 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
327 i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
329 le_occ :: Name -> Name -> Bool
330 -- Compare lexicographically by OccName, *not* by unique, because
331 -- the latter is not stable across compilations
332 le_occ n1 n2 = nameOccName n1 <= nameOccName n2
334 dflags = hsc_dflags hsc_env
335 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
336 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
338 flattenVectInfo (VectInfo { vectInfoVar = vVar
339 , vectInfoTyCon = vTyCon
342 ifaceVectInfoVar = [ Var.varName v
343 | (v, _) <- varEnvElts vVar],
344 ifaceVectInfoTyCon = [ tyConName t
345 | (t, t_v) <- nameEnvElts vTyCon
347 ifaceVectInfoTyConReuse = [ tyConName t
348 | (t, t_v) <- nameEnvElts vTyCon
352 -----------------------------
353 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
354 writeIfaceFile dflags location new_iface
355 = do createDirectoryHierarchy (takeDirectory hi_file_path)
356 writeBinIface dflags hi_file_path new_iface
357 where hi_file_path = ml_hi_file location
360 -- -----------------------------------------------------------------------------
361 -- Look up parents and versions of Names
363 -- This is like a global version of the mi_hash_fn field in each ModIface.
364 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
365 -- the parent and version info.
368 :: HscEnv -- needed to look up versions
369 -> ExternalPackageState -- ditto
370 -> (Name -> Fingerprint)
371 mkHashFun hsc_env eps
374 mod = ASSERT2( isExternalName name, ppr name ) nameModule name
375 occ = nameOccName name
376 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
377 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
379 snd (mi_hash_fn iface occ `orElse`
380 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
382 hpt = hsc_HPT hsc_env
385 -- ---------------------------------------------------------------------------
386 -- Compute fingerprints for the interface
390 -> Maybe Fingerprint -- the old fingerprint, if any
391 -> ModIface -- The new interface (lacking decls)
392 -> [IfaceDecl] -- The new decls
393 -> IO (ModIface, -- Updated interface
394 Bool) -- True <=> no changes at all;
395 -- no need to write Iface
397 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
399 eps <- hscEPS hsc_env
401 -- the ABI of a declaration represents everything that is made
402 -- visible about the declaration that a client can depend on.
403 -- see IfaceDeclABI below.
404 declABI :: IfaceDecl -> IfaceDeclABI
405 declABI decl = (this_mod, decl, extras)
406 where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
408 edges :: [(IfaceDeclABI, Unique, [Unique])]
409 edges = [ (abi, getUnique (ifName decl), out)
411 , let abi = declABI decl
412 , let out = localOccs $ freeNamesDeclABI abi
415 name_module n = ASSERT( isExternalName n ) nameModule n
416 localOccs = map (getUnique . getParent . getOccName)
417 . filter ((== this_mod) . name_module)
419 where getParent occ = lookupOccEnv parent_map occ `orElse` occ
421 -- maps OccNames to their parents in the current module.
422 -- e.g. a reference to a constructor must be turned into a reference
423 -- to the TyCon for the purposes of calculating dependencies.
424 parent_map :: OccEnv OccName
425 parent_map = foldr extend emptyOccEnv new_decls
427 extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
430 -- strongly-connected groups of declarations, in dependency order
431 groups = stronglyConnCompFromEdgedVertices edges
433 global_hash_fn = mkHashFun hsc_env eps
435 -- how to output Names when generating the data to fingerprint.
436 -- Here we want to output the fingerprint for each top-level
437 -- Name, whether it comes from the current module or another
438 -- module. In this way, the fingerprint for a declaration will
439 -- change if the fingerprint for anything it refers to (transitively)
441 mk_put_name :: (OccEnv (OccName,Fingerprint))
442 -> BinHandle -> Name -> IO ()
443 mk_put_name local_env bh name
444 | isWiredInName name = putNameLiterally bh name
445 -- wired-in names don't have fingerprints
447 = ASSERT( isExternalName name )
448 let hash | nameModule name /= this_mod = global_hash_fn name
450 snd (lookupOccEnv local_env (getOccName name)
451 `orElse` pprPanic "urk! lookup local fingerprint"
452 (ppr name)) -- (undefined,fingerprint0))
453 -- This panic indicates that we got the dependency
454 -- analysis wrong, because we needed a fingerprint for
455 -- an entity that wasn't in the environment. To debug
456 -- it, turn the panic into a trace, uncomment the
457 -- pprTraces below, run the compile again, and inspect
458 -- the output and the generated .hi file with
463 -- take a strongly-connected group of declarations and compute
466 fingerprint_group :: (OccEnv (OccName,Fingerprint),
467 [(Fingerprint,IfaceDecl)])
469 -> IO (OccEnv (OccName,Fingerprint),
470 [(Fingerprint,IfaceDecl)])
472 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
473 = do let hash_fn = mk_put_name local_env
475 -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
476 hash <- computeFingerprint dflags hash_fn abi
477 return (extend_hash_env (hash,decl) local_env,
478 (hash,decl) : decls_w_hashes)
480 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
481 = do let decls = map abiDecl abis
482 local_env' = foldr extend_hash_env local_env
483 (zip (repeat fingerprint0) decls)
484 hash_fn = mk_put_name local_env'
485 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
486 let stable_abis = sortBy cmp_abiNames abis
487 -- put the cycle in a canonical order
488 hash <- computeFingerprint dflags hash_fn stable_abis
489 let pairs = zip (repeat hash) decls
490 return (foldr extend_hash_env local_env pairs,
491 pairs ++ decls_w_hashes)
493 extend_hash_env :: (Fingerprint,IfaceDecl)
494 -> OccEnv (OccName,Fingerprint)
495 -> OccEnv (OccName,Fingerprint)
496 extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
499 item = (decl_name, hash)
500 env1 = extendOccEnv env0 decl_name item
501 add_imp bndr env = extendOccEnv env bndr item
504 (local_env, decls_w_hashes) <-
505 foldM fingerprint_group (emptyOccEnv, []) groups
507 -- when calculating fingerprints, we always need to use canonical
508 -- ordering for lists of things. In particular, the mi_deps has various
509 -- lists of modules and suchlike, so put these all in canonical order:
510 let sorted_deps = sortDependencies (mi_deps iface0)
512 -- the export hash of a module depends on the orphan hashes of the
513 -- orphan modules below us in the dependeny tree. This is the way
514 -- that changes in orphans get propagated all the way up the
515 -- dependency tree. We only care about orphan modules in the current
516 -- package, because changes to orphans outside this package will be
517 -- tracked by the usage on the ABI hash of package modules that we import.
518 let orph_mods = filter ((== this_pkg) . modulePackageId)
519 $ dep_orphs sorted_deps
520 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
522 orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
523 (map IfaceInstABI orph_insts, orph_rules, fam_insts)
525 -- the export list hash doesn't depend on the fingerprints of
526 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
527 export_hash <- computeFingerprint dflags putNameLiterally
528 (mi_exports iface0, orphan_hash, dep_orphan_hashes)
530 -- put the declarations in a canonical order, sorted by OccName
531 let sorted_decls = eltsFM $ listToFM $
532 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
534 -- the ABI hash depends on:
540 mod_hash <- computeFingerprint dflags putNameLiterally
541 (map fst sorted_decls,
546 -- The interface hash depends on:
547 -- - the ABI hash, plus
551 iface_hash <- computeFingerprint dflags putNameLiterally
558 no_change_at_all = Just iface_hash == mb_old_fingerprint
560 final_iface = iface0 {
561 mi_mod_hash = mod_hash,
562 mi_iface_hash = iface_hash,
563 mi_exp_hash = export_hash,
564 mi_orphan_hash = orphan_hash,
565 mi_orphan = not (null orph_rules && null orph_insts),
566 mi_finsts = not . null $ mi_fam_insts iface0,
567 mi_decls = sorted_decls,
568 mi_hash_fn = lookupOccEnv local_env }
570 return (final_iface, no_change_at_all)
573 this_mod = mi_module iface0
574 dflags = hsc_dflags hsc_env
575 this_pkg = thisPackage dflags
576 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
577 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
578 -- ToDo: shouldn't we be splitting fam_insts into orphans and
580 fam_insts = mi_fam_insts iface0
581 fix_fn = mi_fix_fn iface0
584 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
585 getOrphanHashes hsc_env mods = do
586 eps <- hscEPS hsc_env
588 hpt = hsc_HPT hsc_env
590 dflags = hsc_dflags hsc_env
592 case lookupIfaceByModule dflags hpt pit mod of
593 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
594 Just iface -> mi_orphan_hash iface
596 return (map get_orph_hash mods)
599 sortDependencies :: Dependencies -> Dependencies
601 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
602 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
603 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
604 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
606 -- The ABI of a declaration consists of:
607 -- the full name of the identifier (inc. module and package, because
608 -- these are used to construct the symbol name by which the
609 -- identifier is known externally).
610 -- the fixity of the identifier
611 -- the declaration itself, as exposed to clients. That is, the
612 -- definition of an Id is included in the fingerprint only if
613 -- it is made available as as unfolding in the interface.
615 -- for classes: instances, fixity & rules for methods
616 -- for datatypes: instances, fixity & rules for constrs
617 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
619 abiDecl :: IfaceDeclABI -> IfaceDecl
620 abiDecl (_, decl, _) = decl
622 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
623 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
624 ifName (abiDecl abi2)
626 freeNamesDeclABI :: IfaceDeclABI -> NameSet
627 freeNamesDeclABI (_mod, decl, extras) =
628 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
631 = IfaceIdExtras Fixity [IfaceRule]
632 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
633 | IfaceClassExtras [IfaceInstABI] [(Fixity,[IfaceRule])]
634 | IfaceOtherDeclExtras
636 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
637 freeNamesDeclExtras (IfaceIdExtras _ rules)
638 = unionManyNameSets (map freeNamesIfRule rules)
639 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
640 = unionManyNameSets (map freeNamesSub subs)
641 freeNamesDeclExtras (IfaceClassExtras _insts subs)
642 = unionManyNameSets (map freeNamesSub subs)
643 freeNamesDeclExtras IfaceOtherDeclExtras
646 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
647 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
649 instance Binary IfaceDeclExtras where
650 get _bh = panic "no get for IfaceDeclExtras"
651 put_ bh (IfaceIdExtras fix rules) = do
652 putByte bh 1; put_ bh fix; put_ bh rules
653 put_ bh (IfaceDataExtras fix insts cons) = do
654 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
655 put_ bh (IfaceClassExtras insts methods) = do
656 putByte bh 3; put_ bh insts; put_ bh methods
657 put_ bh IfaceOtherDeclExtras = do
660 declExtras :: (OccName -> Fixity)
661 -> OccEnv [IfaceRule]
662 -> OccEnv [IfaceInst]
666 declExtras fix_fn rule_env inst_env decl
668 IfaceId{} -> IfaceIdExtras (fix_fn n)
669 (lookupOccEnvL rule_env n)
670 IfaceData{ifCons=cons} ->
671 IfaceDataExtras (fix_fn n)
672 (map IfaceInstABI $ lookupOccEnvL inst_env n)
673 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
674 IfaceClass{ifSigs=sigs} ->
676 (map IfaceInstABI $ lookupOccEnvL inst_env n)
677 [id_extras op | IfaceClassOp op _ _ <- sigs]
678 _other -> IfaceOtherDeclExtras
681 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
684 -- When hashing an instance, we hash only its structure, not the
685 -- fingerprints of the things it mentions. See the section on instances
686 -- in the commentary,
687 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
689 newtype IfaceInstABI = IfaceInstABI IfaceInst
691 instance Binary IfaceInstABI where
692 get = panic "no get for IfaceInstABI"
693 put_ bh (IfaceInstABI inst) = do
694 let ud = getUserData bh
695 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
698 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
699 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
701 -- used when we want to fingerprint a structure without depending on the
702 -- fingerprints of external Names that it refers to.
703 putNameLiterally :: BinHandle -> Name -> IO ()
704 putNameLiterally bh name = ASSERT( isExternalName name )
705 do { put_ bh $! nameModule name
706 ; put_ bh $! nameOccName name }
708 computeFingerprint :: Binary a
710 -> (BinHandle -> Name -> IO ())
714 computeFingerprint _dflags put_name a = do
715 bh <- openBinMem (3*1024) -- just less than a block
716 ud <- newWriteState put_name putFS
717 bh <- return $ setUserData bh ud
722 -- for testing: use the md5sum command to generate fingerprints and
723 -- compare the results against our built-in version.
724 fp' <- oldMD5 dflags bh
725 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
728 oldMD5 dflags bh = do
729 tmp <- newTempName dflags "bin"
731 tmp2 <- newTempName dflags "md5"
732 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
735 ExitFailure _ -> ghcError (PhaseFailed cmd r)
737 hash_str <- readFile tmp2
738 return $! readHexFingerprint hash_str
741 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
742 instOrphWarn unqual inst
743 = mkWarnMsg (getSrcSpan inst) unqual $
744 hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
746 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
747 ruleOrphWarn unqual mod rule
748 = mkWarnMsg silly_loc unqual $
749 ptext (sLit "Orphan rule:") <+> ppr rule
751 silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 0)
752 -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
753 -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
755 ----------------------
756 -- mkOrphMap partitions instance decls or rules into
757 -- (a) an OccEnv for ones that are not orphans,
758 -- mapping the local OccName to a list of its decls
759 -- (b) a list of orphan decls
760 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
761 -- Nothing for an orphan decl
762 -> [decl] -- Sorted into canonical order
763 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
764 -- each sublist in canonical order
765 [decl]) -- Orphan decls; in canonical order
766 mkOrphMap get_key decls
767 = foldl go (emptyOccEnv, []) decls
769 go (non_orphs, orphs) d
770 | Just occ <- get_key d
771 = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
772 | otherwise = (non_orphs, d:orphs)
776 %*********************************************************
778 \subsection{Keeping track of what we've slurped, and fingerprints}
780 %*********************************************************
784 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
785 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
786 = do { eps <- hscEPS hsc_env
787 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
788 dir_imp_mods used_names
789 ; usages `seqList` return usages }
790 -- seq the list of Usages returned: occasionally these
791 -- don't get evaluated for a while and we can end up hanging on to
792 -- the entire collection of Ifaces.
794 mk_usage_info :: PackageIfaceTable
800 mk_usage_info pit hsc_env this_mod direct_imports used_names
801 = mapCatMaybes mkUsage usage_mods
803 hpt = hsc_HPT hsc_env
804 dflags = hsc_dflags hsc_env
805 this_pkg = thisPackage dflags
807 used_mods = moduleEnvKeys ent_map
808 dir_imp_mods = (moduleEnvKeys direct_imports)
809 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
810 usage_mods = sortBy stableModuleCmp all_mods
811 -- canonical order is imported, to avoid interface-file
814 -- ent_map groups together all the things imported and used
815 -- from a particular module
816 ent_map :: ModuleEnv [OccName]
817 ent_map = foldNameSet add_mv emptyModuleEnv used_names
820 | isWiredInName name = mv_map -- ignore wired-in names
822 = case nameModule_maybe name of
823 Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
824 Just mod -> -- We use this fiddly lambda function rather than
825 -- (++) as the argument to extendModuleEnv_C to
826 -- avoid quadratic behaviour (trac #2680)
827 extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
828 where occ = nameOccName name
830 -- We want to create a Usage for a home module if
831 -- a) we used something from it; has something in used_names
832 -- b) we imported it, even if we used nothing from it
833 -- (need to recompile if its export list changes: export_fprint)
834 mkUsage :: Module -> Maybe Usage
836 | isNothing maybe_iface -- We can't depend on it if we didn't
837 -- load its interface.
838 || mod == this_mod -- We don't care about usages of
839 -- things in *this* module
842 | modulePackageId mod /= this_pkg
843 = Just UsagePackageModule{ usg_mod = mod,
844 usg_mod_hash = mod_hash }
845 -- for package modules, we record the module hash only
848 && isNothing export_hash
849 && not is_direct_import
851 = Nothing -- Record no usage info
852 -- for directly-imported modules, we always want to record a usage
853 -- on the orphan hash. This is what triggers a recompilation if
854 -- an orphan is added or removed somewhere below us in the future.
857 = Just UsageHomeModule {
858 usg_mod_name = moduleName mod,
859 usg_mod_hash = mod_hash,
860 usg_exports = export_hash,
861 usg_entities = fmToList ent_hashs }
863 maybe_iface = lookupIfaceByModule dflags hpt pit mod
864 -- In one-shot mode, the interfaces for home-package
865 -- modules accumulate in the PIT not HPT. Sigh.
867 is_direct_import = mod `elemModuleEnv` direct_imports
869 Just iface = maybe_iface
870 finsts_mod = mi_finsts iface
871 hash_env = mi_hash_fn iface
872 mod_hash = mi_mod_hash iface
873 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
874 | otherwise = Nothing
876 used_occs = lookupModuleEnv ent_map mod `orElse` []
878 -- Making a FiniteMap here ensures that (a) we remove duplicates
879 -- when we have usages on several subordinates of a single parent,
880 -- and (b) that the usages emerge in a canonical order, which
881 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
882 -- using Ord on the OccNames, which is a lexicographic ordering.
883 ent_hashs :: FiniteMap OccName Fingerprint
884 ent_hashs = listToFM (map lookup_occ used_occs)
888 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
891 depend_on_exports mod =
892 case lookupModuleEnv direct_imports mod of
894 -- Even if we used 'import M ()', we have to register a
895 -- usage on the export list because we are sensitive to
896 -- changes in orphan instances/rules.
898 -- In GHC 6.8.x the above line read "True", and in
899 -- fact it recorded a dependency on *all* the
900 -- modules underneath in the dependency tree. This
901 -- happens to make orphans work right, but is too
902 -- expensive: it'll read too many interface files.
903 -- The 'isNothing maybe_iface' check above saved us
904 -- from generating many of these usages (at least in
905 -- one-shot mode), but that's even more bogus!
909 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
910 mkIfaceAnnotations = map mkIfaceAnnotation
912 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
913 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
914 ifAnnotatedTarget = fmap nameOccName target,
915 ifAnnotatedValue = serialized
920 mkIfaceExports :: [AvailInfo]
921 -> [(Module, [GenAvailInfo OccName])]
922 -- Group by module and sort by occurrence
923 -- This keeps the list in canonical order
924 mkIfaceExports exports
925 = [ (mod, eltsFM avails)
926 | (mod, avails) <- fmToList groupFM
929 -- Group by the module where the exported entities are defined
930 -- (which may not be the same for all Names in an Avail)
931 -- Deliberately use FiniteMap rather than UniqFM so we
932 -- get a canonical ordering
933 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
934 groupFM = foldl add emptyModuleEnv exports
936 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
937 -> Module -> GenAvailInfo OccName
938 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
939 add_one env mod avail
940 = extendModuleEnv_C plusFM env mod
941 (unitFM (occNameFS (availName avail)) avail)
943 -- NB: we should not get T(X) and T(Y) in the export list
944 -- else the plusFM will simply discard one! They
945 -- should have been combined by now.
947 = ASSERT( isExternalName n )
948 add_one env (nameModule n) (Avail (nameOccName n))
950 add env (AvailTC tc ns)
951 = ASSERT( all isExternalName ns )
952 foldl add_for_mod env mods
954 tc_occ = nameOccName tc
955 mods = nub (map nameModule ns)
956 -- Usually just one, but see Note [Original module]
959 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
960 -- NB. sort the children, we need a canonical order
962 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
965 Note [Orignal module]
966 ~~~~~~~~~~~~~~~~~~~~~
968 module X where { data family T }
969 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
970 The exported Avail from Y will look like
973 - only MkT is brought into scope by the data instance;
974 - but the parent (used for grouping and naming in T(..) exports) is X.T
975 - and in this case we export X.T too
977 In the result of MkIfaceExports, the names are grouped by defining module,
978 so we may need to split up a single Avail into multiple ones.
981 %************************************************************************
983 Load the old interface file for this module (unless
984 we have it aleady), and check whether it is up to date
987 %************************************************************************
990 checkOldIface :: HscEnv
992 -> Bool -- Source unchanged
993 -> Maybe ModIface -- Old interface from compilation manager, if any
994 -> IO (RecompileRequired, Maybe ModIface)
996 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
997 = do { showPass (hsc_dflags hsc_env)
998 ("Checking old interface for " ++
999 showSDoc (ppr (ms_mod mod_summary))) ;
1001 ; initIfaceCheck hsc_env $
1002 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1005 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1006 -> IfG (Bool, Maybe ModIface)
1007 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1008 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
1009 { when (not source_unchanged)
1010 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1012 -- If the source has changed and we're in interactive mode, avoid reading
1013 -- an interface; just return the one we might have been supplied with.
1014 ; let dflags = hsc_dflags hsc_env
1015 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1016 return (outOfDate, maybe_iface)
1018 case maybe_iface of {
1019 Just old_iface -> do -- Use the one we already have
1020 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1021 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1022 ; return (recomp, Just old_iface) }
1026 -- Try and read the old interface for the current module
1027 -- from the .hi file left from the last time we compiled it
1028 { let iface_path = msHiFilePath mod_summary
1029 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1030 ; case read_result of {
1031 Failed err -> do -- Old interface file not found, or garbled; give up
1032 { traceIf (text "FYI: cannot read old interface file:"
1034 ; return (outOfDate, Nothing) }
1036 ; Succeeded iface -> do
1038 -- We have got the old iface; check its versions
1039 { traceIf (text "Read the interface file" <+> text iface_path)
1040 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1041 ; return (recomp, Just iface)
1046 @recompileRequired@ is called from the HscMain. It checks whether
1047 a recompilation is required. It needs access to the persistent state,
1048 finder, etc, because it may have to load lots of interface files to
1049 check their versions.
1052 type RecompileRequired = Bool
1053 upToDate, outOfDate :: Bool
1054 upToDate = False -- Recompile not required
1055 outOfDate = True -- Recompile required
1057 checkVersions :: HscEnv
1058 -> Bool -- True <=> source unchanged
1060 -> ModIface -- Old interface
1061 -> IfG RecompileRequired
1062 checkVersions hsc_env source_unchanged mod_summary iface
1063 | not source_unchanged
1066 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1067 ppr (mi_module iface) <> colon)
1069 ; recomp <- checkDependencies hsc_env mod_summary iface
1070 ; if recomp then return outOfDate else do {
1072 -- Source code unchanged and no errors yet... carry on
1074 -- First put the dependent-module info, read from the old
1075 -- interface, into the envt, so that when we look for
1076 -- interfaces we look for the right one (.hi or .hi-boot)
1078 -- It's just temporary because either the usage check will succeed
1079 -- (in which case we are done with this module) or it'll fail (in which
1080 -- case we'll compile the module from scratch anyhow).
1082 -- We do this regardless of compilation mode, although in --make mode
1083 -- all the dependent modules should be in the HPT already, so it's
1085 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1087 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1088 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1091 -- This is a bit of a hack really
1092 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1093 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1096 -- If the direct imports of this module are resolved to targets that
1097 -- are not among the dependencies of the previous interface file,
1098 -- then we definitely need to recompile. This catches cases like
1099 -- - an exposed package has been upgraded
1100 -- - we are compiling with different package flags
1101 -- - a home module that was shadowing a package module has been removed
1102 -- - a new home module has been added that shadows a package module
1105 -- Returns True if recompilation is required.
1106 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1107 checkDependencies hsc_env summary iface
1108 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1110 prev_dep_mods = dep_mods (mi_deps iface)
1111 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1113 this_pkg = thisPackage (hsc_dflags hsc_env)
1115 orM = foldr f (return False)
1116 where f m rest = do b <- m; if b then return True else rest
1118 dep_missing (L _ mod) = do
1119 find_res <- liftIO $ findImportedModule hsc_env mod Nothing
1123 -> if moduleName mod `notElem` map fst prev_dep_mods
1124 then do traceHiDiffs $
1125 text "imported module " <> quotes (ppr mod) <>
1126 text " not among previous dependencies"
1131 -> if pkg `notElem` prev_dep_pkgs
1132 then do traceHiDiffs $
1133 text "imported module " <> quotes (ppr mod) <>
1134 text " is from package " <> quotes (ppr pkg) <>
1135 text ", which is not among previous dependencies"
1139 where pkg = modulePackageId mod
1140 _otherwise -> return outOfDate
1142 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1143 -> IfG RecompileRequired
1144 needInterface mod continue
1145 = do -- Load the imported interface if possible
1146 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1147 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1149 mb_iface <- loadInterface doc_str mod ImportBySystem
1150 -- Load the interface, but don't complain on failure;
1151 -- Instead, get an Either back which we can test
1154 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1156 -- Couldn't find or parse a module mentioned in the
1157 -- old interface file. Don't complain: it might
1158 -- just be that the current module doesn't need that
1159 -- import and it's been deleted
1160 Succeeded iface -> continue iface
1163 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1164 -- Given the usage information extracted from the old
1165 -- M.hi file for the module being compiled, figure out
1166 -- whether M needs to be recompiled.
1168 checkModUsage _this_pkg UsagePackageModule{
1170 usg_mod_hash = old_mod_hash }
1171 = needInterface mod $ \iface -> do
1172 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1173 -- We only track the ABI hash of package modules, rather than
1174 -- individual entity usages, so if the ABI hash changes we must
1175 -- recompile. This is safe but may entail more recompilation when
1176 -- a dependent package has changed.
1178 checkModUsage this_pkg UsageHomeModule{
1179 usg_mod_name = mod_name,
1180 usg_mod_hash = old_mod_hash,
1181 usg_exports = maybe_old_export_hash,
1182 usg_entities = old_decl_hash }
1184 let mod = mkModule this_pkg mod_name
1185 needInterface mod $ \iface -> do
1188 new_mod_hash = mi_mod_hash iface
1189 new_decl_hash = mi_hash_fn iface
1190 new_export_hash = mi_exp_hash iface
1193 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1194 if not recompile then return upToDate else do
1196 -- CHECK EXPORT LIST
1197 checkMaybeHash maybe_old_export_hash new_export_hash
1198 (ptext (sLit " Export list changed")) $ do
1200 -- CHECK ITEMS ONE BY ONE
1201 recompile <- checkList [ checkEntityUsage new_decl_hash u
1202 | u <- old_decl_hash]
1204 then return outOfDate -- This one failed, so just bail out now
1205 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1207 ------------------------
1208 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1209 checkModuleFingerprint old_mod_hash new_mod_hash
1210 | new_mod_hash == old_mod_hash
1211 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1214 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1215 old_mod_hash new_mod_hash
1217 ------------------------
1218 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1219 -> IfG RecompileRequired -> IfG RecompileRequired
1220 checkMaybeHash maybe_old_hash new_hash doc continue
1221 | Just hash <- maybe_old_hash, hash /= new_hash
1222 = out_of_date_hash doc hash new_hash
1226 ------------------------
1227 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1228 -> (OccName, Fingerprint)
1230 checkEntityUsage new_hash (name,old_hash)
1231 = case new_hash name of
1233 Nothing -> -- We used it before, but it ain't there now
1234 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1236 Just (_, new_hash) -- It's there, but is it up to date?
1237 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1239 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1242 up_to_date, out_of_date :: SDoc -> IfG Bool
1243 up_to_date msg = traceHiDiffs msg >> return upToDate
1244 out_of_date msg = traceHiDiffs msg >> return outOfDate
1246 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1247 out_of_date_hash msg old_hash new_hash
1248 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1250 ----------------------
1251 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1252 -- This helper is used in two places
1253 checkList [] = return upToDate
1254 checkList (check:checks) = do recompile <- check
1256 then return outOfDate
1257 else checkList checks
1260 %************************************************************************
1262 Converting things to their Iface equivalents
1264 %************************************************************************
1267 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1268 -- Assumption: the thing is already tidied, so that locally-bound names
1269 -- (lambdas, for-alls) already have non-clashing OccNames
1270 -- Reason: Iface stuff uses OccNames, and the conversion here does
1271 -- not do tidying on the way
1272 tyThingToIfaceDecl (AnId id)
1273 = IfaceId { ifName = getOccName id,
1274 ifType = toIfaceType (idType id),
1277 info = case toIfaceIdInfo (idInfo id) of
1279 items -> HasInfo items
1281 tyThingToIfaceDecl (AClass clas)
1282 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1283 ifName = getOccName clas,
1284 ifTyVars = toIfaceTvBndrs clas_tyvars,
1285 ifFDs = map toIfaceFD clas_fds,
1286 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1287 ifSigs = map toIfaceClassOp op_stuff,
1288 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1290 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1291 = classExtraBigSig clas
1292 tycon = classTyCon clas
1294 toIfaceClassOp (sel_id, def_meth)
1295 = ASSERT(sel_tyvars == clas_tyvars)
1296 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1298 -- Be careful when splitting the type, because of things
1299 -- like class Foo a where
1300 -- op :: (?x :: String) => a -> a
1301 -- and class Baz a where
1302 -- op :: (Ord a) => a -> a
1303 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1304 op_ty = funResultTy rho_ty
1306 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1308 tyThingToIfaceDecl (ATyCon tycon)
1310 = IfaceSyn { ifName = getOccName tycon,
1311 ifTyVars = toIfaceTvBndrs tyvars,
1314 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1318 = IfaceData { ifName = getOccName tycon,
1319 ifTyVars = toIfaceTvBndrs tyvars,
1320 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1321 ifCons = ifaceConDecls (algTyConRhs tycon),
1322 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1323 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1324 ifGeneric = tyConHasGenerics tycon,
1325 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1327 | isForeignTyCon tycon
1328 = IfaceForeign { ifName = getOccName tycon,
1329 ifExtName = tyConExtName tycon }
1331 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1333 tyvars = tyConTyVars tycon
1335 = case synTyConRhs tycon of
1336 OpenSynTyCon ki _ -> (Nothing, toIfaceType ki)
1337 SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1339 ifaceConDecls (NewTyCon { data_con = con }) =
1340 IfNewTyCon (ifaceConDecl con)
1341 ifaceConDecls (DataTyCon { data_cons = cons }) =
1342 IfDataTyCon (map ifaceConDecl cons)
1343 ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
1344 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1345 -- The last case happens when a TyCon has been trimmed during tidying
1346 -- Furthermore, tyThingToIfaceDecl is also used
1347 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1348 -- AbstractTyCon case is perfectly sensible.
1350 ifaceConDecl data_con
1351 = IfCon { ifConOcc = getOccName (dataConName data_con),
1352 ifConInfix = dataConIsInfix data_con,
1353 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1354 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1355 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1356 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1357 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1358 ifConFields = map getOccName
1359 (dataConFieldLabels data_con),
1360 ifConStricts = dataConStrictMarks data_con }
1362 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1364 famInstToIface Nothing = Nothing
1365 famInstToIface (Just (famTyCon, instTys)) =
1366 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1368 tyThingToIfaceDecl (ADataCon dc)
1369 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1372 getFS :: NamedThing a => a -> FastString
1373 getFS x = occNameFS (getOccName x)
1375 --------------------------
1376 instanceToIfaceInst :: Instance -> IfaceInst
1377 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1378 is_cls = cls_name, is_tcs = mb_tcs })
1379 = ASSERT( cls_name == className cls )
1380 IfaceInst { ifDFun = dfun_name,
1382 ifInstCls = cls_name,
1383 ifInstTys = map do_rough mb_tcs,
1386 do_rough Nothing = Nothing
1387 do_rough (Just n) = Just (toIfaceTyCon_name n)
1389 dfun_name = idName dfun_id
1390 mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1391 is_local name = nameIsLocalOrFrom mod name
1393 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1394 (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1395 -- Slightly awkward: we need the Class to get the fundeps
1396 (tvs, fds) = classTvsFds cls
1397 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1398 orph | is_local cls_name = Just (nameOccName cls_name)
1399 | all isJust mb_ns = head mb_ns
1400 | otherwise = Nothing
1402 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1403 -- that is not in the "determined" arguments
1404 mb_ns | null fds = [choose_one arg_names]
1405 | otherwise = map do_one fds
1406 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1407 , not (tv `elem` rtvs)]
1409 choose_one :: [NameSet] -> Maybe OccName
1410 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1412 (n : _) -> Just (nameOccName n)
1414 --------------------------
1415 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1416 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1419 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1420 , ifFamInstFam = fam
1421 , ifFamInstTys = map do_rough mb_tcs }
1423 do_rough Nothing = Nothing
1424 do_rough (Just n) = Just (toIfaceTyCon_name n)
1426 --------------------------
1427 toIfaceLetBndr :: Id -> IfaceLetBndr
1428 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1429 (toIfaceType (idType id))
1432 -- Stripped-down version of tcIfaceIdInfo
1433 -- Change this if you want to export more IdInfo for
1434 -- non-top-level Ids. Don't forget to change
1435 -- CoreTidy.tidyLetBndr too!
1437 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1439 inline_prag = inlinePragInfo id_info
1440 prag_info | isAlwaysActive inline_prag = NoInfo
1441 | otherwise = HasInfo [HsInline inline_prag]
1443 --------------------------
1444 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1445 toIfaceIdInfo id_info
1446 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1447 inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
1449 ------------ Arity --------------
1450 arity_info = arityInfo id_info
1451 arity_hsinfo | arity_info == 0 = Nothing
1452 | otherwise = Just (HsArity arity_info)
1454 ------------ Caf Info --------------
1455 caf_info = cafInfo id_info
1456 caf_hsinfo = case caf_info of
1457 NoCafRefs -> Just HsNoCafRefs
1460 ------------ Strictness --------------
1461 -- No point in explicitly exporting TopSig
1462 strict_hsinfo = case newStrictnessInfo id_info of
1463 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1466 ------------ Worker --------------
1467 work_info = workerInfo id_info
1468 has_worker = workerExists work_info
1469 wrkr_hsinfo = case work_info of
1470 HasWorker work_id wrap_arity ->
1471 Just (HsWorker ((idName work_id)) wrap_arity)
1474 ------------ Unfolding --------------
1475 -- The unfolding is redundant if there is a worker
1476 unfold_info = unfoldingInfo id_info
1477 rhs = unfoldingTemplate unfold_info
1478 no_unfolding = neverUnfold unfold_info
1479 -- The CoreTidy phase retains unfolding info iff
1480 -- we want to expose the unfolding, taking into account
1481 -- unconditional NOINLINE, etc. See TidyPgm.addExternal
1482 unfold_hsinfo | no_unfolding = Nothing
1483 | has_worker = Nothing -- Unfolding is implicit
1484 | otherwise = Just (HsUnfold (toIfaceExpr rhs))
1486 ------------ Inline prag --------------
1487 inline_prag = inlinePragInfo id_info
1488 inline_hsinfo | isAlwaysActive inline_prag = Nothing
1489 | no_unfolding && not has_worker = Nothing
1490 -- If the iface file give no unfolding info, we
1491 -- don't need to say when inlining is OK!
1492 | otherwise = Just (HsInline inline_prag)
1494 --------------------------
1495 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1496 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1497 = pprTrace "toHsRule: builtin" (ppr fn) $
1500 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1501 ru_act = act, ru_bndrs = bndrs,
1502 ru_args = args, ru_rhs = rhs })
1503 = IfaceRule { ifRuleName = name, ifActivation = act,
1504 ifRuleBndrs = map toIfaceBndr bndrs,
1506 ifRuleArgs = map do_arg args,
1507 ifRuleRhs = toIfaceExpr rhs,
1510 -- For type args we must remove synonyms from the outermost
1511 -- level. Reason: so that when we read it back in we'll
1512 -- construct the same ru_rough field as we have right now;
1514 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1515 do_arg arg = toIfaceExpr arg
1517 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1518 -- A rule is an orphan only if none of the variables
1519 -- mentioned on its left-hand side are locally defined
1520 lhs_names = fn : nameSetToList (exprsFreeNames args)
1521 -- No need to delete bndrs, because
1522 -- exprsFreeNames finds only External names
1524 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1525 (n : _) -> Just (nameOccName n)
1528 bogusIfaceRule :: Name -> IfaceRule
1529 bogusIfaceRule id_name
1530 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1531 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1532 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1534 ---------------------
1535 toIfaceExpr :: CoreExpr -> IfaceExpr
1536 toIfaceExpr (Var v) = toIfaceVar v
1537 toIfaceExpr (Lit l) = IfaceLit l
1538 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1539 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1540 toIfaceExpr (App f a) = toIfaceApp f [a]
1541 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1542 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1543 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1544 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1546 ---------------------
1547 toIfaceNote :: Note -> IfaceNote
1548 toIfaceNote (SCC cc) = IfaceSCC cc
1549 toIfaceNote InlineMe = IfaceInlineMe
1550 toIfaceNote (CoreNote s) = IfaceCoreNote s
1552 ---------------------
1553 toIfaceBind :: Bind Id -> IfaceBinding
1554 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1555 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1557 ---------------------
1558 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1559 -> (IfaceConAlt, [FastString], IfaceExpr)
1560 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1562 ---------------------
1563 toIfaceCon :: AltCon -> IfaceConAlt
1564 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1565 | otherwise = IfaceDataAlt (getName dc)
1567 tc = dataConTyCon dc
1569 toIfaceCon (LitAlt l) = IfaceLitAlt l
1570 toIfaceCon DEFAULT = IfaceDefault
1572 ---------------------
1573 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1574 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1575 toIfaceApp (Var v) as
1576 = case isDataConWorkId_maybe v of
1577 -- We convert the *worker* for tuples into IfaceTuples
1578 Just dc | isTupleTyCon tc && saturated
1579 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1581 val_args = dropWhile isTypeArg as
1582 saturated = val_args `lengthIs` idArity v
1583 tup_args = map toIfaceExpr val_args
1584 tc = dataConTyCon dc
1586 _ -> mkIfaceApps (toIfaceVar v) as
1588 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1590 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1591 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1593 ---------------------
1594 toIfaceVar :: Id -> IfaceExpr
1596 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1597 -- Foreign calls have special syntax
1598 | isExternalName name = IfaceExt name
1599 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1601 | otherwise = IfaceLcl (getFS name)