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
518 dep_pkgs (mi_deps iface0))
519 -- dep_pkgs: see "Package Version Changes" on
520 -- wiki/Commentary/Compiler/RecompilationAvoidance
522 -- put the declarations in a canonical order, sorted by OccName
523 let sorted_decls = eltsFM $ listToFM $
524 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
526 -- the ABI hash depends on:
532 mod_hash <- computeFingerprint dflags putNameLiterally
533 (map fst sorted_decls,
538 -- The interface hash depends on:
539 -- - the ABI hash, plus
543 iface_hash <- computeFingerprint dflags putNameLiterally
550 no_change_at_all = Just iface_hash == mb_old_fingerprint
552 final_iface = iface0 {
553 mi_mod_hash = mod_hash,
554 mi_iface_hash = iface_hash,
555 mi_exp_hash = export_hash,
556 mi_orphan_hash = orphan_hash,
557 mi_orphan = not (null orph_rules && null orph_insts),
558 mi_finsts = not . null $ mi_fam_insts iface0,
559 mi_decls = sorted_decls,
560 mi_hash_fn = lookupOccEnv local_env }
562 return (final_iface, no_change_at_all)
565 this_mod = mi_module iface0
566 dflags = hsc_dflags hsc_env
567 this_pkg = thisPackage dflags
568 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
569 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
570 -- ToDo: shouldn't we be splitting fam_insts into orphans and
572 fam_insts = mi_fam_insts iface0
573 fix_fn = mi_fix_fn iface0
576 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
577 getOrphanHashes hsc_env mods = do
578 eps <- hscEPS hsc_env
580 hpt = hsc_HPT hsc_env
582 dflags = hsc_dflags hsc_env
584 case lookupIfaceByModule dflags hpt pit mod of
585 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
586 Just iface -> mi_orphan_hash iface
588 return (map get_orph_hash mods)
591 sortDependencies :: Dependencies -> Dependencies
593 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
594 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
595 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
596 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
600 %************************************************************************
602 The ABI of an IfaceDecl
604 %************************************************************************
606 Note [The ABI of an IfaceDecl]
607 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
608 The ABI of a declaration consists of:
610 (a) the full name of the identifier (inc. module and package,
611 because these are used to construct the symbol name by which
612 the identifier is known externally).
614 (b) the declaration itself, as exposed to clients. That is, the
615 definition of an Id is included in the fingerprint only if
616 it is made available as as unfolding in the interface.
618 (c) the fixity of the identifier
620 (e) for classes: instances, fixity & rules for methods
621 (f) for datatypes: instances, fixity & rules for constrs
623 Items (c)-(f) are not stored in the IfaceDecl, but instead appear
624 elsewhere in the interface file. But they are *fingerprinted* with
625 the Id itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
626 and fingerprinting that as part of the Id.
629 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
632 = IfaceIdExtras Fixity [IfaceRule]
633 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
634 | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
635 | IfaceSynExtras Fixity
636 | IfaceOtherDeclExtras
638 abiDecl :: IfaceDeclABI -> IfaceDecl
639 abiDecl (_, decl, _) = decl
641 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
642 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
643 ifName (abiDecl abi2)
645 freeNamesDeclABI :: IfaceDeclABI -> NameSet
646 freeNamesDeclABI (_mod, decl, extras) =
647 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
649 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
650 freeNamesDeclExtras (IfaceIdExtras _ rules)
651 = unionManyNameSets (map freeNamesIfRule rules)
652 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
653 = unionManyNameSets (map freeNamesSub subs)
654 freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
655 = unionManyNameSets (map freeNamesSub subs)
656 freeNamesDeclExtras (IfaceSynExtras _)
658 freeNamesDeclExtras IfaceOtherDeclExtras
661 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
662 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
664 -- This instance is used only to compute fingerprints
665 instance Binary IfaceDeclExtras where
666 get _bh = panic "no get for IfaceDeclExtras"
667 put_ bh (IfaceIdExtras fix rules) = do
668 putByte bh 1; put_ bh fix; put_ bh rules
669 put_ bh (IfaceDataExtras fix insts cons) = do
670 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
671 put_ bh (IfaceClassExtras fix insts methods) = do
672 putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
673 put_ bh (IfaceSynExtras fix) = do
674 putByte bh 4; put_ bh fix
675 put_ bh IfaceOtherDeclExtras = do
678 declExtras :: (OccName -> Fixity)
679 -> OccEnv [IfaceRule]
680 -> OccEnv [IfaceInst]
684 declExtras fix_fn rule_env inst_env decl
686 IfaceId{} -> IfaceIdExtras (fix_fn n)
687 (lookupOccEnvL rule_env n)
688 IfaceData{ifCons=cons} ->
689 IfaceDataExtras (fix_fn n)
690 (map IfaceInstABI $ lookupOccEnvL inst_env n)
691 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
692 IfaceClass{ifSigs=sigs} ->
693 IfaceClassExtras (fix_fn n)
694 (map IfaceInstABI $ lookupOccEnvL inst_env n)
695 [id_extras op | IfaceClassOp op _ _ <- sigs]
696 IfaceSyn{} -> IfaceSynExtras (fix_fn n)
697 _other -> IfaceOtherDeclExtras
700 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
703 -- When hashing an instance, we hash only its structure, not the
704 -- fingerprints of the things it mentions. See the section on instances
705 -- in the commentary,
706 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
708 newtype IfaceInstABI = IfaceInstABI IfaceInst
710 instance Binary IfaceInstABI where
711 get = panic "no get for IfaceInstABI"
712 put_ bh (IfaceInstABI inst) = do
713 let ud = getUserData bh
714 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
717 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
718 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
720 -- used when we want to fingerprint a structure without depending on the
721 -- fingerprints of external Names that it refers to.
722 putNameLiterally :: BinHandle -> Name -> IO ()
723 putNameLiterally bh name = ASSERT( isExternalName name )
724 do { put_ bh $! nameModule name
725 ; put_ bh $! nameOccName name }
727 computeFingerprint :: Binary a
729 -> (BinHandle -> Name -> IO ())
733 computeFingerprint _dflags put_name a = do
734 bh <- openBinMem (3*1024) -- just less than a block
735 ud <- newWriteState put_name putFS
736 bh <- return $ setUserData bh ud
741 -- for testing: use the md5sum command to generate fingerprints and
742 -- compare the results against our built-in version.
743 fp' <- oldMD5 dflags bh
744 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
747 oldMD5 dflags bh = do
748 tmp <- newTempName dflags "bin"
750 tmp2 <- newTempName dflags "md5"
751 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
754 ExitFailure _ -> ghcError (PhaseFailed cmd r)
756 hash_str <- readFile tmp2
757 return $! readHexFingerprint hash_str
760 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
761 instOrphWarn unqual inst
762 = mkWarnMsg (getSrcSpan inst) unqual $
763 hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
765 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
766 ruleOrphWarn unqual mod rule
767 = mkWarnMsg silly_loc unqual $
768 ptext (sLit "Orphan rule:") <+> ppr rule
770 silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
771 -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
772 -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
774 ----------------------
775 -- mkOrphMap partitions instance decls or rules into
776 -- (a) an OccEnv for ones that are not orphans,
777 -- mapping the local OccName to a list of its decls
778 -- (b) a list of orphan decls
779 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
780 -- Nothing for an orphan decl
781 -> [decl] -- Sorted into canonical order
782 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
783 -- each sublist in canonical order
784 [decl]) -- Orphan decls; in canonical order
785 mkOrphMap get_key decls
786 = foldl go (emptyOccEnv, []) decls
788 go (non_orphs, orphs) d
789 | Just occ <- get_key d
790 = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
791 | otherwise = (non_orphs, d:orphs)
795 %************************************************************************
797 Keeping track of what we've slurped, and fingerprints
799 %************************************************************************
802 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
803 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
804 = do { eps <- hscEPS hsc_env
805 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
806 dir_imp_mods used_names
807 ; usages `seqList` return usages }
808 -- seq the list of Usages returned: occasionally these
809 -- don't get evaluated for a while and we can end up hanging on to
810 -- the entire collection of Ifaces.
812 mk_usage_info :: PackageIfaceTable
818 mk_usage_info pit hsc_env this_mod direct_imports used_names
819 = mapCatMaybes mkUsage usage_mods
821 hpt = hsc_HPT hsc_env
822 dflags = hsc_dflags hsc_env
823 this_pkg = thisPackage dflags
825 used_mods = moduleEnvKeys ent_map
826 dir_imp_mods = (moduleEnvKeys direct_imports)
827 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
828 usage_mods = sortBy stableModuleCmp all_mods
829 -- canonical order is imported, to avoid interface-file
832 -- ent_map groups together all the things imported and used
833 -- from a particular module
834 ent_map :: ModuleEnv [OccName]
835 ent_map = foldNameSet add_mv emptyModuleEnv used_names
838 | isWiredInName name = mv_map -- ignore wired-in names
840 = case nameModule_maybe name of
841 Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
842 Just mod -> -- We use this fiddly lambda function rather than
843 -- (++) as the argument to extendModuleEnv_C to
844 -- avoid quadratic behaviour (trac #2680)
845 extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
846 where occ = nameOccName name
848 -- We want to create a Usage for a home module if
849 -- a) we used something from it; has something in used_names
850 -- b) we imported it, even if we used nothing from it
851 -- (need to recompile if its export list changes: export_fprint)
852 mkUsage :: Module -> Maybe Usage
854 | isNothing maybe_iface -- We can't depend on it if we didn't
855 -- load its interface.
856 || mod == this_mod -- We don't care about usages of
857 -- things in *this* module
860 | modulePackageId mod /= this_pkg
861 = Just UsagePackageModule{ usg_mod = mod,
862 usg_mod_hash = mod_hash }
863 -- for package modules, we record the module hash only
866 && isNothing export_hash
867 && not is_direct_import
869 = Nothing -- Record no usage info
870 -- for directly-imported modules, we always want to record a usage
871 -- on the orphan hash. This is what triggers a recompilation if
872 -- an orphan is added or removed somewhere below us in the future.
875 = Just UsageHomeModule {
876 usg_mod_name = moduleName mod,
877 usg_mod_hash = mod_hash,
878 usg_exports = export_hash,
879 usg_entities = fmToList ent_hashs }
881 maybe_iface = lookupIfaceByModule dflags hpt pit mod
882 -- In one-shot mode, the interfaces for home-package
883 -- modules accumulate in the PIT not HPT. Sigh.
885 is_direct_import = mod `elemModuleEnv` direct_imports
887 Just iface = maybe_iface
888 finsts_mod = mi_finsts iface
889 hash_env = mi_hash_fn iface
890 mod_hash = mi_mod_hash iface
891 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
892 | otherwise = Nothing
894 used_occs = lookupModuleEnv ent_map mod `orElse` []
896 -- Making a FiniteMap here ensures that (a) we remove duplicates
897 -- when we have usages on several subordinates of a single parent,
898 -- and (b) that the usages emerge in a canonical order, which
899 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
900 -- using Ord on the OccNames, which is a lexicographic ordering.
901 ent_hashs :: FiniteMap OccName Fingerprint
902 ent_hashs = listToFM (map lookup_occ used_occs)
906 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
909 depend_on_exports mod =
910 case lookupModuleEnv direct_imports mod of
912 -- Even if we used 'import M ()', we have to register a
913 -- usage on the export list because we are sensitive to
914 -- changes in orphan instances/rules.
916 -- In GHC 6.8.x the above line read "True", and in
917 -- fact it recorded a dependency on *all* the
918 -- modules underneath in the dependency tree. This
919 -- happens to make orphans work right, but is too
920 -- expensive: it'll read too many interface files.
921 -- The 'isNothing maybe_iface' check above saved us
922 -- from generating many of these usages (at least in
923 -- one-shot mode), but that's even more bogus!
927 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
928 mkIfaceAnnotations = map mkIfaceAnnotation
930 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
931 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
932 ifAnnotatedTarget = fmap nameOccName target,
933 ifAnnotatedValue = serialized
938 mkIfaceExports :: [AvailInfo]
939 -> [(Module, [GenAvailInfo OccName])]
940 -- Group by module and sort by occurrence
941 mkIfaceExports exports
942 = [ (mod, eltsFM avails)
943 | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
944 (moduleEnvToList groupFM)
945 -- NB. the fmToList is in a random order,
946 -- because Ord Module is not a predictable
947 -- ordering. Hence we perform a final sort
948 -- using the stable Module ordering.
951 -- Group by the module where the exported entities are defined
952 -- (which may not be the same for all Names in an Avail)
953 -- Deliberately use FiniteMap rather than UniqFM so we
954 -- get a canonical ordering
955 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
956 groupFM = foldl add emptyModuleEnv exports
958 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
959 -> Module -> GenAvailInfo OccName
960 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
961 add_one env mod avail
962 = extendModuleEnv_C plusFM env mod
963 (unitFM (occNameFS (availName avail)) avail)
965 -- NB: we should not get T(X) and T(Y) in the export list
966 -- else the plusFM will simply discard one! They
967 -- should have been combined by now.
969 = ASSERT( isExternalName n )
970 add_one env (nameModule n) (Avail (nameOccName n))
972 add env (AvailTC tc ns)
973 = ASSERT( all isExternalName ns )
974 foldl add_for_mod env mods
976 tc_occ = nameOccName tc
977 mods = nub (map nameModule ns)
978 -- Usually just one, but see Note [Original module]
981 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
982 -- NB. sort the children, we need a canonical order
984 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
987 Note [Orignal module]
988 ~~~~~~~~~~~~~~~~~~~~~
990 module X where { data family T }
991 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
992 The exported Avail from Y will look like
995 - only MkT is brought into scope by the data instance;
996 - but the parent (used for grouping and naming in T(..) exports) is X.T
997 - and in this case we export X.T too
999 In the result of MkIfaceExports, the names are grouped by defining module,
1000 so we may need to split up a single Avail into multiple ones.
1003 %************************************************************************
1005 Load the old interface file for this module (unless
1006 we have it aleady), and check whether it is up to date
1009 %************************************************************************
1012 checkOldIface :: HscEnv
1014 -> Bool -- Source unchanged
1015 -> Maybe ModIface -- Old interface from compilation manager, if any
1016 -> IO (RecompileRequired, Maybe ModIface)
1018 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1019 = do { showPass (hsc_dflags hsc_env)
1020 ("Checking old interface for " ++
1021 showSDoc (ppr (ms_mod mod_summary))) ;
1023 ; initIfaceCheck hsc_env $
1024 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1027 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1028 -> IfG (Bool, Maybe ModIface)
1029 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1030 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
1031 { when (not source_unchanged)
1032 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1034 -- If the source has changed and we're in interactive mode, avoid reading
1035 -- an interface; just return the one we might have been supplied with.
1036 ; let dflags = hsc_dflags hsc_env
1037 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1038 return (outOfDate, maybe_iface)
1040 case maybe_iface of {
1041 Just old_iface -> do -- Use the one we already have
1042 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1043 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1044 ; return (recomp, Just old_iface) }
1048 -- Try and read the old interface for the current module
1049 -- from the .hi file left from the last time we compiled it
1050 { let iface_path = msHiFilePath mod_summary
1051 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1052 ; case read_result of {
1053 Failed err -> do -- Old interface file not found, or garbled; give up
1054 { traceIf (text "FYI: cannot read old interface file:"
1056 ; return (outOfDate, Nothing) }
1058 ; Succeeded iface -> do
1060 -- We have got the old iface; check its versions
1061 { traceIf (text "Read the interface file" <+> text iface_path)
1062 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1063 ; return (recomp, Just iface)
1068 @recompileRequired@ is called from the HscMain. It checks whether
1069 a recompilation is required. It needs access to the persistent state,
1070 finder, etc, because it may have to load lots of interface files to
1071 check their versions.
1074 type RecompileRequired = Bool
1075 upToDate, outOfDate :: Bool
1076 upToDate = False -- Recompile not required
1077 outOfDate = True -- Recompile required
1079 checkVersions :: HscEnv
1080 -> Bool -- True <=> source unchanged
1082 -> ModIface -- Old interface
1083 -> IfG RecompileRequired
1084 checkVersions hsc_env source_unchanged mod_summary iface
1085 | not source_unchanged
1088 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1089 ppr (mi_module iface) <> colon)
1091 ; recomp <- checkDependencies hsc_env mod_summary iface
1092 ; if recomp then return outOfDate else do {
1094 -- Source code unchanged and no errors yet... carry on
1096 -- First put the dependent-module info, read from the old
1097 -- interface, into the envt, so that when we look for
1098 -- interfaces we look for the right one (.hi or .hi-boot)
1100 -- It's just temporary because either the usage check will succeed
1101 -- (in which case we are done with this module) or it'll fail (in which
1102 -- case we'll compile the module from scratch anyhow).
1104 -- We do this regardless of compilation mode, although in --make mode
1105 -- all the dependent modules should be in the HPT already, so it's
1107 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1109 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1110 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1113 -- This is a bit of a hack really
1114 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1115 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1118 -- If the direct imports of this module are resolved to targets that
1119 -- are not among the dependencies of the previous interface file,
1120 -- then we definitely need to recompile. This catches cases like
1121 -- - an exposed package has been upgraded
1122 -- - we are compiling with different package flags
1123 -- - a home module that was shadowing a package module has been removed
1124 -- - a new home module has been added that shadows a package module
1127 -- Returns True if recompilation is required.
1128 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1129 checkDependencies hsc_env summary iface
1130 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1132 prev_dep_mods = dep_mods (mi_deps iface)
1133 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1135 this_pkg = thisPackage (hsc_dflags hsc_env)
1137 orM = foldr f (return False)
1138 where f m rest = do b <- m; if b then return True else rest
1140 dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
1141 find_res <- liftIO $ findImportedModule hsc_env mod pkg
1145 -> if moduleName mod `notElem` map fst prev_dep_mods
1146 then do traceHiDiffs $
1147 text "imported module " <> quotes (ppr mod) <>
1148 text " not among previous dependencies"
1153 -> if pkg `notElem` prev_dep_pkgs
1154 then do traceHiDiffs $
1155 text "imported module " <> quotes (ppr mod) <>
1156 text " is from package " <> quotes (ppr pkg) <>
1157 text ", which is not among previous dependencies"
1161 where pkg = modulePackageId mod
1162 _otherwise -> return outOfDate
1164 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1165 -> IfG RecompileRequired
1166 needInterface mod continue
1167 = do -- Load the imported interface if possible
1168 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1169 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1171 mb_iface <- loadInterface doc_str mod ImportBySystem
1172 -- Load the interface, but don't complain on failure;
1173 -- Instead, get an Either back which we can test
1176 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1178 -- Couldn't find or parse a module mentioned in the
1179 -- old interface file. Don't complain: it might
1180 -- just be that the current module doesn't need that
1181 -- import and it's been deleted
1182 Succeeded iface -> continue iface
1185 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1186 -- Given the usage information extracted from the old
1187 -- M.hi file for the module being compiled, figure out
1188 -- whether M needs to be recompiled.
1190 checkModUsage _this_pkg UsagePackageModule{
1192 usg_mod_hash = old_mod_hash }
1193 = needInterface mod $ \iface -> do
1194 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1195 -- We only track the ABI hash of package modules, rather than
1196 -- individual entity usages, so if the ABI hash changes we must
1197 -- recompile. This is safe but may entail more recompilation when
1198 -- a dependent package has changed.
1200 checkModUsage this_pkg UsageHomeModule{
1201 usg_mod_name = mod_name,
1202 usg_mod_hash = old_mod_hash,
1203 usg_exports = maybe_old_export_hash,
1204 usg_entities = old_decl_hash }
1206 let mod = mkModule this_pkg mod_name
1207 needInterface mod $ \iface -> do
1210 new_mod_hash = mi_mod_hash iface
1211 new_decl_hash = mi_hash_fn iface
1212 new_export_hash = mi_exp_hash iface
1215 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1216 if not recompile then return upToDate else do
1218 -- CHECK EXPORT LIST
1219 checkMaybeHash maybe_old_export_hash new_export_hash
1220 (ptext (sLit " Export list changed")) $ do
1222 -- CHECK ITEMS ONE BY ONE
1223 recompile <- checkList [ checkEntityUsage new_decl_hash u
1224 | u <- old_decl_hash]
1226 then return outOfDate -- This one failed, so just bail out now
1227 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1229 ------------------------
1230 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1231 checkModuleFingerprint old_mod_hash new_mod_hash
1232 | new_mod_hash == old_mod_hash
1233 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1236 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1237 old_mod_hash new_mod_hash
1239 ------------------------
1240 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1241 -> IfG RecompileRequired -> IfG RecompileRequired
1242 checkMaybeHash maybe_old_hash new_hash doc continue
1243 | Just hash <- maybe_old_hash, hash /= new_hash
1244 = out_of_date_hash doc hash new_hash
1248 ------------------------
1249 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1250 -> (OccName, Fingerprint)
1252 checkEntityUsage new_hash (name,old_hash)
1253 = case new_hash name of
1255 Nothing -> -- We used it before, but it ain't there now
1256 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1258 Just (_, new_hash) -- It's there, but is it up to date?
1259 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1261 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1264 up_to_date, out_of_date :: SDoc -> IfG Bool
1265 up_to_date msg = traceHiDiffs msg >> return upToDate
1266 out_of_date msg = traceHiDiffs msg >> return outOfDate
1268 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1269 out_of_date_hash msg old_hash new_hash
1270 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1272 ----------------------
1273 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1274 -- This helper is used in two places
1275 checkList [] = return upToDate
1276 checkList (check:checks) = do recompile <- check
1278 then return outOfDate
1279 else checkList checks
1282 %************************************************************************
1284 Converting things to their Iface equivalents
1286 %************************************************************************
1289 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1290 -- Assumption: the thing is already tidied, so that locally-bound names
1291 -- (lambdas, for-alls) already have non-clashing OccNames
1292 -- Reason: Iface stuff uses OccNames, and the conversion here does
1293 -- not do tidying on the way
1294 tyThingToIfaceDecl (AnId id)
1295 = IfaceId { ifName = getOccName id,
1296 ifType = toIfaceType (idType id),
1297 ifIdDetails = toIfaceIdDetails (idDetails id),
1300 info = case toIfaceIdInfo (idInfo id) of
1302 items -> HasInfo items
1304 tyThingToIfaceDecl (AClass clas)
1305 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1306 ifName = getOccName clas,
1307 ifTyVars = toIfaceTvBndrs clas_tyvars,
1308 ifFDs = map toIfaceFD clas_fds,
1309 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1310 ifSigs = map toIfaceClassOp op_stuff,
1311 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1313 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1314 = classExtraBigSig clas
1315 tycon = classTyCon clas
1317 toIfaceClassOp (sel_id, def_meth)
1318 = ASSERT(sel_tyvars == clas_tyvars)
1319 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1321 -- Be careful when splitting the type, because of things
1322 -- like class Foo a where
1323 -- op :: (?x :: String) => a -> a
1324 -- and class Baz a where
1325 -- op :: (Ord a) => a -> a
1326 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1327 op_ty = funResultTy rho_ty
1329 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1331 tyThingToIfaceDecl (ATyCon tycon)
1333 = IfaceSyn { ifName = getOccName tycon,
1334 ifTyVars = toIfaceTvBndrs tyvars,
1337 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1341 = IfaceData { ifName = getOccName tycon,
1342 ifTyVars = toIfaceTvBndrs tyvars,
1343 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1344 ifCons = ifaceConDecls (algTyConRhs tycon),
1345 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1346 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1347 ifGeneric = tyConHasGenerics tycon,
1348 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1350 | isForeignTyCon tycon
1351 = IfaceForeign { ifName = getOccName tycon,
1352 ifExtName = tyConExtName tycon }
1354 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1356 tyvars = tyConTyVars tycon
1358 = case synTyConRhs tycon of
1359 OpenSynTyCon ki _ -> (Nothing, toIfaceType ki)
1360 SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1362 ifaceConDecls (NewTyCon { data_con = con }) =
1363 IfNewTyCon (ifaceConDecl con)
1364 ifaceConDecls (DataTyCon { data_cons = cons }) =
1365 IfDataTyCon (map ifaceConDecl cons)
1366 ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
1367 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1368 -- The last case happens when a TyCon has been trimmed during tidying
1369 -- Furthermore, tyThingToIfaceDecl is also used
1370 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1371 -- AbstractTyCon case is perfectly sensible.
1373 ifaceConDecl data_con
1374 = IfCon { ifConOcc = getOccName (dataConName data_con),
1375 ifConInfix = dataConIsInfix data_con,
1376 ifConWrapper = isJust (dataConWrapId_maybe data_con),
1377 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1378 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1379 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1380 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1381 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1382 ifConFields = map getOccName
1383 (dataConFieldLabels data_con),
1384 ifConStricts = dataConStrictMarks data_con }
1386 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1388 famInstToIface Nothing = Nothing
1389 famInstToIface (Just (famTyCon, instTys)) =
1390 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1392 tyThingToIfaceDecl (ADataCon dc)
1393 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1396 getFS :: NamedThing a => a -> FastString
1397 getFS x = occNameFS (getOccName x)
1399 --------------------------
1400 instanceToIfaceInst :: Instance -> IfaceInst
1401 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1402 is_cls = cls_name, is_tcs = mb_tcs })
1403 = ASSERT( cls_name == className cls )
1404 IfaceInst { ifDFun = dfun_name,
1406 ifInstCls = cls_name,
1407 ifInstTys = map do_rough mb_tcs,
1410 do_rough Nothing = Nothing
1411 do_rough (Just n) = Just (toIfaceTyCon_name n)
1413 dfun_name = idName dfun_id
1414 mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1415 is_local name = nameIsLocalOrFrom mod name
1417 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1418 (_, cls, tys) = tcSplitDFunTy (idType dfun_id)
1419 -- Slightly awkward: we need the Class to get the fundeps
1420 (tvs, fds) = classTvsFds cls
1421 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1422 orph | is_local cls_name = Just (nameOccName cls_name)
1423 | all isJust mb_ns = ASSERT( not (null mb_ns) ) head mb_ns
1424 | otherwise = Nothing
1426 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1427 -- that is not in the "determined" arguments
1428 mb_ns | null fds = [choose_one arg_names]
1429 | otherwise = map do_one fds
1430 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1431 , not (tv `elem` rtvs)]
1433 choose_one :: [NameSet] -> Maybe OccName
1434 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1436 (n : _) -> Just (nameOccName n)
1438 --------------------------
1439 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1440 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1443 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1444 , ifFamInstFam = fam
1445 , ifFamInstTys = map do_rough mb_tcs }
1447 do_rough Nothing = Nothing
1448 do_rough (Just n) = Just (toIfaceTyCon_name n)
1450 --------------------------
1451 toIfaceLetBndr :: Id -> IfaceLetBndr
1452 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1453 (toIfaceType (idType id))
1456 -- Stripped-down version of tcIfaceIdInfo
1457 -- Change this if you want to export more IdInfo for
1458 -- non-top-level Ids. Don't forget to change
1459 -- CoreTidy.tidyLetBndr too!
1461 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1463 inline_prag = inlinePragInfo id_info
1464 prag_info | isDefaultInlinePragma inline_prag = NoInfo
1465 | otherwise = HasInfo [HsInline inline_prag]
1467 --------------------------
1468 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
1469 toIfaceIdDetails VanillaId = IfVanillaId
1470 toIfaceIdDetails (DFunId {}) = IfDFunId
1471 toIfaceIdDetails (RecSelId { sel_naughty = n
1472 , sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
1473 toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
1474 IfVanillaId -- Unexpected
1476 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1477 toIfaceIdInfo id_info
1478 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1479 inline_hsinfo, unfold_hsinfo]
1480 -- NB: strictness must be before unfolding
1481 -- See TcIface.tcUnfolding
1483 ------------ Arity --------------
1484 arity_info = arityInfo id_info
1485 arity_hsinfo | arity_info == 0 = Nothing
1486 | otherwise = Just (HsArity arity_info)
1488 ------------ Caf Info --------------
1489 caf_info = cafInfo id_info
1490 caf_hsinfo = case caf_info of
1491 NoCafRefs -> Just HsNoCafRefs
1494 ------------ Strictness --------------
1495 -- No point in explicitly exporting TopSig
1496 strict_hsinfo = case strictnessInfo id_info of
1497 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1500 ------------ Unfolding --------------
1501 unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
1502 loop_breaker = isNonRuleLoopBreaker (occInfo id_info)
1504 ------------ Inline prag --------------
1505 inline_prag = inlinePragInfo id_info
1506 inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1507 | otherwise = Just (HsInline inline_prag)
1509 --------------------------
1510 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
1511 toIfUnfolding lb unf@(CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
1512 , uf_src = src, uf_guidance = guidance })
1513 = Just $ HsUnfold lb $
1517 UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok (toIfaceExpr rhs)
1518 _other -> pprPanic "toIfUnfolding" (ppr unf)
1519 InlineWrapper w -> IfWrapper arity (idName w)
1520 InlineCompulsory -> IfCompulsory (toIfaceExpr rhs)
1521 InlineRhs -> IfCoreUnfold (toIfaceExpr rhs)
1522 -- Yes, even if guidance is UnfNever, expose the unfolding
1523 -- If we didn't want to expose the unfolding, TidyPgm would
1524 -- have stuck in NoUnfolding. For supercompilation we want
1525 -- to see that unfolding!
1527 toIfUnfolding lb (DFunUnfolding _con ops)
1528 = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
1529 -- No need to serialise the data constructor;
1530 -- we can recover it from the type of the dfun
1535 --------------------------
1536 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1537 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1538 = pprTrace "toHsRule: builtin" (ppr fn) $
1541 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1542 ru_act = act, ru_bndrs = bndrs,
1543 ru_args = args, ru_rhs = rhs })
1544 = IfaceRule { ifRuleName = name, ifActivation = act,
1545 ifRuleBndrs = map toIfaceBndr bndrs,
1547 ifRuleArgs = map do_arg args,
1548 ifRuleRhs = toIfaceExpr rhs,
1551 -- For type args we must remove synonyms from the outermost
1552 -- level. Reason: so that when we read it back in we'll
1553 -- construct the same ru_rough field as we have right now;
1555 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1556 do_arg arg = toIfaceExpr arg
1558 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1559 -- A rule is an orphan only if none of the variables
1560 -- mentioned on its left-hand side are locally defined
1561 lhs_names = fn : nameSetToList (exprsFreeNames args)
1562 -- No need to delete bndrs, because
1563 -- exprsFreeNames finds only External names
1565 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1566 (n : _) -> Just (nameOccName n)
1569 bogusIfaceRule :: Name -> IfaceRule
1570 bogusIfaceRule id_name
1571 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1572 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1573 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1575 ---------------------
1576 toIfaceExpr :: CoreExpr -> IfaceExpr
1577 toIfaceExpr (Var v) = toIfaceVar v
1578 toIfaceExpr (Lit l) = IfaceLit l
1579 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1580 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1581 toIfaceExpr (App f a) = toIfaceApp f [a]
1582 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1583 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1584 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1585 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1587 ---------------------
1588 toIfaceNote :: Note -> IfaceNote
1589 toIfaceNote (SCC cc) = IfaceSCC cc
1590 toIfaceNote (CoreNote s) = IfaceCoreNote s
1592 ---------------------
1593 toIfaceBind :: Bind Id -> IfaceBinding
1594 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1595 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1597 ---------------------
1598 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1599 -> (IfaceConAlt, [FastString], IfaceExpr)
1600 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1602 ---------------------
1603 toIfaceCon :: AltCon -> IfaceConAlt
1604 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1605 | otherwise = IfaceDataAlt (getName dc)
1607 tc = dataConTyCon dc
1609 toIfaceCon (LitAlt l) = IfaceLitAlt l
1610 toIfaceCon DEFAULT = IfaceDefault
1612 ---------------------
1613 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1614 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1615 toIfaceApp (Var v) as
1616 = case isDataConWorkId_maybe v of
1617 -- We convert the *worker* for tuples into IfaceTuples
1618 Just dc | isTupleTyCon tc && saturated
1619 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1621 val_args = dropWhile isTypeArg as
1622 saturated = val_args `lengthIs` idArity v
1623 tup_args = map toIfaceExpr val_args
1624 tc = dataConTyCon dc
1626 _ -> mkIfaceApps (toIfaceVar v) as
1628 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1630 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1631 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1633 ---------------------
1634 toIfaceVar :: Id -> IfaceExpr
1636 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1637 -- Foreign calls have special syntax
1638 | isExternalName name = IfaceExt name
1639 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1641 | otherwise = IfaceLcl (getFS name)