2 % (c) The University of Glasgow 2006-2008
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
10 mkIface, -- Build a ModIface from a ModGuts,
11 -- including computing version information
15 writeIfaceFile, -- Write the interface file
17 checkOldIface, -- See if recompilation is required, by
18 -- comparing version information
20 tyThingToIfaceDecl -- Converting things to their Iface equivalents
24 -----------------------------------------------
25 Recompilation checking
26 -----------------------------------------------
28 A complete description of how recompilation checking works can be
29 found in the wiki commentary:
31 http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
33 Please read the above page for a top-down description of how this all
34 works. Notes below cover specific issues related to the implementation.
38 * In the mi_usages information in an interface, we record the
39 fingerprint of each free variable of the module
41 * In mkIface, we compute the fingerprint of each exported thing A.f.
42 For each external thing that A.f refers to, we include the fingerprint
43 of the external reference when computing the fingerprint of A.f. So
44 if anything that A.f depends on changes, then A.f's fingerprint will
47 * In checkOldIface we compare the mi_usages for the module with
48 the actual fingerprint for all each thing recorded in mi_usages
51 #include "HsVersions.h"
86 import BasicTypes hiding ( SuccessFlag(..) )
89 import Util hiding ( eqListBy )
101 import System.FilePath
106 %************************************************************************
108 \subsection{Completing an interface}
110 %************************************************************************
114 -> Maybe Fingerprint -- The old fingerprint, if we have it
115 -> ModDetails -- The trimmed, tidied interface
116 -> ModGuts -- Usages, deprecations, etc
118 Maybe (ModIface, -- The new one
119 Bool)) -- True <=> there was an old Iface, and the
120 -- new one is identical, so no need
123 mkIface hsc_env maybe_old_fingerprint mod_details
124 ModGuts{ mg_module = this_mod,
126 mg_used_names = used_names,
128 mg_dir_imps = dir_imp_mods,
129 mg_rdr_env = rdr_env,
130 mg_fix_env = fix_env,
132 mg_hpc_info = hpc_info }
133 = mkIface_ hsc_env maybe_old_fingerprint
134 this_mod is_boot used_names deps rdr_env
135 fix_env warns hpc_info dir_imp_mods mod_details
137 -- | make an interface from the results of typechecking only. Useful
138 -- for non-optimising compilation, or where we aren't generating any
139 -- object code at all ('HscNothing').
141 -> Maybe Fingerprint -- The old fingerprint, if we have it
142 -> ModDetails -- gotten from mkBootModDetails, probably
143 -> TcGblEnv -- Usages, deprecations, etc
144 -> IO (Messages, Maybe (ModIface, Bool))
145 mkIfaceTc hsc_env maybe_old_fingerprint mod_details
146 tc_result@TcGblEnv{ tcg_mod = this_mod,
148 tcg_imports = imports,
149 tcg_rdr_env = rdr_env,
150 tcg_fix_env = fix_env,
152 tcg_hpc = other_hpc_info
155 used_names <- mkUsedNames tc_result
156 deps <- mkDependencies tc_result
157 let hpc_info = emptyHpcInfo other_hpc_info
158 mkIface_ hsc_env maybe_old_fingerprint
159 this_mod (isHsBoot hsc_src) used_names deps rdr_env
160 fix_env warns hpc_info (imp_mods imports) mod_details
163 mkUsedNames :: TcGblEnv -> IO NameSet
165 TcGblEnv{ tcg_inst_uses = dfun_uses_var,
168 = do { 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
323 deliberatelyOmitted :: String -> a
324 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
326 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
328 flattenVectInfo (VectInfo { vectInfoVar = vVar
329 , vectInfoTyCon = vTyCon
332 ifaceVectInfoVar = [ Var.varName v
333 | (v, _) <- varEnvElts vVar],
334 ifaceVectInfoTyCon = [ tyConName t
335 | (t, t_v) <- nameEnvElts vTyCon
337 ifaceVectInfoTyConReuse = [ tyConName t
338 | (t, t_v) <- nameEnvElts vTyCon
342 -----------------------------
343 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
344 writeIfaceFile dflags location new_iface
345 = do createDirectoryHierarchy (takeDirectory hi_file_path)
346 writeBinIface dflags hi_file_path new_iface
347 where hi_file_path = ml_hi_file location
350 -- -----------------------------------------------------------------------------
351 -- Look up parents and versions of Names
353 -- This is like a global version of the mi_hash_fn field in each ModIface.
354 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
355 -- the parent and version info.
358 :: HscEnv -- needed to look up versions
359 -> ExternalPackageState -- ditto
360 -> (Name -> Fingerprint)
361 mkHashFun hsc_env eps
364 mod = ASSERT2( isExternalName name, ppr name ) nameModule name
365 occ = nameOccName name
366 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
367 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
369 snd (mi_hash_fn iface occ `orElse`
370 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
372 hpt = hsc_HPT hsc_env
375 -- ---------------------------------------------------------------------------
376 -- Compute fingerprints for the interface
380 -> Maybe Fingerprint -- the old fingerprint, if any
381 -> ModIface -- The new interface (lacking decls)
382 -> [IfaceDecl] -- The new decls
383 -> IO (ModIface, -- Updated interface
384 Bool) -- True <=> no changes at all;
385 -- no need to write Iface
387 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
389 eps <- hscEPS hsc_env
391 -- The ABI of a declaration represents everything that is made
392 -- visible about the declaration that a client can depend on.
393 -- see IfaceDeclABI below.
394 declABI :: IfaceDecl -> IfaceDeclABI
395 declABI decl = (this_mod, decl, extras)
396 where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
398 edges :: [(IfaceDeclABI, Unique, [Unique])]
399 edges = [ (abi, getUnique (ifName decl), out)
401 , let abi = declABI decl
402 , let out = localOccs $ freeNamesDeclABI abi
405 name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
406 localOccs = map (getUnique . getParent . getOccName)
407 . filter ((== this_mod) . name_module)
409 where getParent occ = lookupOccEnv parent_map occ `orElse` occ
411 -- maps OccNames to their parents in the current module.
412 -- e.g. a reference to a constructor must be turned into a reference
413 -- to the TyCon for the purposes of calculating dependencies.
414 parent_map :: OccEnv OccName
415 parent_map = foldr extend emptyOccEnv new_decls
417 extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
420 -- strongly-connected groups of declarations, in dependency order
421 groups = stronglyConnCompFromEdgedVertices edges
423 global_hash_fn = mkHashFun hsc_env eps
425 -- how to output Names when generating the data to fingerprint.
426 -- Here we want to output the fingerprint for each top-level
427 -- Name, whether it comes from the current module or another
428 -- module. In this way, the fingerprint for a declaration will
429 -- change if the fingerprint for anything it refers to (transitively)
431 mk_put_name :: (OccEnv (OccName,Fingerprint))
432 -> BinHandle -> Name -> IO ()
433 mk_put_name local_env bh name
434 | isWiredInName name = putNameLiterally bh name
435 -- wired-in names don't have fingerprints
437 = ASSERT( isExternalName name )
438 let hash | nameModule name /= this_mod = global_hash_fn name
440 snd (lookupOccEnv local_env (getOccName name)
441 `orElse` pprPanic "urk! lookup local fingerprint"
442 (ppr name)) -- (undefined,fingerprint0))
443 -- This panic indicates that we got the dependency
444 -- analysis wrong, because we needed a fingerprint for
445 -- an entity that wasn't in the environment. To debug
446 -- it, turn the panic into a trace, uncomment the
447 -- pprTraces below, run the compile again, and inspect
448 -- the output and the generated .hi file with
453 -- take a strongly-connected group of declarations and compute
456 fingerprint_group :: (OccEnv (OccName,Fingerprint),
457 [(Fingerprint,IfaceDecl)])
459 -> IO (OccEnv (OccName,Fingerprint),
460 [(Fingerprint,IfaceDecl)])
462 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
463 = do let hash_fn = mk_put_name local_env
465 -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
466 hash <- computeFingerprint dflags hash_fn abi
467 return (extend_hash_env (hash,decl) local_env,
468 (hash,decl) : decls_w_hashes)
470 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
471 = do let decls = map abiDecl abis
472 local_env' = foldr extend_hash_env local_env
473 (zip (repeat fingerprint0) decls)
474 hash_fn = mk_put_name local_env'
475 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
476 let stable_abis = sortBy cmp_abiNames abis
477 -- put the cycle in a canonical order
478 hash <- computeFingerprint dflags hash_fn stable_abis
479 let pairs = zip (repeat hash) decls
480 return (foldr extend_hash_env local_env pairs,
481 pairs ++ decls_w_hashes)
483 extend_hash_env :: (Fingerprint,IfaceDecl)
484 -> OccEnv (OccName,Fingerprint)
485 -> OccEnv (OccName,Fingerprint)
486 extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
489 item = (decl_name, hash)
490 env1 = extendOccEnv env0 decl_name item
491 add_imp bndr env = extendOccEnv env bndr item
494 (local_env, decls_w_hashes) <-
495 foldM fingerprint_group (emptyOccEnv, []) groups
497 -- when calculating fingerprints, we always need to use canonical
498 -- ordering for lists of things. In particular, the mi_deps has various
499 -- lists of modules and suchlike, so put these all in canonical order:
500 let sorted_deps = sortDependencies (mi_deps iface0)
502 -- the export hash of a module depends on the orphan hashes of the
503 -- orphan modules below us in the dependency tree. This is the way
504 -- that changes in orphans get propagated all the way up the
505 -- dependency tree. We only care about orphan modules in the current
506 -- package, because changes to orphans outside this package will be
507 -- tracked by the usage on the ABI hash of package modules that we import.
508 let orph_mods = filter ((== this_pkg) . modulePackageId)
509 $ dep_orphs sorted_deps
510 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
512 orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
513 (map IfaceInstABI orph_insts, orph_rules, fam_insts)
515 -- the export list hash doesn't depend on the fingerprints of
516 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
517 export_hash <- computeFingerprint dflags putNameLiterally
521 dep_pkgs (mi_deps iface0))
522 -- dep_pkgs: see "Package Version Changes" on
523 -- wiki/Commentary/Compiler/RecompilationAvoidance
525 -- put the declarations in a canonical order, sorted by OccName
526 let sorted_decls = eltsFM $ listToFM $
527 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
529 -- the ABI hash depends on:
535 mod_hash <- computeFingerprint dflags putNameLiterally
536 (map fst sorted_decls,
541 -- The interface hash depends on:
542 -- - the ABI hash, plus
546 iface_hash <- computeFingerprint dflags putNameLiterally
553 no_change_at_all = Just iface_hash == mb_old_fingerprint
555 final_iface = iface0 {
556 mi_mod_hash = mod_hash,
557 mi_iface_hash = iface_hash,
558 mi_exp_hash = export_hash,
559 mi_orphan_hash = orphan_hash,
560 mi_orphan = not (null orph_rules && null orph_insts),
561 mi_finsts = not . null $ mi_fam_insts iface0,
562 mi_decls = sorted_decls,
563 mi_hash_fn = lookupOccEnv local_env }
565 return (final_iface, no_change_at_all)
568 this_mod = mi_module iface0
569 dflags = hsc_dflags hsc_env
570 this_pkg = thisPackage dflags
571 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
572 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
573 -- ToDo: shouldn't we be splitting fam_insts into orphans and
575 fam_insts = mi_fam_insts iface0
576 fix_fn = mi_fix_fn iface0
579 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
580 getOrphanHashes hsc_env mods = do
581 eps <- hscEPS hsc_env
583 hpt = hsc_HPT hsc_env
585 dflags = hsc_dflags hsc_env
587 case lookupIfaceByModule dflags hpt pit mod of
588 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
589 Just iface -> mi_orphan_hash iface
591 return (map get_orph_hash mods)
594 sortDependencies :: Dependencies -> Dependencies
596 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
597 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
598 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
599 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
603 %************************************************************************
605 The ABI of an IfaceDecl
607 %************************************************************************
609 Note [The ABI of an IfaceDecl]
610 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
611 The ABI of a declaration consists of:
613 (a) the full name of the identifier (inc. module and package,
614 because these are used to construct the symbol name by which
615 the identifier is known externally).
617 (b) the declaration itself, as exposed to clients. That is, the
618 definition of an Id is included in the fingerprint only if
619 it is made available as as unfolding in the interface.
621 (c) the fixity of the identifier
623 (e) for classes: instances, fixity & rules for methods
624 (f) for datatypes: instances, fixity & rules for constrs
626 Items (c)-(f) are not stored in the IfaceDecl, but instead appear
627 elsewhere in the interface file. But they are *fingerprinted* with
628 the Id itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
629 and fingerprinting that as part of the Id.
632 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
635 = IfaceIdExtras Fixity [IfaceRule]
636 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
637 | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
638 | IfaceSynExtras Fixity
639 | IfaceOtherDeclExtras
641 abiDecl :: IfaceDeclABI -> IfaceDecl
642 abiDecl (_, decl, _) = decl
644 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
645 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
646 ifName (abiDecl abi2)
648 freeNamesDeclABI :: IfaceDeclABI -> NameSet
649 freeNamesDeclABI (_mod, decl, extras) =
650 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
652 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
653 freeNamesDeclExtras (IfaceIdExtras _ rules)
654 = unionManyNameSets (map freeNamesIfRule rules)
655 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
656 = unionManyNameSets (map freeNamesSub subs)
657 freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
658 = unionManyNameSets (map freeNamesSub subs)
659 freeNamesDeclExtras (IfaceSynExtras _)
661 freeNamesDeclExtras IfaceOtherDeclExtras
664 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
665 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
667 instance Outputable IfaceDeclExtras where
668 ppr IfaceOtherDeclExtras = empty
669 ppr (IfaceIdExtras fix rules) = ppr_id_extras fix rules
670 ppr (IfaceSynExtras fix) = ppr fix
671 ppr (IfaceDataExtras fix insts stuff) = vcat [ppr fix, ppr_insts insts,
672 ppr_id_extras_s stuff]
673 ppr (IfaceClassExtras fix insts stuff) = vcat [ppr fix, ppr_insts insts,
674 ppr_id_extras_s stuff]
676 ppr_insts :: [IfaceInstABI] -> SDoc
677 ppr_insts _ = ptext (sLit "<insts>")
679 ppr_id_extras_s :: [(Fixity, [IfaceRule])] -> SDoc
680 ppr_id_extras_s stuff = vcat [ppr_id_extras f r | (f,r)<- stuff]
682 ppr_id_extras :: Fixity -> [IfaceRule] -> SDoc
683 ppr_id_extras fix rules = ppr fix $$ vcat (map ppr rules)
685 -- This instance is used only to compute fingerprints
686 instance Binary IfaceDeclExtras where
687 get _bh = panic "no get for IfaceDeclExtras"
688 put_ bh (IfaceIdExtras fix rules) = do
689 putByte bh 1; put_ bh fix; put_ bh rules
690 put_ bh (IfaceDataExtras fix insts cons) = do
691 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
692 put_ bh (IfaceClassExtras fix insts methods) = do
693 putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
694 put_ bh (IfaceSynExtras fix) = do
695 putByte bh 4; put_ bh fix
696 put_ bh IfaceOtherDeclExtras = do
699 declExtras :: (OccName -> Fixity)
700 -> OccEnv [IfaceRule]
701 -> OccEnv [IfaceInst]
705 declExtras fix_fn rule_env inst_env decl
707 IfaceId{} -> IfaceIdExtras (fix_fn n)
708 (lookupOccEnvL rule_env n)
709 IfaceData{ifCons=cons} ->
710 IfaceDataExtras (fix_fn n)
711 (map IfaceInstABI $ lookupOccEnvL inst_env n)
712 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
713 IfaceClass{ifSigs=sigs} ->
714 IfaceClassExtras (fix_fn n)
715 (map IfaceInstABI $ lookupOccEnvL inst_env n)
716 [id_extras op | IfaceClassOp op _ _ <- sigs]
717 IfaceSyn{} -> IfaceSynExtras (fix_fn n)
718 _other -> IfaceOtherDeclExtras
721 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
724 -- When hashing an instance, we hash only its structure, not the
725 -- fingerprints of the things it mentions. See the section on instances
726 -- in the commentary,
727 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
729 newtype IfaceInstABI = IfaceInstABI IfaceInst
731 instance Binary IfaceInstABI where
732 get = panic "no get for IfaceInstABI"
733 put_ bh (IfaceInstABI inst) = do
734 let ud = getUserData bh
735 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
738 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
739 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
741 -- used when we want to fingerprint a structure without depending on the
742 -- fingerprints of external Names that it refers to.
743 putNameLiterally :: BinHandle -> Name -> IO ()
744 putNameLiterally bh name = ASSERT( isExternalName name )
745 do { put_ bh $! nameModule name
746 ; put_ bh $! nameOccName name }
748 computeFingerprint :: Binary a
750 -> (BinHandle -> Name -> IO ())
754 computeFingerprint _dflags put_name a = do
755 bh <- openBinMem (3*1024) -- just less than a block
756 ud <- newWriteState put_name putFS
757 bh <- return $ setUserData bh ud
762 -- for testing: use the md5sum command to generate fingerprints and
763 -- compare the results against our built-in version.
764 fp' <- oldMD5 dflags bh
765 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
768 oldMD5 dflags bh = do
769 tmp <- newTempName dflags "bin"
771 tmp2 <- newTempName dflags "md5"
772 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
775 ExitFailure _ -> ghcError (PhaseFailed cmd r)
777 hash_str <- readFile tmp2
778 return $! readHexFingerprint hash_str
781 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
782 instOrphWarn unqual inst
783 = mkWarnMsg (getSrcSpan inst) unqual $
784 hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
786 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
787 ruleOrphWarn unqual mod rule
788 = mkWarnMsg silly_loc unqual $
789 ptext (sLit "Orphan rule:") <+> ppr rule
791 silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
792 -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
793 -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
795 ----------------------
796 -- mkOrphMap partitions instance decls or rules into
797 -- (a) an OccEnv for ones that are not orphans,
798 -- mapping the local OccName to a list of its decls
799 -- (b) a list of orphan decls
800 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
801 -- Nothing for an orphan decl
802 -> [decl] -- Sorted into canonical order
803 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
804 -- each sublist in canonical order
805 [decl]) -- Orphan decls; in canonical order
806 mkOrphMap get_key decls
807 = foldl go (emptyOccEnv, []) decls
809 go (non_orphs, orphs) d
810 | Just occ <- get_key d
811 = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
812 | otherwise = (non_orphs, d:orphs)
816 %************************************************************************
818 Keeping track of what we've slurped, and fingerprints
820 %************************************************************************
823 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
824 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
825 = do { eps <- hscEPS hsc_env
826 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
827 dir_imp_mods used_names
828 ; usages `seqList` return usages }
829 -- seq the list of Usages returned: occasionally these
830 -- don't get evaluated for a while and we can end up hanging on to
831 -- the entire collection of Ifaces.
833 mk_usage_info :: PackageIfaceTable
839 mk_usage_info pit hsc_env this_mod direct_imports used_names
840 = mapCatMaybes mkUsage usage_mods
842 hpt = hsc_HPT hsc_env
843 dflags = hsc_dflags hsc_env
844 this_pkg = thisPackage dflags
846 used_mods = moduleEnvKeys ent_map
847 dir_imp_mods = (moduleEnvKeys direct_imports)
848 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
849 usage_mods = sortBy stableModuleCmp all_mods
850 -- canonical order is imported, to avoid interface-file
853 -- ent_map groups together all the things imported and used
854 -- from a particular module
855 ent_map :: ModuleEnv [OccName]
856 ent_map = foldNameSet add_mv emptyModuleEnv used_names
859 | isWiredInName name = mv_map -- ignore wired-in names
861 = case nameModule_maybe name of
862 Nothing -> pprPanic "mkUsageInfo: internal name?" (ppr name)
863 Just mod -> -- We use this fiddly lambda function rather than
864 -- (++) as the argument to extendModuleEnv_C to
865 -- avoid quadratic behaviour (trac #2680)
866 extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
867 where occ = nameOccName name
869 -- We want to create a Usage for a home module if
870 -- a) we used something from it; has something in used_names
871 -- b) we imported it, even if we used nothing from it
872 -- (need to recompile if its export list changes: export_fprint)
873 mkUsage :: Module -> Maybe Usage
875 | isNothing maybe_iface -- We can't depend on it if we didn't
876 -- load its interface.
877 || mod == this_mod -- We don't care about usages of
878 -- things in *this* module
881 | modulePackageId mod /= this_pkg
882 = Just UsagePackageModule{ usg_mod = mod,
883 usg_mod_hash = mod_hash }
884 -- for package modules, we record the module hash only
887 && isNothing export_hash
888 && not is_direct_import
890 = Nothing -- Record no usage info
891 -- for directly-imported modules, we always want to record a usage
892 -- on the orphan hash. This is what triggers a recompilation if
893 -- an orphan is added or removed somewhere below us in the future.
896 = Just UsageHomeModule {
897 usg_mod_name = moduleName mod,
898 usg_mod_hash = mod_hash,
899 usg_exports = export_hash,
900 usg_entities = fmToList ent_hashs }
902 maybe_iface = lookupIfaceByModule dflags hpt pit mod
903 -- In one-shot mode, the interfaces for home-package
904 -- modules accumulate in the PIT not HPT. Sigh.
906 is_direct_import = mod `elemModuleEnv` direct_imports
908 Just iface = maybe_iface
909 finsts_mod = mi_finsts iface
910 hash_env = mi_hash_fn iface
911 mod_hash = mi_mod_hash iface
912 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
913 | otherwise = Nothing
915 used_occs = lookupModuleEnv ent_map mod `orElse` []
917 -- Making a FiniteMap here ensures that (a) we remove duplicates
918 -- when we have usages on several subordinates of a single parent,
919 -- and (b) that the usages emerge in a canonical order, which
920 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
921 -- using Ord on the OccNames, which is a lexicographic ordering.
922 ent_hashs :: FiniteMap OccName Fingerprint
923 ent_hashs = listToFM (map lookup_occ used_occs)
927 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
930 depend_on_exports mod =
931 case lookupModuleEnv direct_imports mod of
933 -- Even if we used 'import M ()', we have to register a
934 -- usage on the export list because we are sensitive to
935 -- changes in orphan instances/rules.
937 -- In GHC 6.8.x the above line read "True", and in
938 -- fact it recorded a dependency on *all* the
939 -- modules underneath in the dependency tree. This
940 -- happens to make orphans work right, but is too
941 -- expensive: it'll read too many interface files.
942 -- The 'isNothing maybe_iface' check above saved us
943 -- from generating many of these usages (at least in
944 -- one-shot mode), but that's even more bogus!
948 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
949 mkIfaceAnnotations = map mkIfaceAnnotation
951 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
952 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
953 ifAnnotatedTarget = fmap nameOccName target,
954 ifAnnotatedValue = serialized
959 mkIfaceExports :: [AvailInfo]
960 -> [(Module, [GenAvailInfo OccName])]
961 -- Group by module and sort by occurrence
962 mkIfaceExports exports
963 = [ (mod, eltsFM avails)
964 | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
965 (moduleEnvToList groupFM)
966 -- NB. the fmToList is in a random order,
967 -- because Ord Module is not a predictable
968 -- ordering. Hence we perform a final sort
969 -- using the stable Module ordering.
972 -- Group by the module where the exported entities are defined
973 -- (which may not be the same for all Names in an Avail)
974 -- Deliberately use FiniteMap rather than UniqFM so we
975 -- get a canonical ordering
976 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
977 groupFM = foldl add emptyModuleEnv exports
979 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
980 -> Module -> GenAvailInfo OccName
981 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
982 add_one env mod avail
983 = extendModuleEnv_C plusFM env mod
984 (unitFM (occNameFS (availName avail)) avail)
986 -- NB: we should not get T(X) and T(Y) in the export list
987 -- else the plusFM will simply discard one! They
988 -- should have been combined by now.
990 = ASSERT( isExternalName n )
991 add_one env (nameModule n) (Avail (nameOccName n))
993 add env (AvailTC tc ns)
994 = ASSERT( all isExternalName ns )
995 foldl add_for_mod env mods
997 tc_occ = nameOccName tc
998 mods = nub (map nameModule ns)
999 -- Usually just one, but see Note [Original module]
1002 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
1003 -- NB. sort the children, we need a canonical order
1005 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
1008 Note [Orignal module]
1009 ~~~~~~~~~~~~~~~~~~~~~
1011 module X where { data family T }
1012 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
1013 The exported Avail from Y will look like
1016 - only MkT is brought into scope by the data instance;
1017 - but the parent (used for grouping and naming in T(..) exports) is X.T
1018 - and in this case we export X.T too
1020 In the result of MkIfaceExports, the names are grouped by defining module,
1021 so we may need to split up a single Avail into multiple ones.
1024 %************************************************************************
1026 Load the old interface file for this module (unless
1027 we have it aleady), and check whether it is up to date
1030 %************************************************************************
1033 checkOldIface :: HscEnv
1035 -> Bool -- Source unchanged
1036 -> Maybe ModIface -- Old interface from compilation manager, if any
1037 -> IO (RecompileRequired, Maybe ModIface)
1039 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1040 = do { showPass (hsc_dflags hsc_env)
1041 ("Checking old interface for " ++
1042 showSDoc (ppr (ms_mod mod_summary))) ;
1044 ; initIfaceCheck hsc_env $
1045 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1048 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1049 -> IfG (Bool, Maybe ModIface)
1050 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1051 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
1052 { when (not source_unchanged)
1053 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1055 -- If the source has changed and we're in interactive mode, avoid reading
1056 -- an interface; just return the one we might have been supplied with.
1057 ; let dflags = hsc_dflags hsc_env
1058 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1059 return (outOfDate, maybe_iface)
1061 case maybe_iface of {
1062 Just old_iface -> do -- Use the one we already have
1063 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1064 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1065 ; return (recomp, Just old_iface) }
1069 -- Try and read the old interface for the current module
1070 -- from the .hi file left from the last time we compiled it
1071 { let iface_path = msHiFilePath mod_summary
1072 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1073 ; case read_result of {
1074 Failed err -> do -- Old interface file not found, or garbled; give up
1075 { traceIf (text "FYI: cannot read old interface file:"
1077 ; return (outOfDate, Nothing) }
1079 ; Succeeded iface -> do
1081 -- We have got the old iface; check its versions
1082 { traceIf (text "Read the interface file" <+> text iface_path)
1083 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1084 ; return (recomp, Just iface)
1089 @recompileRequired@ is called from the HscMain. It checks whether
1090 a recompilation is required. It needs access to the persistent state,
1091 finder, etc, because it may have to load lots of interface files to
1092 check their versions.
1095 type RecompileRequired = Bool
1096 upToDate, outOfDate :: Bool
1097 upToDate = False -- Recompile not required
1098 outOfDate = True -- Recompile required
1100 checkVersions :: HscEnv
1101 -> Bool -- True <=> source unchanged
1103 -> ModIface -- Old interface
1104 -> IfG RecompileRequired
1105 checkVersions hsc_env source_unchanged mod_summary iface
1106 | not source_unchanged
1109 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1110 ppr (mi_module iface) <> colon)
1112 ; recomp <- checkDependencies hsc_env mod_summary iface
1113 ; if recomp then return outOfDate else do {
1115 -- Source code unchanged and no errors yet... carry on
1117 -- First put the dependent-module info, read from the old
1118 -- interface, into the envt, so that when we look for
1119 -- interfaces we look for the right one (.hi or .hi-boot)
1121 -- It's just temporary because either the usage check will succeed
1122 -- (in which case we are done with this module) or it'll fail (in which
1123 -- case we'll compile the module from scratch anyhow).
1125 -- We do this regardless of compilation mode, although in --make mode
1126 -- all the dependent modules should be in the HPT already, so it's
1128 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1130 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1131 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1134 -- This is a bit of a hack really
1135 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1136 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1139 -- If the direct imports of this module are resolved to targets that
1140 -- are not among the dependencies of the previous interface file,
1141 -- then we definitely need to recompile. This catches cases like
1142 -- - an exposed package has been upgraded
1143 -- - we are compiling with different package flags
1144 -- - a home module that was shadowing a package module has been removed
1145 -- - a new home module has been added that shadows a package module
1148 -- Returns True if recompilation is required.
1149 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1150 checkDependencies hsc_env summary iface
1151 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1153 prev_dep_mods = dep_mods (mi_deps iface)
1154 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1156 this_pkg = thisPackage (hsc_dflags hsc_env)
1158 orM = foldr f (return False)
1159 where f m rest = do b <- m; if b then return True else rest
1161 dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
1162 find_res <- liftIO $ findImportedModule hsc_env mod pkg
1166 -> if moduleName mod `notElem` map fst prev_dep_mods
1167 then do traceHiDiffs $
1168 text "imported module " <> quotes (ppr mod) <>
1169 text " not among previous dependencies"
1174 -> if pkg `notElem` prev_dep_pkgs
1175 then do traceHiDiffs $
1176 text "imported module " <> quotes (ppr mod) <>
1177 text " is from package " <> quotes (ppr pkg) <>
1178 text ", which is not among previous dependencies"
1182 where pkg = modulePackageId mod
1183 _otherwise -> return outOfDate
1185 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1186 -> IfG RecompileRequired
1187 needInterface mod continue
1188 = do -- Load the imported interface if possible
1189 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1190 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1192 mb_iface <- loadInterface doc_str mod ImportBySystem
1193 -- Load the interface, but don't complain on failure;
1194 -- Instead, get an Either back which we can test
1197 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1199 -- Couldn't find or parse a module mentioned in the
1200 -- old interface file. Don't complain: it might
1201 -- just be that the current module doesn't need that
1202 -- import and it's been deleted
1203 Succeeded iface -> continue iface
1206 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1207 -- Given the usage information extracted from the old
1208 -- M.hi file for the module being compiled, figure out
1209 -- whether M needs to be recompiled.
1211 checkModUsage _this_pkg UsagePackageModule{
1213 usg_mod_hash = old_mod_hash }
1214 = needInterface mod $ \iface -> do
1215 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1216 -- We only track the ABI hash of package modules, rather than
1217 -- individual entity usages, so if the ABI hash changes we must
1218 -- recompile. This is safe but may entail more recompilation when
1219 -- a dependent package has changed.
1221 checkModUsage this_pkg UsageHomeModule{
1222 usg_mod_name = mod_name,
1223 usg_mod_hash = old_mod_hash,
1224 usg_exports = maybe_old_export_hash,
1225 usg_entities = old_decl_hash }
1227 let mod = mkModule this_pkg mod_name
1228 needInterface mod $ \iface -> do
1231 new_mod_hash = mi_mod_hash iface
1232 new_decl_hash = mi_hash_fn iface
1233 new_export_hash = mi_exp_hash iface
1236 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1237 if not recompile then return upToDate else do
1239 -- CHECK EXPORT LIST
1240 checkMaybeHash maybe_old_export_hash new_export_hash
1241 (ptext (sLit " Export list changed")) $ do
1243 -- CHECK ITEMS ONE BY ONE
1244 recompile <- checkList [ checkEntityUsage new_decl_hash u
1245 | u <- old_decl_hash]
1247 then return outOfDate -- This one failed, so just bail out now
1248 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1250 ------------------------
1251 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1252 checkModuleFingerprint old_mod_hash new_mod_hash
1253 | new_mod_hash == old_mod_hash
1254 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1257 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1258 old_mod_hash new_mod_hash
1260 ------------------------
1261 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1262 -> IfG RecompileRequired -> IfG RecompileRequired
1263 checkMaybeHash maybe_old_hash new_hash doc continue
1264 | Just hash <- maybe_old_hash, hash /= new_hash
1265 = out_of_date_hash doc hash new_hash
1269 ------------------------
1270 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1271 -> (OccName, Fingerprint)
1273 checkEntityUsage new_hash (name,old_hash)
1274 = case new_hash name of
1276 Nothing -> -- We used it before, but it ain't there now
1277 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1279 Just (_, new_hash) -- It's there, but is it up to date?
1280 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1282 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1285 up_to_date, out_of_date :: SDoc -> IfG Bool
1286 up_to_date msg = traceHiDiffs msg >> return upToDate
1287 out_of_date msg = traceHiDiffs msg >> return outOfDate
1289 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1290 out_of_date_hash msg old_hash new_hash
1291 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1293 ----------------------
1294 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1295 -- This helper is used in two places
1296 checkList [] = return upToDate
1297 checkList (check:checks) = do recompile <- check
1299 then return outOfDate
1300 else checkList checks
1303 %************************************************************************
1305 Converting things to their Iface equivalents
1307 %************************************************************************
1310 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1311 -- Assumption: the thing is already tidied, so that locally-bound names
1312 -- (lambdas, for-alls) already have non-clashing OccNames
1313 -- Reason: Iface stuff uses OccNames, and the conversion here does
1314 -- not do tidying on the way
1315 tyThingToIfaceDecl (AnId id)
1316 = IfaceId { ifName = getOccName id,
1317 ifType = toIfaceType (idType id),
1318 ifIdDetails = toIfaceIdDetails (idDetails id),
1321 info = case toIfaceIdInfo (idInfo id) of
1323 items -> HasInfo items
1325 tyThingToIfaceDecl (AClass clas)
1326 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1327 ifName = getOccName clas,
1328 ifTyVars = toIfaceTvBndrs clas_tyvars,
1329 ifFDs = map toIfaceFD clas_fds,
1330 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1331 ifSigs = map toIfaceClassOp op_stuff,
1332 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1334 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1335 = classExtraBigSig clas
1336 tycon = classTyCon clas
1338 toIfaceClassOp (sel_id, def_meth)
1339 = ASSERT(sel_tyvars == clas_tyvars)
1340 IfaceClassOp (getOccName sel_id) (toDmSpec def_meth) (toIfaceType op_ty)
1342 -- Be careful when splitting the type, because of things
1343 -- like class Foo a where
1344 -- op :: (?x :: String) => a -> a
1345 -- and class Baz a where
1346 -- op :: (Ord a) => a -> a
1347 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1348 op_ty = funResultTy rho_ty
1350 toDmSpec NoDefMeth = NoDM
1351 toDmSpec GenDefMeth = GenericDM
1352 toDmSpec (DefMeth _) = VanillaDM
1354 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1356 tyThingToIfaceDecl (ATyCon tycon)
1358 = IfaceSyn { ifName = getOccName tycon,
1359 ifTyVars = toIfaceTvBndrs tyvars,
1362 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1366 = IfaceData { ifName = getOccName tycon,
1367 ifTyVars = toIfaceTvBndrs tyvars,
1368 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1369 ifCons = ifaceConDecls (algTyConRhs tycon),
1370 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1371 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1372 ifGeneric = tyConHasGenerics tycon,
1373 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1375 | isForeignTyCon tycon
1376 = IfaceForeign { ifName = getOccName tycon,
1377 ifExtName = tyConExtName tycon }
1379 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1381 tyvars = tyConTyVars tycon
1383 = case synTyConRhs tycon of
1384 SynFamilyTyCon -> (Nothing, toIfaceType (synTyConResKind tycon))
1385 SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1387 ifaceConDecls (NewTyCon { data_con = con }) =
1388 IfNewTyCon (ifaceConDecl con)
1389 ifaceConDecls (DataTyCon { data_cons = cons }) =
1390 IfDataTyCon (map ifaceConDecl cons)
1391 ifaceConDecls DataFamilyTyCon {} = IfOpenDataTyCon
1392 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1393 -- The last case happens when a TyCon has been trimmed during tidying
1394 -- Furthermore, tyThingToIfaceDecl is also used
1395 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1396 -- AbstractTyCon case is perfectly sensible.
1398 ifaceConDecl data_con
1399 = IfCon { ifConOcc = getOccName (dataConName data_con),
1400 ifConInfix = dataConIsInfix data_con,
1401 ifConWrapper = isJust (dataConWrapId_maybe data_con),
1402 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1403 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1404 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1405 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1406 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1407 ifConFields = map getOccName
1408 (dataConFieldLabels data_con),
1409 ifConStricts = dataConStrictMarks data_con }
1411 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1413 famInstToIface Nothing = Nothing
1414 famInstToIface (Just (famTyCon, instTys)) =
1415 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1417 tyThingToIfaceDecl (ADataCon dc)
1418 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1421 getFS :: NamedThing a => a -> FastString
1422 getFS x = occNameFS (getOccName x)
1424 --------------------------
1425 instanceToIfaceInst :: Instance -> IfaceInst
1426 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1427 is_cls = cls_name, is_tcs = mb_tcs })
1428 = ASSERT( cls_name == className cls )
1429 IfaceInst { ifDFun = dfun_name,
1431 ifInstCls = cls_name,
1432 ifInstTys = map do_rough mb_tcs,
1435 do_rough Nothing = Nothing
1436 do_rough (Just n) = Just (toIfaceTyCon_name n)
1438 dfun_name = idName dfun_id
1439 mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1440 is_local name = nameIsLocalOrFrom mod name
1442 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1443 (_, cls, tys) = tcSplitDFunTy (idType dfun_id)
1444 -- Slightly awkward: we need the Class to get the fundeps
1445 (tvs, fds) = classTvsFds cls
1446 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1447 orph | is_local cls_name = Just (nameOccName cls_name)
1448 | all isJust mb_ns = ASSERT( not (null mb_ns) ) head mb_ns
1449 | otherwise = Nothing
1451 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1452 -- that is not in the "determined" arguments
1453 mb_ns | null fds = [choose_one arg_names]
1454 | otherwise = map do_one fds
1455 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1456 , not (tv `elem` rtvs)]
1458 choose_one :: [NameSet] -> Maybe OccName
1459 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1461 (n : _) -> Just (nameOccName n)
1463 --------------------------
1464 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1465 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1468 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1469 , ifFamInstFam = fam
1470 , ifFamInstTys = map do_rough mb_tcs }
1472 do_rough Nothing = Nothing
1473 do_rough (Just n) = Just (toIfaceTyCon_name n)
1475 --------------------------
1476 toIfaceLetBndr :: Id -> IfaceLetBndr
1477 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1478 (toIfaceType (idType id))
1481 -- Stripped-down version of tcIfaceIdInfo
1482 -- Change this if you want to export more IdInfo for
1483 -- non-top-level Ids. Don't forget to change
1484 -- CoreTidy.tidyLetBndr too!
1486 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1488 inline_prag = inlinePragInfo id_info
1489 prag_info | isDefaultInlinePragma inline_prag = NoInfo
1490 | otherwise = HasInfo [HsInline inline_prag]
1492 --------------------------
1493 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
1494 toIfaceIdDetails VanillaId = IfVanillaId
1495 toIfaceIdDetails (DFunId {}) = IfDFunId
1496 toIfaceIdDetails (RecSelId { sel_naughty = n
1497 , sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
1498 toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
1499 IfVanillaId -- Unexpected
1501 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1502 toIfaceIdInfo id_info
1503 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1504 inline_hsinfo, unfold_hsinfo]
1505 -- NB: strictness must be before unfolding
1506 -- See TcIface.tcUnfolding
1508 ------------ Arity --------------
1509 arity_info = arityInfo id_info
1510 arity_hsinfo | arity_info == 0 = Nothing
1511 | otherwise = Just (HsArity arity_info)
1513 ------------ Caf Info --------------
1514 caf_info = cafInfo id_info
1515 caf_hsinfo = case caf_info of
1516 NoCafRefs -> Just HsNoCafRefs
1519 ------------ Strictness --------------
1520 -- No point in explicitly exporting TopSig
1521 strict_hsinfo = case strictnessInfo id_info of
1522 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1525 ------------ Unfolding --------------
1526 unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
1527 loop_breaker = isNonRuleLoopBreaker (occInfo id_info)
1529 ------------ Inline prag --------------
1530 inline_prag = inlinePragInfo id_info
1531 inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1532 | otherwise = Just (HsInline inline_prag)
1534 --------------------------
1535 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
1536 toIfUnfolding lb unf@(CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
1537 , uf_src = src, uf_guidance = guidance })
1538 = Just $ HsUnfold lb $
1542 UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok (toIfaceExpr rhs)
1543 _other -> pprPanic "toIfUnfolding" (ppr unf)
1544 InlineWrapper w -> IfWrapper arity (idName w)
1545 InlineCompulsory -> IfCompulsory (toIfaceExpr rhs)
1546 InlineRhs -> IfCoreUnfold (toIfaceExpr rhs)
1547 -- Yes, even if guidance is UnfNever, expose the unfolding
1548 -- If we didn't want to expose the unfolding, TidyPgm would
1549 -- have stuck in NoUnfolding. For supercompilation we want
1550 -- to see that unfolding!
1552 toIfUnfolding lb (DFunUnfolding _ar _con ops)
1553 = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
1554 -- No need to serialise the data constructor;
1555 -- we can recover it from the type of the dfun
1560 --------------------------
1561 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1562 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1563 = pprTrace "toHsRule: builtin" (ppr fn) $
1566 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1567 ru_act = act, ru_bndrs = bndrs,
1568 ru_args = args, ru_rhs = rhs })
1569 = IfaceRule { ifRuleName = name, ifActivation = act,
1570 ifRuleBndrs = map toIfaceBndr bndrs,
1572 ifRuleArgs = map do_arg args,
1573 ifRuleRhs = toIfaceExpr rhs,
1576 -- For type args we must remove synonyms from the outermost
1577 -- level. Reason: so that when we read it back in we'll
1578 -- construct the same ru_rough field as we have right now;
1580 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1581 do_arg arg = toIfaceExpr arg
1583 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1584 -- A rule is an orphan only if none of the variables
1585 -- mentioned on its left-hand side are locally defined
1586 lhs_names = fn : nameSetToList (exprsFreeNames args)
1587 -- No need to delete bndrs, because
1588 -- exprsFreeNames finds only External names
1590 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1591 (n : _) -> Just (nameOccName n)
1594 bogusIfaceRule :: Name -> IfaceRule
1595 bogusIfaceRule id_name
1596 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1597 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1598 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1600 ---------------------
1601 toIfaceExpr :: CoreExpr -> IfaceExpr
1602 toIfaceExpr (Var v) = toIfaceVar v
1603 toIfaceExpr (Lit l) = IfaceLit l
1604 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1605 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1606 toIfaceExpr (App f a) = toIfaceApp f [a]
1607 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1608 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1609 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1610 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1612 ---------------------
1613 toIfaceNote :: Note -> IfaceNote
1614 toIfaceNote (SCC cc) = IfaceSCC cc
1615 toIfaceNote (CoreNote s) = IfaceCoreNote s
1617 ---------------------
1618 toIfaceBind :: Bind Id -> IfaceBinding
1619 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1620 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1622 ---------------------
1623 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1624 -> (IfaceConAlt, [FastString], IfaceExpr)
1625 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1627 ---------------------
1628 toIfaceCon :: AltCon -> IfaceConAlt
1629 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1630 | otherwise = IfaceDataAlt (getName dc)
1632 tc = dataConTyCon dc
1634 toIfaceCon (LitAlt l) = IfaceLitAlt l
1635 toIfaceCon DEFAULT = IfaceDefault
1637 ---------------------
1638 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1639 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1640 toIfaceApp (Var v) as
1641 = case isDataConWorkId_maybe v of
1642 -- We convert the *worker* for tuples into IfaceTuples
1643 Just dc | isTupleTyCon tc && saturated
1644 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1646 val_args = dropWhile isTypeArg as
1647 saturated = val_args `lengthIs` idArity v
1648 tup_args = map toIfaceExpr val_args
1649 tc = dataConTyCon dc
1651 _ -> mkIfaceApps (toIfaceVar v) as
1653 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1655 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1656 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1658 ---------------------
1659 toIfaceVar :: Id -> IfaceExpr
1661 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1662 -- Foreign calls have special syntax
1663 | isExternalName name = IfaceExt name
1664 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1666 | otherwise = IfaceLcl (getFS name)