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 )
100 import System.FilePath
105 %************************************************************************
107 \subsection{Completing an interface}
109 %************************************************************************
113 -> Maybe Fingerprint -- The old fingerprint, if we have it
114 -> ModDetails -- The trimmed, tidied interface
115 -> ModGuts -- Usages, deprecations, etc
117 Maybe (ModIface, -- The new one
118 Bool)) -- True <=> there was an old Iface, and the
119 -- new one is identical, so no need
122 mkIface hsc_env maybe_old_fingerprint mod_details
123 ModGuts{ mg_module = this_mod,
125 mg_used_names = used_names,
127 mg_dir_imps = dir_imp_mods,
128 mg_rdr_env = rdr_env,
129 mg_fix_env = fix_env,
131 mg_hpc_info = hpc_info }
132 = mkIface_ hsc_env maybe_old_fingerprint
133 this_mod is_boot used_names deps rdr_env
134 fix_env warns hpc_info dir_imp_mods mod_details
136 -- | make an interface from the results of typechecking only. Useful
137 -- for non-optimising compilation, or where we aren't generating any
138 -- object code at all ('HscNothing').
140 -> Maybe Fingerprint -- The old fingerprint, if we have it
141 -> ModDetails -- gotten from mkBootModDetails, probably
142 -> TcGblEnv -- Usages, deprecations, etc
143 -> IO (Messages, Maybe (ModIface, Bool))
144 mkIfaceTc hsc_env maybe_old_fingerprint mod_details
145 tc_result@TcGblEnv{ tcg_mod = this_mod,
147 tcg_imports = imports,
148 tcg_rdr_env = rdr_env,
149 tcg_fix_env = fix_env,
151 tcg_hpc = other_hpc_info
154 used_names <- mkUsedNames tc_result
155 deps <- mkDependencies tc_result
156 let hpc_info = emptyHpcInfo other_hpc_info
157 mkIface_ hsc_env maybe_old_fingerprint
158 this_mod (isHsBoot hsc_src) used_names deps rdr_env
159 fix_env warns hpc_info (imp_mods imports) mod_details
162 mkUsedNames :: TcGblEnv -> IO NameSet
164 TcGblEnv{ tcg_inst_uses = dfun_uses_var,
168 dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
169 return (allUses dus `unionNameSets` dfun_uses)
171 mkDependencies :: TcGblEnv -> IO Dependencies
173 TcGblEnv{ tcg_mod = mod,
174 tcg_imports = imports,
178 th_used <- readIORef th_var -- Whether TH is used
180 dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
181 -- M.hi-boot can be in the imp_dep_mods, but we must remove
182 -- it before recording the modules on which this one depends!
183 -- (We want to retain M.hi-boot in imp_dep_mods so that
184 -- loadHiBootInterface can see if M's direct imports depend
185 -- on M.hi-boot, and hence that we should do the hi-boot consistency
188 pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
189 | otherwise = imp_dep_pkgs imports
191 return Deps { dep_mods = sortBy (stableModuleNameCmp `on` fst) dep_mods,
192 dep_pkgs = sortBy stablePackageIdCmp pkgs,
193 dep_orphs = sortBy stableModuleCmp (imp_orphs imports),
194 dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
195 -- sort to get into canonical order
196 -- NB. remember to use lexicographic ordering
198 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
199 -> NameSet -> Dependencies -> GlobalRdrEnv
200 -> NameEnv FixItem -> Warnings -> HpcInfo
203 -> IO (Messages, Maybe (ModIface, Bool))
204 mkIface_ hsc_env maybe_old_fingerprint
205 this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
207 ModDetails{ md_insts = insts,
208 md_fam_insts = fam_insts,
211 md_vect_info = vect_info,
213 md_exports = exports }
214 -- NB: notice that mkIface does not look at the bindings
215 -- only at the TypeEnv. The previous Tidy phase has
216 -- put exactly the info into the TypeEnv that we want
217 -- to expose in the interface
219 = do { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
221 ; let { entities = typeEnvElts type_env ;
222 decls = [ tyThingToIfaceDecl entity
223 | entity <- entities,
224 let name = getName entity,
225 not (isImplicitTyThing entity),
226 -- No implicit Ids and class tycons in the interface file
227 not (isWiredInName name),
228 -- Nor wired-in things; the compiler knows about them anyhow
229 nameIsLocalOrFrom this_mod name ]
230 -- Sigh: see Note [Root-main Id] in TcRnDriver
232 ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
234 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
235 ; iface_insts = map instanceToIfaceInst insts
236 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
237 ; iface_vect_info = flattenVectInfo vect_info
239 ; intermediate_iface = ModIface {
240 mi_module = this_mod,
244 mi_exports = mkIfaceExports exports,
246 -- Sort these lexicographically, so that
247 -- the result is stable across compilations
248 mi_insts = sortLe le_inst iface_insts,
249 mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
250 mi_rules = sortLe le_rule iface_rules,
252 mi_vect_info = iface_vect_info,
254 mi_fixities = fixities,
256 mi_anns = mkIfaceAnnotations anns,
257 mi_globals = Just rdr_env,
259 -- Left out deliberately: filled in by addVersionInfo
260 mi_iface_hash = fingerprint0,
261 mi_mod_hash = fingerprint0,
262 mi_exp_hash = fingerprint0,
263 mi_orphan_hash = fingerprint0,
264 mi_orphan = False, -- Always set by addVersionInfo, but
265 -- it's a strict field, so we can't omit it.
266 mi_finsts = False, -- Ditto
267 mi_decls = deliberatelyOmitted "decls",
268 mi_hash_fn = deliberatelyOmitted "hash_fn",
269 mi_hpc = isHpcUsed hpc_info,
271 -- And build the cached values
272 mi_warn_fn = mkIfaceWarnCache warns,
273 mi_fix_fn = mkIfaceFixCache fixities }
276 ; (new_iface, no_change_at_all)
277 <- {-# SCC "versioninfo" #-}
278 addFingerprints hsc_env maybe_old_fingerprint
279 intermediate_iface decls
281 -- Warn about orphans
282 ; let orph_warnings --- Laziness means no work done unless -fwarn-orphans
283 | dopt Opt_WarnOrphans dflags = rule_warns `unionBags` inst_warns
284 | otherwise = emptyBag
285 errs_and_warns = (orph_warnings, emptyBag)
286 unqual = mkPrintUnqualified dflags rdr_env
287 inst_warns = listToBag [ instOrphWarn unqual d
288 | (d,i) <- insts `zip` iface_insts
289 , isNothing (ifInstOrph i) ]
290 rule_warns = listToBag [ ruleOrphWarn unqual this_mod r
292 , isNothing (ifRuleOrph r) ]
294 ; if errorsFound dflags errs_and_warns
295 then return ( errs_and_warns, Nothing )
298 -- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
301 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
302 (pprModIface new_iface)
304 -- bug #1617: on reload we weren't updating the PrintUnqualified
305 -- correctly. This stems from the fact that the interface had
306 -- not changed, so addVersionInfo returns the old ModIface
307 -- with the old GlobalRdrEnv (mi_globals).
308 ; let final_iface = new_iface{ mi_globals = Just rdr_env }
310 ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
312 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
313 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
314 i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
316 le_occ :: Name -> Name -> Bool
317 -- Compare lexicographically by OccName, *not* by unique, because
318 -- the latter is not stable across compilations
319 le_occ n1 n2 = nameOccName n1 <= nameOccName n2
321 dflags = hsc_dflags hsc_env
322 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
323 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
325 flattenVectInfo (VectInfo { vectInfoVar = vVar
326 , vectInfoTyCon = vTyCon
329 ifaceVectInfoVar = [ Var.varName v
330 | (v, _) <- varEnvElts vVar],
331 ifaceVectInfoTyCon = [ tyConName t
332 | (t, t_v) <- nameEnvElts vTyCon
334 ifaceVectInfoTyConReuse = [ tyConName t
335 | (t, t_v) <- nameEnvElts vTyCon
339 -----------------------------
340 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
341 writeIfaceFile dflags location new_iface
342 = do createDirectoryHierarchy (takeDirectory hi_file_path)
343 writeBinIface dflags hi_file_path new_iface
344 where hi_file_path = ml_hi_file location
347 -- -----------------------------------------------------------------------------
348 -- Look up parents and versions of Names
350 -- This is like a global version of the mi_hash_fn field in each ModIface.
351 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
352 -- the parent and version info.
355 :: HscEnv -- needed to look up versions
356 -> ExternalPackageState -- ditto
357 -> (Name -> Fingerprint)
358 mkHashFun hsc_env eps
361 mod = ASSERT2( isExternalName name, ppr name ) nameModule name
362 occ = nameOccName name
363 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
364 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
366 snd (mi_hash_fn iface occ `orElse`
367 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
369 hpt = hsc_HPT hsc_env
372 -- ---------------------------------------------------------------------------
373 -- Compute fingerprints for the interface
377 -> Maybe Fingerprint -- the old fingerprint, if any
378 -> ModIface -- The new interface (lacking decls)
379 -> [IfaceDecl] -- The new decls
380 -> IO (ModIface, -- Updated interface
381 Bool) -- True <=> no changes at all;
382 -- no need to write Iface
384 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
386 eps <- hscEPS hsc_env
388 -- The ABI of a declaration represents everything that is made
389 -- visible about the declaration that a client can depend on.
390 -- see IfaceDeclABI below.
391 declABI :: IfaceDecl -> IfaceDeclABI
392 declABI decl = (this_mod, decl, extras)
393 where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
395 edges :: [(IfaceDeclABI, Unique, [Unique])]
396 edges = [ (abi, getUnique (ifName decl), out)
398 , let abi = declABI decl
399 , let out = localOccs $ freeNamesDeclABI abi
402 name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
403 localOccs = map (getUnique . getParent . getOccName)
404 . filter ((== this_mod) . name_module)
406 where getParent occ = lookupOccEnv parent_map occ `orElse` occ
408 -- maps OccNames to their parents in the current module.
409 -- e.g. a reference to a constructor must be turned into a reference
410 -- to the TyCon for the purposes of calculating dependencies.
411 parent_map :: OccEnv OccName
412 parent_map = foldr extend emptyOccEnv new_decls
414 extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
417 -- strongly-connected groups of declarations, in dependency order
418 groups = stronglyConnCompFromEdgedVertices edges
420 global_hash_fn = mkHashFun hsc_env eps
422 -- how to output Names when generating the data to fingerprint.
423 -- Here we want to output the fingerprint for each top-level
424 -- Name, whether it comes from the current module or another
425 -- module. In this way, the fingerprint for a declaration will
426 -- change if the fingerprint for anything it refers to (transitively)
428 mk_put_name :: (OccEnv (OccName,Fingerprint))
429 -> BinHandle -> Name -> IO ()
430 mk_put_name local_env bh name
431 | isWiredInName name = putNameLiterally bh name
432 -- wired-in names don't have fingerprints
434 = ASSERT( isExternalName name )
435 let hash | nameModule name /= this_mod = global_hash_fn name
437 snd (lookupOccEnv local_env (getOccName name)
438 `orElse` pprPanic "urk! lookup local fingerprint"
439 (ppr name)) -- (undefined,fingerprint0))
440 -- This panic indicates that we got the dependency
441 -- analysis wrong, because we needed a fingerprint for
442 -- an entity that wasn't in the environment. To debug
443 -- it, turn the panic into a trace, uncomment the
444 -- pprTraces below, run the compile again, and inspect
445 -- the output and the generated .hi file with
450 -- take a strongly-connected group of declarations and compute
453 fingerprint_group :: (OccEnv (OccName,Fingerprint),
454 [(Fingerprint,IfaceDecl)])
456 -> IO (OccEnv (OccName,Fingerprint),
457 [(Fingerprint,IfaceDecl)])
459 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
460 = do let hash_fn = mk_put_name local_env
462 -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
463 hash <- computeFingerprint dflags hash_fn abi
464 return (extend_hash_env (hash,decl) local_env,
465 (hash,decl) : decls_w_hashes)
467 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
468 = do let decls = map abiDecl abis
469 local_env' = foldr extend_hash_env local_env
470 (zip (repeat fingerprint0) decls)
471 hash_fn = mk_put_name local_env'
472 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
473 let stable_abis = sortBy cmp_abiNames abis
474 -- put the cycle in a canonical order
475 hash <- computeFingerprint dflags hash_fn stable_abis
476 let pairs = zip (repeat hash) decls
477 return (foldr extend_hash_env local_env pairs,
478 pairs ++ decls_w_hashes)
480 extend_hash_env :: (Fingerprint,IfaceDecl)
481 -> OccEnv (OccName,Fingerprint)
482 -> OccEnv (OccName,Fingerprint)
483 extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
486 item = (decl_name, hash)
487 env1 = extendOccEnv env0 decl_name item
488 add_imp bndr env = extendOccEnv env bndr item
491 (local_env, decls_w_hashes) <-
492 foldM fingerprint_group (emptyOccEnv, []) groups
494 -- when calculating fingerprints, we always need to use canonical
495 -- ordering for lists of things. In particular, the mi_deps has various
496 -- lists of modules and suchlike, so put these all in canonical order:
497 let sorted_deps = sortDependencies (mi_deps iface0)
499 -- the export hash of a module depends on the orphan hashes of the
500 -- orphan modules below us in the dependency tree. This is the way
501 -- that changes in orphans get propagated all the way up the
502 -- dependency tree. We only care about orphan modules in the current
503 -- package, because changes to orphans outside this package will be
504 -- tracked by the usage on the ABI hash of package modules that we import.
505 let orph_mods = filter ((== this_pkg) . modulePackageId)
506 $ dep_orphs sorted_deps
507 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
509 orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
510 (map IfaceInstABI orph_insts, orph_rules, fam_insts)
512 -- the export list hash doesn't depend on the fingerprints of
513 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
514 export_hash <- computeFingerprint dflags putNameLiterally
515 (mi_exports iface0, orphan_hash, dep_orphan_hashes)
517 -- put the declarations in a canonical order, sorted by OccName
518 let sorted_decls = eltsFM $ listToFM $
519 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
521 -- the ABI hash depends on:
527 mod_hash <- computeFingerprint dflags putNameLiterally
528 (map fst sorted_decls,
533 -- The interface hash depends on:
534 -- - the ABI hash, plus
538 iface_hash <- computeFingerprint dflags putNameLiterally
545 no_change_at_all = Just iface_hash == mb_old_fingerprint
547 final_iface = iface0 {
548 mi_mod_hash = mod_hash,
549 mi_iface_hash = iface_hash,
550 mi_exp_hash = export_hash,
551 mi_orphan_hash = orphan_hash,
552 mi_orphan = not (null orph_rules && null orph_insts),
553 mi_finsts = not . null $ mi_fam_insts iface0,
554 mi_decls = sorted_decls,
555 mi_hash_fn = lookupOccEnv local_env }
557 return (final_iface, no_change_at_all)
560 this_mod = mi_module iface0
561 dflags = hsc_dflags hsc_env
562 this_pkg = thisPackage dflags
563 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
564 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
565 -- ToDo: shouldn't we be splitting fam_insts into orphans and
567 fam_insts = mi_fam_insts iface0
568 fix_fn = mi_fix_fn iface0
571 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
572 getOrphanHashes hsc_env mods = do
573 eps <- hscEPS hsc_env
575 hpt = hsc_HPT hsc_env
577 dflags = hsc_dflags hsc_env
579 case lookupIfaceByModule dflags hpt pit mod of
580 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
581 Just iface -> mi_orphan_hash iface
583 return (map get_orph_hash mods)
586 sortDependencies :: Dependencies -> Dependencies
588 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
589 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
590 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
591 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
595 %************************************************************************
597 The ABI of an IfaceDecl
599 %************************************************************************
601 Note [The ABI of an IfaceDecl]
602 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
603 The ABI of a declaration consists of:
605 (a) the full name of the identifier (inc. module and package,
606 because these are used to construct the symbol name by which
607 the identifier is known externally).
609 (b) the declaration itself, as exposed to clients. That is, the
610 definition of an Id is included in the fingerprint only if
611 it is made available as as unfolding in the interface.
613 (c) the fixity of the identifier
615 (e) for classes: instances, fixity & rules for methods
616 (f) for datatypes: instances, fixity & rules for constrs
618 Items (c)-(f) are not stored in the IfaceDecl, but instead appear
619 elsewhere in the interface file. But they are *fingerprinted* with
620 the Id itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
621 and fingerprinting that as part of the Id.
624 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
627 = IfaceIdExtras Fixity [IfaceRule]
628 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
629 | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
630 | IfaceSynExtras Fixity
631 | IfaceOtherDeclExtras
633 abiDecl :: IfaceDeclABI -> IfaceDecl
634 abiDecl (_, decl, _) = decl
636 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
637 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
638 ifName (abiDecl abi2)
640 freeNamesDeclABI :: IfaceDeclABI -> NameSet
641 freeNamesDeclABI (_mod, decl, extras) =
642 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
644 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
645 freeNamesDeclExtras (IfaceIdExtras _ rules)
646 = unionManyNameSets (map freeNamesIfRule rules)
647 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
648 = unionManyNameSets (map freeNamesSub subs)
649 freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
650 = unionManyNameSets (map freeNamesSub subs)
651 freeNamesDeclExtras (IfaceSynExtras _)
653 freeNamesDeclExtras IfaceOtherDeclExtras
656 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
657 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
659 -- This instance is used only to compute fingerprints
660 instance Binary IfaceDeclExtras where
661 get _bh = panic "no get for IfaceDeclExtras"
662 put_ bh (IfaceIdExtras fix rules) = do
663 putByte bh 1; put_ bh fix; put_ bh rules
664 put_ bh (IfaceDataExtras fix insts cons) = do
665 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
666 put_ bh (IfaceClassExtras fix insts methods) = do
667 putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
668 put_ bh (IfaceSynExtras fix) = do
669 putByte bh 4; put_ bh fix
670 put_ bh IfaceOtherDeclExtras = do
673 declExtras :: (OccName -> Fixity)
674 -> OccEnv [IfaceRule]
675 -> OccEnv [IfaceInst]
679 declExtras fix_fn rule_env inst_env decl
681 IfaceId{} -> IfaceIdExtras (fix_fn n)
682 (lookupOccEnvL rule_env n)
683 IfaceData{ifCons=cons} ->
684 IfaceDataExtras (fix_fn n)
685 (map IfaceInstABI $ lookupOccEnvL inst_env n)
686 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
687 IfaceClass{ifSigs=sigs} ->
688 IfaceClassExtras (fix_fn n)
689 (map IfaceInstABI $ lookupOccEnvL inst_env n)
690 [id_extras op | IfaceClassOp op _ _ <- sigs]
691 IfaceSyn{} -> IfaceSynExtras (fix_fn n)
692 _other -> IfaceOtherDeclExtras
695 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
698 -- When hashing an instance, we hash only its structure, not the
699 -- fingerprints of the things it mentions. See the section on instances
700 -- in the commentary,
701 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
703 newtype IfaceInstABI = IfaceInstABI IfaceInst
705 instance Binary IfaceInstABI where
706 get = panic "no get for IfaceInstABI"
707 put_ bh (IfaceInstABI inst) = do
708 let ud = getUserData bh
709 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
712 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
713 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
715 -- used when we want to fingerprint a structure without depending on the
716 -- fingerprints of external Names that it refers to.
717 putNameLiterally :: BinHandle -> Name -> IO ()
718 putNameLiterally bh name = ASSERT( isExternalName name )
719 do { put_ bh $! nameModule name
720 ; put_ bh $! nameOccName name }
722 computeFingerprint :: Binary a
724 -> (BinHandle -> Name -> IO ())
728 computeFingerprint _dflags put_name a = do
729 bh <- openBinMem (3*1024) -- just less than a block
730 ud <- newWriteState put_name putFS
731 bh <- return $ setUserData bh ud
736 -- for testing: use the md5sum command to generate fingerprints and
737 -- compare the results against our built-in version.
738 fp' <- oldMD5 dflags bh
739 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
742 oldMD5 dflags bh = do
743 tmp <- newTempName dflags "bin"
745 tmp2 <- newTempName dflags "md5"
746 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
749 ExitFailure _ -> ghcError (PhaseFailed cmd r)
751 hash_str <- readFile tmp2
752 return $! readHexFingerprint hash_str
755 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
756 instOrphWarn unqual inst
757 = mkWarnMsg (getSrcSpan inst) unqual $
758 hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
760 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
761 ruleOrphWarn unqual mod rule
762 = mkWarnMsg silly_loc unqual $
763 ptext (sLit "Orphan rule:") <+> ppr rule
765 silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
766 -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
767 -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
769 ----------------------
770 -- mkOrphMap partitions instance decls or rules into
771 -- (a) an OccEnv for ones that are not orphans,
772 -- mapping the local OccName to a list of its decls
773 -- (b) a list of orphan decls
774 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
775 -- Nothing for an orphan decl
776 -> [decl] -- Sorted into canonical order
777 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
778 -- each sublist in canonical order
779 [decl]) -- Orphan decls; in canonical order
780 mkOrphMap get_key decls
781 = foldl go (emptyOccEnv, []) decls
783 go (non_orphs, orphs) d
784 | Just occ <- get_key d
785 = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
786 | otherwise = (non_orphs, d:orphs)
790 %************************************************************************
792 Keeping track of what we've slurped, and fingerprints
794 %************************************************************************
797 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
798 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
799 = do { eps <- hscEPS hsc_env
800 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
801 dir_imp_mods used_names
802 ; usages `seqList` return usages }
803 -- seq the list of Usages returned: occasionally these
804 -- don't get evaluated for a while and we can end up hanging on to
805 -- the entire collection of Ifaces.
807 mk_usage_info :: PackageIfaceTable
813 mk_usage_info pit hsc_env this_mod direct_imports used_names
814 = mapCatMaybes mkUsage usage_mods
816 hpt = hsc_HPT hsc_env
817 dflags = hsc_dflags hsc_env
818 this_pkg = thisPackage dflags
820 used_mods = moduleEnvKeys ent_map
821 dir_imp_mods = (moduleEnvKeys direct_imports)
822 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
823 usage_mods = sortBy stableModuleCmp all_mods
824 -- canonical order is imported, to avoid interface-file
827 -- ent_map groups together all the things imported and used
828 -- from a particular module
829 ent_map :: ModuleEnv [OccName]
830 ent_map = foldNameSet add_mv emptyModuleEnv used_names
833 | isWiredInName name = mv_map -- ignore wired-in names
835 = case nameModule_maybe name of
836 Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
837 Just mod -> -- We use this fiddly lambda function rather than
838 -- (++) as the argument to extendModuleEnv_C to
839 -- avoid quadratic behaviour (trac #2680)
840 extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
841 where occ = nameOccName name
843 -- We want to create a Usage for a home module if
844 -- a) we used something from it; has something in used_names
845 -- b) we imported it, even if we used nothing from it
846 -- (need to recompile if its export list changes: export_fprint)
847 mkUsage :: Module -> Maybe Usage
849 | isNothing maybe_iface -- We can't depend on it if we didn't
850 -- load its interface.
851 || mod == this_mod -- We don't care about usages of
852 -- things in *this* module
855 | modulePackageId mod /= this_pkg
856 = Just UsagePackageModule{ usg_mod = mod,
857 usg_mod_hash = mod_hash }
858 -- for package modules, we record the module hash only
861 && isNothing export_hash
862 && not is_direct_import
864 = Nothing -- Record no usage info
865 -- for directly-imported modules, we always want to record a usage
866 -- on the orphan hash. This is what triggers a recompilation if
867 -- an orphan is added or removed somewhere below us in the future.
870 = Just UsageHomeModule {
871 usg_mod_name = moduleName mod,
872 usg_mod_hash = mod_hash,
873 usg_exports = export_hash,
874 usg_entities = fmToList ent_hashs }
876 maybe_iface = lookupIfaceByModule dflags hpt pit mod
877 -- In one-shot mode, the interfaces for home-package
878 -- modules accumulate in the PIT not HPT. Sigh.
880 is_direct_import = mod `elemModuleEnv` direct_imports
882 Just iface = maybe_iface
883 finsts_mod = mi_finsts iface
884 hash_env = mi_hash_fn iface
885 mod_hash = mi_mod_hash iface
886 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
887 | otherwise = Nothing
889 used_occs = lookupModuleEnv ent_map mod `orElse` []
891 -- Making a FiniteMap here ensures that (a) we remove duplicates
892 -- when we have usages on several subordinates of a single parent,
893 -- and (b) that the usages emerge in a canonical order, which
894 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
895 -- using Ord on the OccNames, which is a lexicographic ordering.
896 ent_hashs :: FiniteMap OccName Fingerprint
897 ent_hashs = listToFM (map lookup_occ used_occs)
901 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
904 depend_on_exports mod =
905 case lookupModuleEnv direct_imports mod of
907 -- Even if we used 'import M ()', we have to register a
908 -- usage on the export list because we are sensitive to
909 -- changes in orphan instances/rules.
911 -- In GHC 6.8.x the above line read "True", and in
912 -- fact it recorded a dependency on *all* the
913 -- modules underneath in the dependency tree. This
914 -- happens to make orphans work right, but is too
915 -- expensive: it'll read too many interface files.
916 -- The 'isNothing maybe_iface' check above saved us
917 -- from generating many of these usages (at least in
918 -- one-shot mode), but that's even more bogus!
922 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
923 mkIfaceAnnotations = map mkIfaceAnnotation
925 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
926 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
927 ifAnnotatedTarget = fmap nameOccName target,
928 ifAnnotatedValue = serialized
933 mkIfaceExports :: [AvailInfo]
934 -> [(Module, [GenAvailInfo OccName])]
935 -- Group by module and sort by occurrence
936 mkIfaceExports exports
937 = [ (mod, eltsFM avails)
938 | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
939 (moduleEnvToList groupFM)
940 -- NB. the fmToList is in a random order,
941 -- because Ord Module is not a predictable
942 -- ordering. Hence we perform a final sort
943 -- using the stable Module ordering.
946 -- Group by the module where the exported entities are defined
947 -- (which may not be the same for all Names in an Avail)
948 -- Deliberately use FiniteMap rather than UniqFM so we
949 -- get a canonical ordering
950 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
951 groupFM = foldl add emptyModuleEnv exports
953 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
954 -> Module -> GenAvailInfo OccName
955 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
956 add_one env mod avail
957 = extendModuleEnv_C plusFM env mod
958 (unitFM (occNameFS (availName avail)) avail)
960 -- NB: we should not get T(X) and T(Y) in the export list
961 -- else the plusFM will simply discard one! They
962 -- should have been combined by now.
964 = ASSERT( isExternalName n )
965 add_one env (nameModule n) (Avail (nameOccName n))
967 add env (AvailTC tc ns)
968 = ASSERT( all isExternalName ns )
969 foldl add_for_mod env mods
971 tc_occ = nameOccName tc
972 mods = nub (map nameModule ns)
973 -- Usually just one, but see Note [Original module]
976 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
977 -- NB. sort the children, we need a canonical order
979 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
982 Note [Orignal module]
983 ~~~~~~~~~~~~~~~~~~~~~
985 module X where { data family T }
986 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
987 The exported Avail from Y will look like
990 - only MkT is brought into scope by the data instance;
991 - but the parent (used for grouping and naming in T(..) exports) is X.T
992 - and in this case we export X.T too
994 In the result of MkIfaceExports, the names are grouped by defining module,
995 so we may need to split up a single Avail into multiple ones.
998 %************************************************************************
1000 Load the old interface file for this module (unless
1001 we have it aleady), and check whether it is up to date
1004 %************************************************************************
1007 checkOldIface :: HscEnv
1009 -> Bool -- Source unchanged
1010 -> Maybe ModIface -- Old interface from compilation manager, if any
1011 -> IO (RecompileRequired, Maybe ModIface)
1013 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1014 = do { showPass (hsc_dflags hsc_env)
1015 ("Checking old interface for " ++
1016 showSDoc (ppr (ms_mod mod_summary))) ;
1018 ; initIfaceCheck hsc_env $
1019 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1022 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1023 -> IfG (Bool, Maybe ModIface)
1024 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1025 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
1026 { when (not source_unchanged)
1027 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1029 -- If the source has changed and we're in interactive mode, avoid reading
1030 -- an interface; just return the one we might have been supplied with.
1031 ; let dflags = hsc_dflags hsc_env
1032 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1033 return (outOfDate, maybe_iface)
1035 case maybe_iface of {
1036 Just old_iface -> do -- Use the one we already have
1037 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1038 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1039 ; return (recomp, Just old_iface) }
1043 -- Try and read the old interface for the current module
1044 -- from the .hi file left from the last time we compiled it
1045 { let iface_path = msHiFilePath mod_summary
1046 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1047 ; case read_result of {
1048 Failed err -> do -- Old interface file not found, or garbled; give up
1049 { traceIf (text "FYI: cannot read old interface file:"
1051 ; return (outOfDate, Nothing) }
1053 ; Succeeded iface -> do
1055 -- We have got the old iface; check its versions
1056 { traceIf (text "Read the interface file" <+> text iface_path)
1057 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1058 ; return (recomp, Just iface)
1063 @recompileRequired@ is called from the HscMain. It checks whether
1064 a recompilation is required. It needs access to the persistent state,
1065 finder, etc, because it may have to load lots of interface files to
1066 check their versions.
1069 type RecompileRequired = Bool
1070 upToDate, outOfDate :: Bool
1071 upToDate = False -- Recompile not required
1072 outOfDate = True -- Recompile required
1074 checkVersions :: HscEnv
1075 -> Bool -- True <=> source unchanged
1077 -> ModIface -- Old interface
1078 -> IfG RecompileRequired
1079 checkVersions hsc_env source_unchanged mod_summary iface
1080 | not source_unchanged
1083 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1084 ppr (mi_module iface) <> colon)
1086 ; recomp <- checkDependencies hsc_env mod_summary iface
1087 ; if recomp then return outOfDate else do {
1089 -- Source code unchanged and no errors yet... carry on
1091 -- First put the dependent-module info, read from the old
1092 -- interface, into the envt, so that when we look for
1093 -- interfaces we look for the right one (.hi or .hi-boot)
1095 -- It's just temporary because either the usage check will succeed
1096 -- (in which case we are done with this module) or it'll fail (in which
1097 -- case we'll compile the module from scratch anyhow).
1099 -- We do this regardless of compilation mode, although in --make mode
1100 -- all the dependent modules should be in the HPT already, so it's
1102 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1104 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1105 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1108 -- This is a bit of a hack really
1109 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1110 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1113 -- If the direct imports of this module are resolved to targets that
1114 -- are not among the dependencies of the previous interface file,
1115 -- then we definitely need to recompile. This catches cases like
1116 -- - an exposed package has been upgraded
1117 -- - we are compiling with different package flags
1118 -- - a home module that was shadowing a package module has been removed
1119 -- - a new home module has been added that shadows a package module
1122 -- Returns True if recompilation is required.
1123 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1124 checkDependencies hsc_env summary iface
1125 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1127 prev_dep_mods = dep_mods (mi_deps iface)
1128 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1130 this_pkg = thisPackage (hsc_dflags hsc_env)
1132 orM = foldr f (return False)
1133 where f m rest = do b <- m; if b then return True else rest
1135 dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
1136 find_res <- liftIO $ findImportedModule hsc_env mod pkg
1140 -> if moduleName mod `notElem` map fst prev_dep_mods
1141 then do traceHiDiffs $
1142 text "imported module " <> quotes (ppr mod) <>
1143 text " not among previous dependencies"
1148 -> if pkg `notElem` prev_dep_pkgs
1149 then do traceHiDiffs $
1150 text "imported module " <> quotes (ppr mod) <>
1151 text " is from package " <> quotes (ppr pkg) <>
1152 text ", which is not among previous dependencies"
1156 where pkg = modulePackageId mod
1157 _otherwise -> return outOfDate
1159 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1160 -> IfG RecompileRequired
1161 needInterface mod continue
1162 = do -- Load the imported interface if possible
1163 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1164 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1166 mb_iface <- loadInterface doc_str mod ImportBySystem
1167 -- Load the interface, but don't complain on failure;
1168 -- Instead, get an Either back which we can test
1171 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1173 -- Couldn't find or parse a module mentioned in the
1174 -- old interface file. Don't complain: it might
1175 -- just be that the current module doesn't need that
1176 -- import and it's been deleted
1177 Succeeded iface -> continue iface
1180 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1181 -- Given the usage information extracted from the old
1182 -- M.hi file for the module being compiled, figure out
1183 -- whether M needs to be recompiled.
1185 checkModUsage _this_pkg UsagePackageModule{
1187 usg_mod_hash = old_mod_hash }
1188 = needInterface mod $ \iface -> do
1189 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1190 -- We only track the ABI hash of package modules, rather than
1191 -- individual entity usages, so if the ABI hash changes we must
1192 -- recompile. This is safe but may entail more recompilation when
1193 -- a dependent package has changed.
1195 checkModUsage this_pkg UsageHomeModule{
1196 usg_mod_name = mod_name,
1197 usg_mod_hash = old_mod_hash,
1198 usg_exports = maybe_old_export_hash,
1199 usg_entities = old_decl_hash }
1201 let mod = mkModule this_pkg mod_name
1202 needInterface mod $ \iface -> do
1205 new_mod_hash = mi_mod_hash iface
1206 new_decl_hash = mi_hash_fn iface
1207 new_export_hash = mi_exp_hash iface
1210 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1211 if not recompile then return upToDate else do
1213 -- CHECK EXPORT LIST
1214 checkMaybeHash maybe_old_export_hash new_export_hash
1215 (ptext (sLit " Export list changed")) $ do
1217 -- CHECK ITEMS ONE BY ONE
1218 recompile <- checkList [ checkEntityUsage new_decl_hash u
1219 | u <- old_decl_hash]
1221 then return outOfDate -- This one failed, so just bail out now
1222 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1224 ------------------------
1225 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1226 checkModuleFingerprint old_mod_hash new_mod_hash
1227 | new_mod_hash == old_mod_hash
1228 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1231 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1232 old_mod_hash new_mod_hash
1234 ------------------------
1235 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1236 -> IfG RecompileRequired -> IfG RecompileRequired
1237 checkMaybeHash maybe_old_hash new_hash doc continue
1238 | Just hash <- maybe_old_hash, hash /= new_hash
1239 = out_of_date_hash doc hash new_hash
1243 ------------------------
1244 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1245 -> (OccName, Fingerprint)
1247 checkEntityUsage new_hash (name,old_hash)
1248 = case new_hash name of
1250 Nothing -> -- We used it before, but it ain't there now
1251 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1253 Just (_, new_hash) -- It's there, but is it up to date?
1254 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1256 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1259 up_to_date, out_of_date :: SDoc -> IfG Bool
1260 up_to_date msg = traceHiDiffs msg >> return upToDate
1261 out_of_date msg = traceHiDiffs msg >> return outOfDate
1263 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1264 out_of_date_hash msg old_hash new_hash
1265 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1267 ----------------------
1268 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1269 -- This helper is used in two places
1270 checkList [] = return upToDate
1271 checkList (check:checks) = do recompile <- check
1273 then return outOfDate
1274 else checkList checks
1277 %************************************************************************
1279 Converting things to their Iface equivalents
1281 %************************************************************************
1284 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1285 -- Assumption: the thing is already tidied, so that locally-bound names
1286 -- (lambdas, for-alls) already have non-clashing OccNames
1287 -- Reason: Iface stuff uses OccNames, and the conversion here does
1288 -- not do tidying on the way
1289 tyThingToIfaceDecl (AnId id)
1290 = IfaceId { ifName = getOccName id,
1291 ifType = toIfaceType (idType id),
1292 ifIdDetails = toIfaceIdDetails (idDetails id),
1295 info = case toIfaceIdInfo (idInfo id) of
1297 items -> HasInfo items
1299 tyThingToIfaceDecl (AClass clas)
1300 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1301 ifName = getOccName clas,
1302 ifTyVars = toIfaceTvBndrs clas_tyvars,
1303 ifFDs = map toIfaceFD clas_fds,
1304 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1305 ifSigs = map toIfaceClassOp op_stuff,
1306 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1308 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1309 = classExtraBigSig clas
1310 tycon = classTyCon clas
1312 toIfaceClassOp (sel_id, def_meth)
1313 = ASSERT(sel_tyvars == clas_tyvars)
1314 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1316 -- Be careful when splitting the type, because of things
1317 -- like class Foo a where
1318 -- op :: (?x :: String) => a -> a
1319 -- and class Baz a where
1320 -- op :: (Ord a) => a -> a
1321 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1322 op_ty = funResultTy rho_ty
1324 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1326 tyThingToIfaceDecl (ATyCon tycon)
1328 = IfaceSyn { ifName = getOccName tycon,
1329 ifTyVars = toIfaceTvBndrs tyvars,
1332 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1336 = IfaceData { ifName = getOccName tycon,
1337 ifTyVars = toIfaceTvBndrs tyvars,
1338 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1339 ifCons = ifaceConDecls (algTyConRhs tycon),
1340 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1341 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1342 ifGeneric = tyConHasGenerics tycon,
1343 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1345 | isForeignTyCon tycon
1346 = IfaceForeign { ifName = getOccName tycon,
1347 ifExtName = tyConExtName tycon }
1349 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1351 tyvars = tyConTyVars tycon
1353 = case synTyConRhs tycon of
1354 OpenSynTyCon ki _ -> (Nothing, toIfaceType ki)
1355 SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1357 ifaceConDecls (NewTyCon { data_con = con }) =
1358 IfNewTyCon (ifaceConDecl con)
1359 ifaceConDecls (DataTyCon { data_cons = cons }) =
1360 IfDataTyCon (map ifaceConDecl cons)
1361 ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
1362 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1363 -- The last case happens when a TyCon has been trimmed during tidying
1364 -- Furthermore, tyThingToIfaceDecl is also used
1365 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1366 -- AbstractTyCon case is perfectly sensible.
1368 ifaceConDecl data_con
1369 = IfCon { ifConOcc = getOccName (dataConName data_con),
1370 ifConInfix = dataConIsInfix data_con,
1371 ifConWrapper = isJust (dataConWrapId_maybe data_con),
1372 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1373 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1374 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1375 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1376 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1377 ifConFields = map getOccName
1378 (dataConFieldLabels data_con),
1379 ifConStricts = dataConStrictMarks data_con }
1381 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1383 famInstToIface Nothing = Nothing
1384 famInstToIface (Just (famTyCon, instTys)) =
1385 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1387 tyThingToIfaceDecl (ADataCon dc)
1388 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1391 getFS :: NamedThing a => a -> FastString
1392 getFS x = occNameFS (getOccName x)
1394 --------------------------
1395 instanceToIfaceInst :: Instance -> IfaceInst
1396 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1397 is_cls = cls_name, is_tcs = mb_tcs })
1398 = ASSERT( cls_name == className cls )
1399 IfaceInst { ifDFun = dfun_name,
1401 ifInstCls = cls_name,
1402 ifInstTys = map do_rough mb_tcs,
1405 do_rough Nothing = Nothing
1406 do_rough (Just n) = Just (toIfaceTyCon_name n)
1408 dfun_name = idName dfun_id
1409 mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1410 is_local name = nameIsLocalOrFrom mod name
1412 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1413 (_, cls, tys) = tcSplitDFunTy (idType dfun_id)
1414 -- Slightly awkward: we need the Class to get the fundeps
1415 (tvs, fds) = classTvsFds cls
1416 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1417 orph | is_local cls_name = Just (nameOccName cls_name)
1418 | all isJust mb_ns = ASSERT( not (null mb_ns) ) head mb_ns
1419 | otherwise = Nothing
1421 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1422 -- that is not in the "determined" arguments
1423 mb_ns | null fds = [choose_one arg_names]
1424 | otherwise = map do_one fds
1425 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1426 , not (tv `elem` rtvs)]
1428 choose_one :: [NameSet] -> Maybe OccName
1429 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1431 (n : _) -> Just (nameOccName n)
1433 --------------------------
1434 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1435 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1438 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1439 , ifFamInstFam = fam
1440 , ifFamInstTys = map do_rough mb_tcs }
1442 do_rough Nothing = Nothing
1443 do_rough (Just n) = Just (toIfaceTyCon_name n)
1445 --------------------------
1446 toIfaceLetBndr :: Id -> IfaceLetBndr
1447 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1448 (toIfaceType (idType id))
1451 -- Stripped-down version of tcIfaceIdInfo
1452 -- Change this if you want to export more IdInfo for
1453 -- non-top-level Ids. Don't forget to change
1454 -- CoreTidy.tidyLetBndr too!
1456 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1458 inline_prag = inlinePragInfo id_info
1459 prag_info | isDefaultInlinePragma inline_prag = NoInfo
1460 | otherwise = HasInfo [HsInline inline_prag]
1462 --------------------------
1463 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
1464 toIfaceIdDetails VanillaId = IfVanillaId
1465 toIfaceIdDetails (DFunId {}) = IfDFunId
1466 toIfaceIdDetails (RecSelId { sel_naughty = n
1467 , sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
1468 toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
1469 IfVanillaId -- Unexpected
1471 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1472 toIfaceIdInfo id_info
1473 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1474 inline_hsinfo, unfold_hsinfo]
1475 -- NB: strictness must be before unfolding
1476 -- See TcIface.tcUnfolding
1478 ------------ Arity --------------
1479 arity_info = arityInfo id_info
1480 arity_hsinfo | arity_info == 0 = Nothing
1481 | otherwise = Just (HsArity arity_info)
1483 ------------ Caf Info --------------
1484 caf_info = cafInfo id_info
1485 caf_hsinfo = case caf_info of
1486 NoCafRefs -> Just HsNoCafRefs
1489 ------------ Strictness --------------
1490 -- No point in explicitly exporting TopSig
1491 strict_hsinfo = case strictnessInfo id_info of
1492 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1495 ------------ Unfolding --------------
1496 unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
1497 loop_breaker = isNonRuleLoopBreaker (occInfo id_info)
1499 ------------ Inline prag --------------
1500 inline_prag = inlinePragInfo id_info
1501 inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1502 | otherwise = Just (HsInline inline_prag)
1504 --------------------------
1505 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
1506 toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
1507 , uf_src = src, uf_guidance = guidance })
1509 InlineWrapper w -> Just (HsUnfold lb (IfWrapper arity (idName w)))
1510 InlineRule {} -> Just (HsUnfold lb (IfInlineRule arity sat (toIfaceExpr rhs)))
1511 _other -> Just (HsUnfold lb (IfCoreUnfold (toIfaceExpr rhs)))
1512 -- Yes, even if guidance is UnfNever, expose the unfolding
1513 -- If we didn't want to expose the unfolding, TidyPgm would
1514 -- have stuck in NoUnfolding. For supercompilation we want
1515 -- to see that unfolding!
1517 sat = case guidance of
1518 UnfWhen unsat_ok _ -> unsat_ok
1519 _other -> needSaturated
1521 toIfUnfolding lb (DFunUnfolding _con ops)
1522 = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
1523 -- No need to serialise the data constructor;
1524 -- we can recover it from the type of the dfun
1529 --------------------------
1530 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1531 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1532 = pprTrace "toHsRule: builtin" (ppr fn) $
1535 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1536 ru_act = act, ru_bndrs = bndrs,
1537 ru_args = args, ru_rhs = rhs })
1538 = IfaceRule { ifRuleName = name, ifActivation = act,
1539 ifRuleBndrs = map toIfaceBndr bndrs,
1541 ifRuleArgs = map do_arg args,
1542 ifRuleRhs = toIfaceExpr rhs,
1545 -- For type args we must remove synonyms from the outermost
1546 -- level. Reason: so that when we read it back in we'll
1547 -- construct the same ru_rough field as we have right now;
1549 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1550 do_arg arg = toIfaceExpr arg
1552 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1553 -- A rule is an orphan only if none of the variables
1554 -- mentioned on its left-hand side are locally defined
1555 lhs_names = fn : nameSetToList (exprsFreeNames args)
1556 -- No need to delete bndrs, because
1557 -- exprsFreeNames finds only External names
1559 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1560 (n : _) -> Just (nameOccName n)
1563 bogusIfaceRule :: Name -> IfaceRule
1564 bogusIfaceRule id_name
1565 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1566 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1567 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1569 ---------------------
1570 toIfaceExpr :: CoreExpr -> IfaceExpr
1571 toIfaceExpr (Var v) = toIfaceVar v
1572 toIfaceExpr (Lit l) = IfaceLit l
1573 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1574 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1575 toIfaceExpr (App f a) = toIfaceApp f [a]
1576 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1577 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1578 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1579 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1581 ---------------------
1582 toIfaceNote :: Note -> IfaceNote
1583 toIfaceNote (SCC cc) = IfaceSCC cc
1584 toIfaceNote (CoreNote s) = IfaceCoreNote s
1586 ---------------------
1587 toIfaceBind :: Bind Id -> IfaceBinding
1588 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1589 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1591 ---------------------
1592 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1593 -> (IfaceConAlt, [FastString], IfaceExpr)
1594 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1596 ---------------------
1597 toIfaceCon :: AltCon -> IfaceConAlt
1598 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1599 | otherwise = IfaceDataAlt (getName dc)
1601 tc = dataConTyCon dc
1603 toIfaceCon (LitAlt l) = IfaceLitAlt l
1604 toIfaceCon DEFAULT = IfaceDefault
1606 ---------------------
1607 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1608 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1609 toIfaceApp (Var v) as
1610 = case isDataConWorkId_maybe v of
1611 -- We convert the *worker* for tuples into IfaceTuples
1612 Just dc | isTupleTyCon tc && saturated
1613 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1615 val_args = dropWhile isTypeArg as
1616 saturated = val_args `lengthIs` idArity v
1617 tup_args = map toIfaceExpr val_args
1618 tc = dataConTyCon dc
1620 _ -> mkIfaceApps (toIfaceVar v) as
1622 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1624 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1625 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1627 ---------------------
1628 toIfaceVar :: Id -> IfaceExpr
1630 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1631 -- Foreign calls have special syntax
1632 | isExternalName name = IfaceExt name
1633 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1635 | otherwise = IfaceLcl (getFS name)