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,
167 = do { dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
168 ; return (allUses dus `unionNameSets` dfun_uses) }
170 mkDependencies :: TcGblEnv -> IO Dependencies
172 TcGblEnv{ tcg_mod = mod,
173 tcg_imports = imports,
177 th_used <- readIORef th_var -- Whether TH is used
179 dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
180 -- M.hi-boot can be in the imp_dep_mods, but we must remove
181 -- it before recording the modules on which this one depends!
182 -- (We want to retain M.hi-boot in imp_dep_mods so that
183 -- loadHiBootInterface can see if M's direct imports depend
184 -- on M.hi-boot, and hence that we should do the hi-boot consistency
187 pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
188 | otherwise = imp_dep_pkgs imports
190 return Deps { dep_mods = sortBy (stableModuleNameCmp `on` fst) dep_mods,
191 dep_pkgs = sortBy stablePackageIdCmp pkgs,
192 dep_orphs = sortBy stableModuleCmp (imp_orphs imports),
193 dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
194 -- sort to get into canonical order
195 -- NB. remember to use lexicographic ordering
197 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
198 -> NameSet -> Dependencies -> GlobalRdrEnv
199 -> NameEnv FixItem -> Warnings -> HpcInfo
202 -> IO (Messages, Maybe (ModIface, Bool))
203 mkIface_ hsc_env maybe_old_fingerprint
204 this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
206 ModDetails{ md_insts = insts,
207 md_fam_insts = fam_insts,
210 md_vect_info = vect_info,
212 md_exports = exports }
213 -- NB: notice that mkIface does not look at the bindings
214 -- only at the TypeEnv. The previous Tidy phase has
215 -- put exactly the info into the TypeEnv that we want
216 -- to expose in the interface
218 = do { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
220 ; let { entities = typeEnvElts type_env ;
221 decls = [ tyThingToIfaceDecl entity
222 | entity <- entities,
223 let name = getName entity,
224 not (isImplicitTyThing entity),
225 -- No implicit Ids and class tycons in the interface file
226 not (isWiredInName name),
227 -- Nor wired-in things; the compiler knows about them anyhow
228 nameIsLocalOrFrom this_mod name ]
229 -- Sigh: see Note [Root-main Id] in TcRnDriver
231 ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
233 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
234 ; iface_insts = map instanceToIfaceInst insts
235 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
236 ; iface_vect_info = flattenVectInfo vect_info
238 ; intermediate_iface = ModIface {
239 mi_module = this_mod,
243 mi_exports = mkIfaceExports exports,
245 -- Sort these lexicographically, so that
246 -- the result is stable across compilations
247 mi_insts = sortLe le_inst iface_insts,
248 mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
249 mi_rules = sortLe le_rule iface_rules,
251 mi_vect_info = iface_vect_info,
253 mi_fixities = fixities,
255 mi_anns = mkIfaceAnnotations anns,
256 mi_globals = Just rdr_env,
258 -- Left out deliberately: filled in by addVersionInfo
259 mi_iface_hash = fingerprint0,
260 mi_mod_hash = fingerprint0,
261 mi_exp_hash = fingerprint0,
262 mi_orphan_hash = fingerprint0,
263 mi_orphan = False, -- Always set by addVersionInfo, but
264 -- it's a strict field, so we can't omit it.
265 mi_finsts = False, -- Ditto
266 mi_decls = deliberatelyOmitted "decls",
267 mi_hash_fn = deliberatelyOmitted "hash_fn",
268 mi_hpc = isHpcUsed hpc_info,
270 -- And build the cached values
271 mi_warn_fn = mkIfaceWarnCache warns,
272 mi_fix_fn = mkIfaceFixCache fixities }
275 ; (new_iface, no_change_at_all)
276 <- {-# SCC "versioninfo" #-}
277 addFingerprints hsc_env maybe_old_fingerprint
278 intermediate_iface decls
280 -- Warn about orphans
281 ; let orph_warnings --- Laziness means no work done unless -fwarn-orphans
282 | dopt Opt_WarnOrphans dflags = rule_warns `unionBags` inst_warns
283 | otherwise = emptyBag
284 errs_and_warns = (orph_warnings, emptyBag)
285 unqual = mkPrintUnqualified dflags rdr_env
286 inst_warns = listToBag [ instOrphWarn unqual d
287 | (d,i) <- insts `zip` iface_insts
288 , isNothing (ifInstOrph i) ]
289 rule_warns = listToBag [ ruleOrphWarn unqual this_mod r
291 , isNothing (ifRuleOrph r) ]
293 ; if errorsFound dflags errs_and_warns
294 then return ( errs_and_warns, Nothing )
297 -- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
300 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
301 (pprModIface new_iface)
303 -- bug #1617: on reload we weren't updating the PrintUnqualified
304 -- correctly. This stems from the fact that the interface had
305 -- not changed, so addVersionInfo returns the old ModIface
306 -- with the old GlobalRdrEnv (mi_globals).
307 ; let final_iface = new_iface{ mi_globals = Just rdr_env }
309 ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
311 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
312 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
313 i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
315 le_occ :: Name -> Name -> Bool
316 -- Compare lexicographically by OccName, *not* by unique, because
317 -- the latter is not stable across compilations
318 le_occ n1 n2 = nameOccName n1 <= nameOccName n2
320 dflags = hsc_dflags hsc_env
321 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
322 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
324 flattenVectInfo (VectInfo { vectInfoVar = vVar
325 , vectInfoTyCon = vTyCon
328 ifaceVectInfoVar = [ Var.varName v
329 | (v, _) <- varEnvElts vVar],
330 ifaceVectInfoTyCon = [ tyConName t
331 | (t, t_v) <- nameEnvElts vTyCon
333 ifaceVectInfoTyConReuse = [ tyConName t
334 | (t, t_v) <- nameEnvElts vTyCon
338 -----------------------------
339 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
340 writeIfaceFile dflags location new_iface
341 = do createDirectoryHierarchy (takeDirectory hi_file_path)
342 writeBinIface dflags hi_file_path new_iface
343 where hi_file_path = ml_hi_file location
346 -- -----------------------------------------------------------------------------
347 -- Look up parents and versions of Names
349 -- This is like a global version of the mi_hash_fn field in each ModIface.
350 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
351 -- the parent and version info.
354 :: HscEnv -- needed to look up versions
355 -> ExternalPackageState -- ditto
356 -> (Name -> Fingerprint)
357 mkHashFun hsc_env eps
360 mod = ASSERT2( isExternalName name, ppr name ) nameModule name
361 occ = nameOccName name
362 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
363 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
365 snd (mi_hash_fn iface occ `orElse`
366 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
368 hpt = hsc_HPT hsc_env
371 -- ---------------------------------------------------------------------------
372 -- Compute fingerprints for the interface
376 -> Maybe Fingerprint -- the old fingerprint, if any
377 -> ModIface -- The new interface (lacking decls)
378 -> [IfaceDecl] -- The new decls
379 -> IO (ModIface, -- Updated interface
380 Bool) -- True <=> no changes at all;
381 -- no need to write Iface
383 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
385 eps <- hscEPS hsc_env
387 -- The ABI of a declaration represents everything that is made
388 -- visible about the declaration that a client can depend on.
389 -- see IfaceDeclABI below.
390 declABI :: IfaceDecl -> IfaceDeclABI
391 declABI decl = (this_mod, decl, extras)
392 where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
394 edges :: [(IfaceDeclABI, Unique, [Unique])]
395 edges = [ (abi, getUnique (ifName decl), out)
397 , let abi = declABI decl
398 , let out = localOccs $ freeNamesDeclABI abi
401 name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
402 localOccs = map (getUnique . getParent . getOccName)
403 . filter ((== this_mod) . name_module)
405 where getParent occ = lookupOccEnv parent_map occ `orElse` occ
407 -- maps OccNames to their parents in the current module.
408 -- e.g. a reference to a constructor must be turned into a reference
409 -- to the TyCon for the purposes of calculating dependencies.
410 parent_map :: OccEnv OccName
411 parent_map = foldr extend emptyOccEnv new_decls
413 extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
416 -- strongly-connected groups of declarations, in dependency order
417 groups = stronglyConnCompFromEdgedVertices edges
419 global_hash_fn = mkHashFun hsc_env eps
421 -- how to output Names when generating the data to fingerprint.
422 -- Here we want to output the fingerprint for each top-level
423 -- Name, whether it comes from the current module or another
424 -- module. In this way, the fingerprint for a declaration will
425 -- change if the fingerprint for anything it refers to (transitively)
427 mk_put_name :: (OccEnv (OccName,Fingerprint))
428 -> BinHandle -> Name -> IO ()
429 mk_put_name local_env bh name
430 | isWiredInName name = putNameLiterally bh name
431 -- wired-in names don't have fingerprints
433 = ASSERT( isExternalName name )
434 let hash | nameModule name /= this_mod = global_hash_fn name
436 snd (lookupOccEnv local_env (getOccName name)
437 `orElse` pprPanic "urk! lookup local fingerprint"
438 (ppr name)) -- (undefined,fingerprint0))
439 -- This panic indicates that we got the dependency
440 -- analysis wrong, because we needed a fingerprint for
441 -- an entity that wasn't in the environment. To debug
442 -- it, turn the panic into a trace, uncomment the
443 -- pprTraces below, run the compile again, and inspect
444 -- the output and the generated .hi file with
449 -- take a strongly-connected group of declarations and compute
452 fingerprint_group :: (OccEnv (OccName,Fingerprint),
453 [(Fingerprint,IfaceDecl)])
455 -> IO (OccEnv (OccName,Fingerprint),
456 [(Fingerprint,IfaceDecl)])
458 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
459 = do let hash_fn = mk_put_name local_env
461 -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
462 hash <- computeFingerprint dflags hash_fn abi
463 return (extend_hash_env (hash,decl) local_env,
464 (hash,decl) : decls_w_hashes)
466 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
467 = do let decls = map abiDecl abis
468 local_env' = foldr extend_hash_env local_env
469 (zip (repeat fingerprint0) decls)
470 hash_fn = mk_put_name local_env'
471 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
472 let stable_abis = sortBy cmp_abiNames abis
473 -- put the cycle in a canonical order
474 hash <- computeFingerprint dflags hash_fn stable_abis
475 let pairs = zip (repeat hash) decls
476 return (foldr extend_hash_env local_env pairs,
477 pairs ++ decls_w_hashes)
479 extend_hash_env :: (Fingerprint,IfaceDecl)
480 -> OccEnv (OccName,Fingerprint)
481 -> OccEnv (OccName,Fingerprint)
482 extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
485 item = (decl_name, hash)
486 env1 = extendOccEnv env0 decl_name item
487 add_imp bndr env = extendOccEnv env bndr item
490 (local_env, decls_w_hashes) <-
491 foldM fingerprint_group (emptyOccEnv, []) groups
493 -- when calculating fingerprints, we always need to use canonical
494 -- ordering for lists of things. In particular, the mi_deps has various
495 -- lists of modules and suchlike, so put these all in canonical order:
496 let sorted_deps = sortDependencies (mi_deps iface0)
498 -- the export hash of a module depends on the orphan hashes of the
499 -- orphan modules below us in the dependency tree. This is the way
500 -- that changes in orphans get propagated all the way up the
501 -- dependency tree. We only care about orphan modules in the current
502 -- package, because changes to orphans outside this package will be
503 -- tracked by the usage on the ABI hash of package modules that we import.
504 let orph_mods = filter ((== this_pkg) . modulePackageId)
505 $ dep_orphs sorted_deps
506 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
508 orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
509 (map IfaceInstABI orph_insts, orph_rules, fam_insts)
511 -- the export list hash doesn't depend on the fingerprints of
512 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
513 export_hash <- computeFingerprint dflags putNameLiterally
517 dep_pkgs (mi_deps iface0))
518 -- dep_pkgs: see "Package Version Changes" on
519 -- wiki/Commentary/Compiler/RecompilationAvoidance
521 -- put the declarations in a canonical order, sorted by OccName
522 let sorted_decls = eltsFM $ listToFM $
523 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
525 -- the ABI hash depends on:
531 mod_hash <- computeFingerprint dflags putNameLiterally
532 (map fst sorted_decls,
537 -- The interface hash depends on:
538 -- - the ABI hash, plus
542 iface_hash <- computeFingerprint dflags putNameLiterally
549 no_change_at_all = Just iface_hash == mb_old_fingerprint
551 final_iface = iface0 {
552 mi_mod_hash = mod_hash,
553 mi_iface_hash = iface_hash,
554 mi_exp_hash = export_hash,
555 mi_orphan_hash = orphan_hash,
556 mi_orphan = not (null orph_rules && null orph_insts),
557 mi_finsts = not . null $ mi_fam_insts iface0,
558 mi_decls = sorted_decls,
559 mi_hash_fn = lookupOccEnv local_env }
561 return (final_iface, no_change_at_all)
564 this_mod = mi_module iface0
565 dflags = hsc_dflags hsc_env
566 this_pkg = thisPackage dflags
567 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
568 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
569 -- ToDo: shouldn't we be splitting fam_insts into orphans and
571 fam_insts = mi_fam_insts iface0
572 fix_fn = mi_fix_fn iface0
575 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
576 getOrphanHashes hsc_env mods = do
577 eps <- hscEPS hsc_env
579 hpt = hsc_HPT hsc_env
581 dflags = hsc_dflags hsc_env
583 case lookupIfaceByModule dflags hpt pit mod of
584 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
585 Just iface -> mi_orphan_hash iface
587 return (map get_orph_hash mods)
590 sortDependencies :: Dependencies -> Dependencies
592 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
593 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
594 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
595 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
599 %************************************************************************
601 The ABI of an IfaceDecl
603 %************************************************************************
605 Note [The ABI of an IfaceDecl]
606 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
607 The ABI of a declaration consists of:
609 (a) the full name of the identifier (inc. module and package,
610 because these are used to construct the symbol name by which
611 the identifier is known externally).
613 (b) the declaration itself, as exposed to clients. That is, the
614 definition of an Id is included in the fingerprint only if
615 it is made available as as unfolding in the interface.
617 (c) the fixity of the identifier
619 (e) for classes: instances, fixity & rules for methods
620 (f) for datatypes: instances, fixity & rules for constrs
622 Items (c)-(f) are not stored in the IfaceDecl, but instead appear
623 elsewhere in the interface file. But they are *fingerprinted* with
624 the Id itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
625 and fingerprinting that as part of the Id.
628 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
631 = IfaceIdExtras Fixity [IfaceRule]
632 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
633 | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
634 | IfaceSynExtras Fixity
635 | IfaceOtherDeclExtras
637 abiDecl :: IfaceDeclABI -> IfaceDecl
638 abiDecl (_, decl, _) = decl
640 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
641 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
642 ifName (abiDecl abi2)
644 freeNamesDeclABI :: IfaceDeclABI -> NameSet
645 freeNamesDeclABI (_mod, decl, extras) =
646 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
648 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
649 freeNamesDeclExtras (IfaceIdExtras _ rules)
650 = unionManyNameSets (map freeNamesIfRule rules)
651 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
652 = unionManyNameSets (map freeNamesSub subs)
653 freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
654 = unionManyNameSets (map freeNamesSub subs)
655 freeNamesDeclExtras (IfaceSynExtras _)
657 freeNamesDeclExtras IfaceOtherDeclExtras
660 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
661 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
663 instance Outputable IfaceDeclExtras where
664 ppr IfaceOtherDeclExtras = empty
665 ppr (IfaceIdExtras fix rules) = ppr_id_extras fix rules
666 ppr (IfaceSynExtras fix) = ppr fix
667 ppr (IfaceDataExtras fix insts stuff) = vcat [ppr fix, ppr_insts insts,
668 ppr_id_extras_s stuff]
669 ppr (IfaceClassExtras fix insts stuff) = vcat [ppr fix, ppr_insts insts,
670 ppr_id_extras_s stuff]
672 ppr_insts :: [IfaceInstABI] -> SDoc
673 ppr_insts _ = ptext (sLit "<insts>")
675 ppr_id_extras_s :: [(Fixity, [IfaceRule])] -> SDoc
676 ppr_id_extras_s stuff = vcat [ppr_id_extras f r | (f,r)<- stuff]
678 ppr_id_extras :: Fixity -> [IfaceRule] -> SDoc
679 ppr_id_extras fix rules = ppr fix $$ vcat (map ppr rules)
681 -- This instance is used only to compute fingerprints
682 instance Binary IfaceDeclExtras where
683 get _bh = panic "no get for IfaceDeclExtras"
684 put_ bh (IfaceIdExtras fix rules) = do
685 putByte bh 1; put_ bh fix; put_ bh rules
686 put_ bh (IfaceDataExtras fix insts cons) = do
687 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
688 put_ bh (IfaceClassExtras fix insts methods) = do
689 putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
690 put_ bh (IfaceSynExtras fix) = do
691 putByte bh 4; put_ bh fix
692 put_ bh IfaceOtherDeclExtras = do
695 declExtras :: (OccName -> Fixity)
696 -> OccEnv [IfaceRule]
697 -> OccEnv [IfaceInst]
701 declExtras fix_fn rule_env inst_env decl
703 IfaceId{} -> IfaceIdExtras (fix_fn n)
704 (lookupOccEnvL rule_env n)
705 IfaceData{ifCons=cons} ->
706 IfaceDataExtras (fix_fn n)
707 (map IfaceInstABI $ lookupOccEnvL inst_env n)
708 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
709 IfaceClass{ifSigs=sigs} ->
710 IfaceClassExtras (fix_fn n)
711 (map IfaceInstABI $ lookupOccEnvL inst_env n)
712 [id_extras op | IfaceClassOp op _ _ <- sigs]
713 IfaceSyn{} -> IfaceSynExtras (fix_fn n)
714 _other -> IfaceOtherDeclExtras
717 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
720 -- When hashing an instance, we hash only its structure, not the
721 -- fingerprints of the things it mentions. See the section on instances
722 -- in the commentary,
723 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
725 newtype IfaceInstABI = IfaceInstABI IfaceInst
727 instance Binary IfaceInstABI where
728 get = panic "no get for IfaceInstABI"
729 put_ bh (IfaceInstABI inst) = do
730 let ud = getUserData bh
731 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
734 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
735 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
737 -- used when we want to fingerprint a structure without depending on the
738 -- fingerprints of external Names that it refers to.
739 putNameLiterally :: BinHandle -> Name -> IO ()
740 putNameLiterally bh name = ASSERT( isExternalName name )
741 do { put_ bh $! nameModule name
742 ; put_ bh $! nameOccName name }
744 computeFingerprint :: Binary a
746 -> (BinHandle -> Name -> IO ())
750 computeFingerprint _dflags put_name a = do
751 bh <- openBinMem (3*1024) -- just less than a block
752 ud <- newWriteState put_name putFS
753 bh <- return $ setUserData bh ud
758 -- for testing: use the md5sum command to generate fingerprints and
759 -- compare the results against our built-in version.
760 fp' <- oldMD5 dflags bh
761 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
764 oldMD5 dflags bh = do
765 tmp <- newTempName dflags "bin"
767 tmp2 <- newTempName dflags "md5"
768 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
771 ExitFailure _ -> ghcError (PhaseFailed cmd r)
773 hash_str <- readFile tmp2
774 return $! readHexFingerprint hash_str
777 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
778 instOrphWarn unqual inst
779 = mkWarnMsg (getSrcSpan inst) unqual $
780 hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
782 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
783 ruleOrphWarn unqual mod rule
784 = mkWarnMsg silly_loc unqual $
785 ptext (sLit "Orphan rule:") <+> ppr rule
787 silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
788 -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
789 -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
791 ----------------------
792 -- mkOrphMap partitions instance decls or rules into
793 -- (a) an OccEnv for ones that are not orphans,
794 -- mapping the local OccName to a list of its decls
795 -- (b) a list of orphan decls
796 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
797 -- Nothing for an orphan decl
798 -> [decl] -- Sorted into canonical order
799 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
800 -- each sublist in canonical order
801 [decl]) -- Orphan decls; in canonical order
802 mkOrphMap get_key decls
803 = foldl go (emptyOccEnv, []) decls
805 go (non_orphs, orphs) d
806 | Just occ <- get_key d
807 = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
808 | otherwise = (non_orphs, d:orphs)
812 %************************************************************************
814 Keeping track of what we've slurped, and fingerprints
816 %************************************************************************
819 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
820 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
821 = do { eps <- hscEPS hsc_env
822 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
823 dir_imp_mods used_names
824 ; usages `seqList` return usages }
825 -- seq the list of Usages returned: occasionally these
826 -- don't get evaluated for a while and we can end up hanging on to
827 -- the entire collection of Ifaces.
829 mk_usage_info :: PackageIfaceTable
835 mk_usage_info pit hsc_env this_mod direct_imports used_names
836 = mapCatMaybes mkUsage usage_mods
838 hpt = hsc_HPT hsc_env
839 dflags = hsc_dflags hsc_env
840 this_pkg = thisPackage dflags
842 used_mods = moduleEnvKeys ent_map
843 dir_imp_mods = (moduleEnvKeys direct_imports)
844 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
845 usage_mods = sortBy stableModuleCmp all_mods
846 -- canonical order is imported, to avoid interface-file
849 -- ent_map groups together all the things imported and used
850 -- from a particular module
851 ent_map :: ModuleEnv [OccName]
852 ent_map = foldNameSet add_mv emptyModuleEnv used_names
855 | isWiredInName name = mv_map -- ignore wired-in names
857 = case nameModule_maybe name of
858 Nothing -> pprPanic "mkUsageInfo: internal name?" (ppr name)
859 Just mod -> -- We use this fiddly lambda function rather than
860 -- (++) as the argument to extendModuleEnv_C to
861 -- avoid quadratic behaviour (trac #2680)
862 extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
863 where occ = nameOccName name
865 -- We want to create a Usage for a home module if
866 -- a) we used something from it; has something in used_names
867 -- b) we imported it, even if we used nothing from it
868 -- (need to recompile if its export list changes: export_fprint)
869 mkUsage :: Module -> Maybe Usage
871 | isNothing maybe_iface -- We can't depend on it if we didn't
872 -- load its interface.
873 || mod == this_mod -- We don't care about usages of
874 -- things in *this* module
877 | modulePackageId mod /= this_pkg
878 = Just UsagePackageModule{ usg_mod = mod,
879 usg_mod_hash = mod_hash }
880 -- for package modules, we record the module hash only
883 && isNothing export_hash
884 && not is_direct_import
886 = Nothing -- Record no usage info
887 -- for directly-imported modules, we always want to record a usage
888 -- on the orphan hash. This is what triggers a recompilation if
889 -- an orphan is added or removed somewhere below us in the future.
892 = Just UsageHomeModule {
893 usg_mod_name = moduleName mod,
894 usg_mod_hash = mod_hash,
895 usg_exports = export_hash,
896 usg_entities = fmToList ent_hashs }
898 maybe_iface = lookupIfaceByModule dflags hpt pit mod
899 -- In one-shot mode, the interfaces for home-package
900 -- modules accumulate in the PIT not HPT. Sigh.
902 is_direct_import = mod `elemModuleEnv` direct_imports
904 Just iface = maybe_iface
905 finsts_mod = mi_finsts iface
906 hash_env = mi_hash_fn iface
907 mod_hash = mi_mod_hash iface
908 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
909 | otherwise = Nothing
911 used_occs = lookupModuleEnv ent_map mod `orElse` []
913 -- Making a FiniteMap here ensures that (a) we remove duplicates
914 -- when we have usages on several subordinates of a single parent,
915 -- and (b) that the usages emerge in a canonical order, which
916 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
917 -- using Ord on the OccNames, which is a lexicographic ordering.
918 ent_hashs :: FiniteMap OccName Fingerprint
919 ent_hashs = listToFM (map lookup_occ used_occs)
923 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
926 depend_on_exports mod =
927 case lookupModuleEnv direct_imports mod of
929 -- Even if we used 'import M ()', we have to register a
930 -- usage on the export list because we are sensitive to
931 -- changes in orphan instances/rules.
933 -- In GHC 6.8.x the above line read "True", and in
934 -- fact it recorded a dependency on *all* the
935 -- modules underneath in the dependency tree. This
936 -- happens to make orphans work right, but is too
937 -- expensive: it'll read too many interface files.
938 -- The 'isNothing maybe_iface' check above saved us
939 -- from generating many of these usages (at least in
940 -- one-shot mode), but that's even more bogus!
944 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
945 mkIfaceAnnotations = map mkIfaceAnnotation
947 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
948 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
949 ifAnnotatedTarget = fmap nameOccName target,
950 ifAnnotatedValue = serialized
955 mkIfaceExports :: [AvailInfo]
956 -> [(Module, [GenAvailInfo OccName])]
957 -- Group by module and sort by occurrence
958 mkIfaceExports exports
959 = [ (mod, eltsFM avails)
960 | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
961 (moduleEnvToList groupFM)
962 -- NB. the fmToList is in a random order,
963 -- because Ord Module is not a predictable
964 -- ordering. Hence we perform a final sort
965 -- using the stable Module ordering.
968 -- Group by the module where the exported entities are defined
969 -- (which may not be the same for all Names in an Avail)
970 -- Deliberately use FiniteMap rather than UniqFM so we
971 -- get a canonical ordering
972 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
973 groupFM = foldl add emptyModuleEnv exports
975 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
976 -> Module -> GenAvailInfo OccName
977 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
978 add_one env mod avail
979 = extendModuleEnv_C plusFM env mod
980 (unitFM (occNameFS (availName avail)) avail)
982 -- NB: we should not get T(X) and T(Y) in the export list
983 -- else the plusFM will simply discard one! They
984 -- should have been combined by now.
986 = ASSERT( isExternalName n )
987 add_one env (nameModule n) (Avail (nameOccName n))
989 add env (AvailTC tc ns)
990 = ASSERT( all isExternalName ns )
991 foldl add_for_mod env mods
993 tc_occ = nameOccName tc
994 mods = nub (map nameModule ns)
995 -- Usually just one, but see Note [Original module]
998 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
999 -- NB. sort the children, we need a canonical order
1001 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
1004 Note [Orignal module]
1005 ~~~~~~~~~~~~~~~~~~~~~
1007 module X where { data family T }
1008 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
1009 The exported Avail from Y will look like
1012 - only MkT is brought into scope by the data instance;
1013 - but the parent (used for grouping and naming in T(..) exports) is X.T
1014 - and in this case we export X.T too
1016 In the result of MkIfaceExports, the names are grouped by defining module,
1017 so we may need to split up a single Avail into multiple ones.
1020 %************************************************************************
1022 Load the old interface file for this module (unless
1023 we have it aleady), and check whether it is up to date
1026 %************************************************************************
1029 checkOldIface :: HscEnv
1031 -> Bool -- Source unchanged
1032 -> Maybe ModIface -- Old interface from compilation manager, if any
1033 -> IO (RecompileRequired, Maybe ModIface)
1035 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1036 = do { showPass (hsc_dflags hsc_env)
1037 ("Checking old interface for " ++
1038 showSDoc (ppr (ms_mod mod_summary))) ;
1040 ; initIfaceCheck hsc_env $
1041 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1044 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1045 -> IfG (Bool, Maybe ModIface)
1046 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1047 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
1048 { when (not source_unchanged)
1049 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1051 -- If the source has changed and we're in interactive mode, avoid reading
1052 -- an interface; just return the one we might have been supplied with.
1053 ; let dflags = hsc_dflags hsc_env
1054 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1055 return (outOfDate, maybe_iface)
1057 case maybe_iface of {
1058 Just old_iface -> do -- Use the one we already have
1059 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1060 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1061 ; return (recomp, Just old_iface) }
1065 -- Try and read the old interface for the current module
1066 -- from the .hi file left from the last time we compiled it
1067 { let iface_path = msHiFilePath mod_summary
1068 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1069 ; case read_result of {
1070 Failed err -> do -- Old interface file not found, or garbled; give up
1071 { traceIf (text "FYI: cannot read old interface file:"
1073 ; return (outOfDate, Nothing) }
1075 ; Succeeded iface -> do
1077 -- We have got the old iface; check its versions
1078 { traceIf (text "Read the interface file" <+> text iface_path)
1079 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1080 ; return (recomp, Just iface)
1085 @recompileRequired@ is called from the HscMain. It checks whether
1086 a recompilation is required. It needs access to the persistent state,
1087 finder, etc, because it may have to load lots of interface files to
1088 check their versions.
1091 type RecompileRequired = Bool
1092 upToDate, outOfDate :: Bool
1093 upToDate = False -- Recompile not required
1094 outOfDate = True -- Recompile required
1096 checkVersions :: HscEnv
1097 -> Bool -- True <=> source unchanged
1099 -> ModIface -- Old interface
1100 -> IfG RecompileRequired
1101 checkVersions hsc_env source_unchanged mod_summary iface
1102 | not source_unchanged
1105 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1106 ppr (mi_module iface) <> colon)
1108 ; recomp <- checkDependencies hsc_env mod_summary iface
1109 ; if recomp then return outOfDate else do {
1111 -- Source code unchanged and no errors yet... carry on
1113 -- First put the dependent-module info, read from the old
1114 -- interface, into the envt, so that when we look for
1115 -- interfaces we look for the right one (.hi or .hi-boot)
1117 -- It's just temporary because either the usage check will succeed
1118 -- (in which case we are done with this module) or it'll fail (in which
1119 -- case we'll compile the module from scratch anyhow).
1121 -- We do this regardless of compilation mode, although in --make mode
1122 -- all the dependent modules should be in the HPT already, so it's
1124 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1126 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1127 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1130 -- This is a bit of a hack really
1131 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1132 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1135 -- If the direct imports of this module are resolved to targets that
1136 -- are not among the dependencies of the previous interface file,
1137 -- then we definitely need to recompile. This catches cases like
1138 -- - an exposed package has been upgraded
1139 -- - we are compiling with different package flags
1140 -- - a home module that was shadowing a package module has been removed
1141 -- - a new home module has been added that shadows a package module
1144 -- Returns True if recompilation is required.
1145 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1146 checkDependencies hsc_env summary iface
1147 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1149 prev_dep_mods = dep_mods (mi_deps iface)
1150 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1152 this_pkg = thisPackage (hsc_dflags hsc_env)
1154 orM = foldr f (return False)
1155 where f m rest = do b <- m; if b then return True else rest
1157 dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
1158 find_res <- liftIO $ findImportedModule hsc_env mod pkg
1162 -> if moduleName mod `notElem` map fst prev_dep_mods
1163 then do traceHiDiffs $
1164 text "imported module " <> quotes (ppr mod) <>
1165 text " not among previous dependencies"
1170 -> if pkg `notElem` prev_dep_pkgs
1171 then do traceHiDiffs $
1172 text "imported module " <> quotes (ppr mod) <>
1173 text " is from package " <> quotes (ppr pkg) <>
1174 text ", which is not among previous dependencies"
1178 where pkg = modulePackageId mod
1179 _otherwise -> return outOfDate
1181 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1182 -> IfG RecompileRequired
1183 needInterface mod continue
1184 = do -- Load the imported interface if possible
1185 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1186 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1188 mb_iface <- loadInterface doc_str mod ImportBySystem
1189 -- Load the interface, but don't complain on failure;
1190 -- Instead, get an Either back which we can test
1193 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1195 -- Couldn't find or parse a module mentioned in the
1196 -- old interface file. Don't complain: it might
1197 -- just be that the current module doesn't need that
1198 -- import and it's been deleted
1199 Succeeded iface -> continue iface
1202 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1203 -- Given the usage information extracted from the old
1204 -- M.hi file for the module being compiled, figure out
1205 -- whether M needs to be recompiled.
1207 checkModUsage _this_pkg UsagePackageModule{
1209 usg_mod_hash = old_mod_hash }
1210 = needInterface mod $ \iface -> do
1211 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1212 -- We only track the ABI hash of package modules, rather than
1213 -- individual entity usages, so if the ABI hash changes we must
1214 -- recompile. This is safe but may entail more recompilation when
1215 -- a dependent package has changed.
1217 checkModUsage this_pkg UsageHomeModule{
1218 usg_mod_name = mod_name,
1219 usg_mod_hash = old_mod_hash,
1220 usg_exports = maybe_old_export_hash,
1221 usg_entities = old_decl_hash }
1223 let mod = mkModule this_pkg mod_name
1224 needInterface mod $ \iface -> do
1227 new_mod_hash = mi_mod_hash iface
1228 new_decl_hash = mi_hash_fn iface
1229 new_export_hash = mi_exp_hash iface
1232 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1233 if not recompile then return upToDate else do
1235 -- CHECK EXPORT LIST
1236 checkMaybeHash maybe_old_export_hash new_export_hash
1237 (ptext (sLit " Export list changed")) $ do
1239 -- CHECK ITEMS ONE BY ONE
1240 recompile <- checkList [ checkEntityUsage new_decl_hash u
1241 | u <- old_decl_hash]
1243 then return outOfDate -- This one failed, so just bail out now
1244 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1246 ------------------------
1247 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1248 checkModuleFingerprint old_mod_hash new_mod_hash
1249 | new_mod_hash == old_mod_hash
1250 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1253 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1254 old_mod_hash new_mod_hash
1256 ------------------------
1257 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1258 -> IfG RecompileRequired -> IfG RecompileRequired
1259 checkMaybeHash maybe_old_hash new_hash doc continue
1260 | Just hash <- maybe_old_hash, hash /= new_hash
1261 = out_of_date_hash doc hash new_hash
1265 ------------------------
1266 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1267 -> (OccName, Fingerprint)
1269 checkEntityUsage new_hash (name,old_hash)
1270 = case new_hash name of
1272 Nothing -> -- We used it before, but it ain't there now
1273 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1275 Just (_, new_hash) -- It's there, but is it up to date?
1276 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1278 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1281 up_to_date, out_of_date :: SDoc -> IfG Bool
1282 up_to_date msg = traceHiDiffs msg >> return upToDate
1283 out_of_date msg = traceHiDiffs msg >> return outOfDate
1285 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1286 out_of_date_hash msg old_hash new_hash
1287 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1289 ----------------------
1290 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1291 -- This helper is used in two places
1292 checkList [] = return upToDate
1293 checkList (check:checks) = do recompile <- check
1295 then return outOfDate
1296 else checkList checks
1299 %************************************************************************
1301 Converting things to their Iface equivalents
1303 %************************************************************************
1306 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1307 -- Assumption: the thing is already tidied, so that locally-bound names
1308 -- (lambdas, for-alls) already have non-clashing OccNames
1309 -- Reason: Iface stuff uses OccNames, and the conversion here does
1310 -- not do tidying on the way
1311 tyThingToIfaceDecl (AnId id)
1312 = IfaceId { ifName = getOccName id,
1313 ifType = toIfaceType (idType id),
1314 ifIdDetails = toIfaceIdDetails (idDetails id),
1317 info = case toIfaceIdInfo (idInfo id) of
1319 items -> HasInfo items
1321 tyThingToIfaceDecl (AClass clas)
1322 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1323 ifName = getOccName clas,
1324 ifTyVars = toIfaceTvBndrs clas_tyvars,
1325 ifFDs = map toIfaceFD clas_fds,
1326 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1327 ifSigs = map toIfaceClassOp op_stuff,
1328 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1330 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1331 = classExtraBigSig clas
1332 tycon = classTyCon clas
1334 toIfaceClassOp (sel_id, def_meth)
1335 = ASSERT(sel_tyvars == clas_tyvars)
1336 IfaceClassOp (getOccName sel_id) (toDmSpec def_meth) (toIfaceType op_ty)
1338 -- Be careful when splitting the type, because of things
1339 -- like class Foo a where
1340 -- op :: (?x :: String) => a -> a
1341 -- and class Baz a where
1342 -- op :: (Ord a) => a -> a
1343 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1344 op_ty = funResultTy rho_ty
1346 toDmSpec NoDefMeth = NoDM
1347 toDmSpec GenDefMeth = GenericDM
1348 toDmSpec (DefMeth _) = VanillaDM
1350 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1352 tyThingToIfaceDecl (ATyCon tycon)
1354 = IfaceSyn { ifName = getOccName tycon,
1355 ifTyVars = toIfaceTvBndrs tyvars,
1358 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1362 = IfaceData { ifName = getOccName tycon,
1363 ifTyVars = toIfaceTvBndrs tyvars,
1364 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1365 ifCons = ifaceConDecls (algTyConRhs tycon),
1366 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1367 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1368 ifGeneric = tyConHasGenerics tycon,
1369 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1371 | isForeignTyCon tycon
1372 = IfaceForeign { ifName = getOccName tycon,
1373 ifExtName = tyConExtName tycon }
1375 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1377 tyvars = tyConTyVars tycon
1379 = case synTyConRhs tycon of
1380 OpenSynTyCon ki _ -> (Nothing, toIfaceType ki)
1381 SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1383 ifaceConDecls (NewTyCon { data_con = con }) =
1384 IfNewTyCon (ifaceConDecl con)
1385 ifaceConDecls (DataTyCon { data_cons = cons }) =
1386 IfDataTyCon (map ifaceConDecl cons)
1387 ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
1388 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1389 -- The last case happens when a TyCon has been trimmed during tidying
1390 -- Furthermore, tyThingToIfaceDecl is also used
1391 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1392 -- AbstractTyCon case is perfectly sensible.
1394 ifaceConDecl data_con
1395 = IfCon { ifConOcc = getOccName (dataConName data_con),
1396 ifConInfix = dataConIsInfix data_con,
1397 ifConWrapper = isJust (dataConWrapId_maybe data_con),
1398 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1399 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1400 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1401 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1402 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1403 ifConFields = map getOccName
1404 (dataConFieldLabels data_con),
1405 ifConStricts = dataConStrictMarks data_con }
1407 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1409 famInstToIface Nothing = Nothing
1410 famInstToIface (Just (famTyCon, instTys)) =
1411 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1413 tyThingToIfaceDecl (ADataCon dc)
1414 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1417 getFS :: NamedThing a => a -> FastString
1418 getFS x = occNameFS (getOccName x)
1420 --------------------------
1421 instanceToIfaceInst :: Instance -> IfaceInst
1422 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1423 is_cls = cls_name, is_tcs = mb_tcs })
1424 = ASSERT( cls_name == className cls )
1425 IfaceInst { ifDFun = dfun_name,
1427 ifInstCls = cls_name,
1428 ifInstTys = map do_rough mb_tcs,
1431 do_rough Nothing = Nothing
1432 do_rough (Just n) = Just (toIfaceTyCon_name n)
1434 dfun_name = idName dfun_id
1435 mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1436 is_local name = nameIsLocalOrFrom mod name
1438 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1439 (_, cls, tys) = tcSplitDFunTy (idType dfun_id)
1440 -- Slightly awkward: we need the Class to get the fundeps
1441 (tvs, fds) = classTvsFds cls
1442 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1443 orph | is_local cls_name = Just (nameOccName cls_name)
1444 | all isJust mb_ns = ASSERT( not (null mb_ns) ) head mb_ns
1445 | otherwise = Nothing
1447 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1448 -- that is not in the "determined" arguments
1449 mb_ns | null fds = [choose_one arg_names]
1450 | otherwise = map do_one fds
1451 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1452 , not (tv `elem` rtvs)]
1454 choose_one :: [NameSet] -> Maybe OccName
1455 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1457 (n : _) -> Just (nameOccName n)
1459 --------------------------
1460 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1461 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1464 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1465 , ifFamInstFam = fam
1466 , ifFamInstTys = map do_rough mb_tcs }
1468 do_rough Nothing = Nothing
1469 do_rough (Just n) = Just (toIfaceTyCon_name n)
1471 --------------------------
1472 toIfaceLetBndr :: Id -> IfaceLetBndr
1473 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1474 (toIfaceType (idType id))
1477 -- Stripped-down version of tcIfaceIdInfo
1478 -- Change this if you want to export more IdInfo for
1479 -- non-top-level Ids. Don't forget to change
1480 -- CoreTidy.tidyLetBndr too!
1482 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1484 inline_prag = inlinePragInfo id_info
1485 prag_info | isDefaultInlinePragma inline_prag = NoInfo
1486 | otherwise = HasInfo [HsInline inline_prag]
1488 --------------------------
1489 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
1490 toIfaceIdDetails VanillaId = IfVanillaId
1491 toIfaceIdDetails (DFunId {}) = IfDFunId
1492 toIfaceIdDetails (RecSelId { sel_naughty = n
1493 , sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
1494 toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
1495 IfVanillaId -- Unexpected
1497 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1498 toIfaceIdInfo id_info
1499 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1500 inline_hsinfo, unfold_hsinfo]
1501 -- NB: strictness must be before unfolding
1502 -- See TcIface.tcUnfolding
1504 ------------ Arity --------------
1505 arity_info = arityInfo id_info
1506 arity_hsinfo | arity_info == 0 = Nothing
1507 | otherwise = Just (HsArity arity_info)
1509 ------------ Caf Info --------------
1510 caf_info = cafInfo id_info
1511 caf_hsinfo = case caf_info of
1512 NoCafRefs -> Just HsNoCafRefs
1515 ------------ Strictness --------------
1516 -- No point in explicitly exporting TopSig
1517 strict_hsinfo = case strictnessInfo id_info of
1518 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1521 ------------ Unfolding --------------
1522 unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
1523 loop_breaker = isNonRuleLoopBreaker (occInfo id_info)
1525 ------------ Inline prag --------------
1526 inline_prag = inlinePragInfo id_info
1527 inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1528 | otherwise = Just (HsInline inline_prag)
1530 --------------------------
1531 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
1532 toIfUnfolding lb unf@(CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
1533 , uf_src = src, uf_guidance = guidance })
1534 = Just $ HsUnfold lb $
1538 UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok (toIfaceExpr rhs)
1539 _other -> pprPanic "toIfUnfolding" (ppr unf)
1540 InlineWrapper w -> IfWrapper arity (idName w)
1541 InlineCompulsory -> IfCompulsory (toIfaceExpr rhs)
1542 InlineRhs -> IfCoreUnfold (toIfaceExpr rhs)
1543 -- Yes, even if guidance is UnfNever, expose the unfolding
1544 -- If we didn't want to expose the unfolding, TidyPgm would
1545 -- have stuck in NoUnfolding. For supercompilation we want
1546 -- to see that unfolding!
1548 toIfUnfolding lb (DFunUnfolding _con ops)
1549 = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
1550 -- No need to serialise the data constructor;
1551 -- we can recover it from the type of the dfun
1556 --------------------------
1557 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1558 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1559 = pprTrace "toHsRule: builtin" (ppr fn) $
1562 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1563 ru_act = act, ru_bndrs = bndrs,
1564 ru_args = args, ru_rhs = rhs })
1565 = IfaceRule { ifRuleName = name, ifActivation = act,
1566 ifRuleBndrs = map toIfaceBndr bndrs,
1568 ifRuleArgs = map do_arg args,
1569 ifRuleRhs = toIfaceExpr rhs,
1572 -- For type args we must remove synonyms from the outermost
1573 -- level. Reason: so that when we read it back in we'll
1574 -- construct the same ru_rough field as we have right now;
1576 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1577 do_arg arg = toIfaceExpr arg
1579 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1580 -- A rule is an orphan only if none of the variables
1581 -- mentioned on its left-hand side are locally defined
1582 lhs_names = fn : nameSetToList (exprsFreeNames args)
1583 -- No need to delete bndrs, because
1584 -- exprsFreeNames finds only External names
1586 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1587 (n : _) -> Just (nameOccName n)
1590 bogusIfaceRule :: Name -> IfaceRule
1591 bogusIfaceRule id_name
1592 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1593 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1594 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1596 ---------------------
1597 toIfaceExpr :: CoreExpr -> IfaceExpr
1598 toIfaceExpr (Var v) = toIfaceVar v
1599 toIfaceExpr (Lit l) = IfaceLit l
1600 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1601 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1602 toIfaceExpr (App f a) = toIfaceApp f [a]
1603 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1604 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1605 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1606 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1608 ---------------------
1609 toIfaceNote :: Note -> IfaceNote
1610 toIfaceNote (SCC cc) = IfaceSCC cc
1611 toIfaceNote (CoreNote s) = IfaceCoreNote s
1613 ---------------------
1614 toIfaceBind :: Bind Id -> IfaceBinding
1615 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1616 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1618 ---------------------
1619 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1620 -> (IfaceConAlt, [FastString], IfaceExpr)
1621 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1623 ---------------------
1624 toIfaceCon :: AltCon -> IfaceConAlt
1625 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1626 | otherwise = IfaceDataAlt (getName dc)
1628 tc = dataConTyCon dc
1630 toIfaceCon (LitAlt l) = IfaceLitAlt l
1631 toIfaceCon DEFAULT = IfaceDefault
1633 ---------------------
1634 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1635 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1636 toIfaceApp (Var v) as
1637 = case isDataConWorkId_maybe v of
1638 -- We convert the *worker* for tuples into IfaceTuples
1639 Just dc | isTupleTyCon tc && saturated
1640 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1642 val_args = dropWhile isTypeArg as
1643 saturated = val_args `lengthIs` idArity v
1644 tup_args = map toIfaceExpr val_args
1645 tc = dataConTyCon dc
1647 _ -> mkIfaceApps (toIfaceVar v) as
1649 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1651 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1652 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1654 ---------------------
1655 toIfaceVar :: Id -> IfaceExpr
1657 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1658 -- Foreign calls have special syntax
1659 | isExternalName name = IfaceExt name
1660 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1662 | otherwise = IfaceLcl (getFS name)