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 )
100 import qualified Data.Map as Map
102 import System.FilePath
107 %************************************************************************
109 \subsection{Completing an interface}
111 %************************************************************************
115 -> Maybe Fingerprint -- The old fingerprint, if we have it
116 -> ModDetails -- The trimmed, tidied interface
117 -> ModGuts -- Usages, deprecations, etc
119 Maybe (ModIface, -- The new one
120 Bool)) -- True <=> there was an old Iface, and the
121 -- new one is identical, so no need
124 mkIface hsc_env maybe_old_fingerprint mod_details
125 ModGuts{ mg_module = this_mod,
127 mg_used_names = used_names,
129 mg_dir_imps = dir_imp_mods,
130 mg_rdr_env = rdr_env,
131 mg_fix_env = fix_env,
133 mg_hpc_info = hpc_info }
134 = mkIface_ hsc_env maybe_old_fingerprint
135 this_mod is_boot used_names deps rdr_env
136 fix_env warns hpc_info dir_imp_mods mod_details
138 -- | make an interface from the results of typechecking only. Useful
139 -- for non-optimising compilation, or where we aren't generating any
140 -- object code at all ('HscNothing').
142 -> Maybe Fingerprint -- The old fingerprint, if we have it
143 -> ModDetails -- gotten from mkBootModDetails, probably
144 -> TcGblEnv -- Usages, deprecations, etc
145 -> IO (Messages, Maybe (ModIface, Bool))
146 mkIfaceTc hsc_env maybe_old_fingerprint mod_details
147 tc_result@TcGblEnv{ tcg_mod = this_mod,
149 tcg_imports = imports,
150 tcg_rdr_env = rdr_env,
151 tcg_fix_env = fix_env,
153 tcg_hpc = other_hpc_info
156 used_names <- mkUsedNames tc_result
157 deps <- mkDependencies tc_result
158 let hpc_info = emptyHpcInfo other_hpc_info
159 mkIface_ hsc_env maybe_old_fingerprint
160 this_mod (isHsBoot hsc_src) used_names deps rdr_env
161 fix_env warns hpc_info (imp_mods imports) mod_details
164 mkUsedNames :: TcGblEnv -> IO NameSet
166 TcGblEnv{ tcg_inst_uses = dfun_uses_var,
169 = do { dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
170 ; return (allUses dus `unionNameSets` dfun_uses) }
172 mkDependencies :: TcGblEnv -> IO Dependencies
174 TcGblEnv{ tcg_mod = mod,
175 tcg_imports = imports,
179 th_used <- readIORef th_var -- Whether TH is used
181 dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
182 -- M.hi-boot can be in the imp_dep_mods, but we must remove
183 -- it before recording the modules on which this one depends!
184 -- (We want to retain M.hi-boot in imp_dep_mods so that
185 -- loadHiBootInterface can see if M's direct imports depend
186 -- on M.hi-boot, and hence that we should do the hi-boot consistency
189 pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
190 | otherwise = imp_dep_pkgs imports
192 return Deps { dep_mods = sortBy (stableModuleNameCmp `on` fst) dep_mods,
193 dep_pkgs = sortBy stablePackageIdCmp pkgs,
194 dep_orphs = sortBy stableModuleCmp (imp_orphs imports),
195 dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
196 -- sort to get into canonical order
197 -- NB. remember to use lexicographic ordering
199 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
200 -> NameSet -> Dependencies -> GlobalRdrEnv
201 -> NameEnv FixItem -> Warnings -> HpcInfo
204 -> IO (Messages, Maybe (ModIface, Bool))
205 mkIface_ hsc_env maybe_old_fingerprint
206 this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
208 ModDetails{ md_insts = insts,
209 md_fam_insts = fam_insts,
212 md_vect_info = vect_info,
214 md_exports = exports }
215 -- NB: notice that mkIface does not look at the bindings
216 -- only at the TypeEnv. The previous Tidy phase has
217 -- put exactly the info into the TypeEnv that we want
218 -- to expose in the interface
220 = do { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
222 ; let { entities = typeEnvElts type_env ;
223 decls = [ tyThingToIfaceDecl entity
224 | entity <- entities,
225 let name = getName entity,
226 not (isImplicitTyThing entity),
227 -- No implicit Ids and class tycons in the interface file
228 not (isWiredInName name),
229 -- Nor wired-in things; the compiler knows about them anyhow
230 nameIsLocalOrFrom this_mod name ]
231 -- Sigh: see Note [Root-main Id] in TcRnDriver
233 ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
235 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
236 ; iface_insts = map instanceToIfaceInst insts
237 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
238 ; iface_vect_info = flattenVectInfo vect_info
240 ; intermediate_iface = ModIface {
241 mi_module = this_mod,
245 mi_exports = mkIfaceExports exports,
247 -- Sort these lexicographically, so that
248 -- the result is stable across compilations
249 mi_insts = sortLe le_inst iface_insts,
250 mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
251 mi_rules = sortLe le_rule iface_rules,
253 mi_vect_info = iface_vect_info,
255 mi_fixities = fixities,
257 mi_anns = mkIfaceAnnotations anns,
258 mi_globals = Just rdr_env,
260 -- Left out deliberately: filled in by addVersionInfo
261 mi_iface_hash = fingerprint0,
262 mi_mod_hash = fingerprint0,
263 mi_exp_hash = fingerprint0,
264 mi_orphan_hash = fingerprint0,
265 mi_orphan = False, -- Always set by addVersionInfo, but
266 -- it's a strict field, so we can't omit it.
267 mi_finsts = False, -- Ditto
268 mi_decls = deliberatelyOmitted "decls",
269 mi_hash_fn = deliberatelyOmitted "hash_fn",
270 mi_hpc = isHpcUsed hpc_info,
272 -- And build the cached values
273 mi_warn_fn = mkIfaceWarnCache warns,
274 mi_fix_fn = mkIfaceFixCache fixities }
277 ; (new_iface, no_change_at_all)
278 <- {-# SCC "versioninfo" #-}
279 addFingerprints hsc_env maybe_old_fingerprint
280 intermediate_iface decls
282 -- Warn about orphans
283 ; let warn_orphs = dopt Opt_WarnOrphans dflags
284 warn_auto_orphs = dopt Opt_WarnAutoOrphans dflags
285 orph_warnings --- Laziness means no work done unless -fwarn-orphans
286 | warn_orphs || warn_auto_orphs = rule_warns `unionBags` inst_warns
287 | otherwise = emptyBag
288 errs_and_warns = (orph_warnings, emptyBag)
289 unqual = mkPrintUnqualified dflags rdr_env
290 inst_warns = listToBag [ instOrphWarn unqual d
291 | (d,i) <- insts `zip` iface_insts
292 , isNothing (ifInstOrph i) ]
293 rule_warns = listToBag [ ruleOrphWarn unqual this_mod r
295 , isNothing (ifRuleOrph r)
296 , if ifRuleAuto r then warn_auto_orphs
299 ; if errorsFound dflags errs_and_warns
300 then return ( errs_and_warns, Nothing )
303 -- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
306 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
307 (pprModIface new_iface)
309 -- bug #1617: on reload we weren't updating the PrintUnqualified
310 -- correctly. This stems from the fact that the interface had
311 -- not changed, so addVersionInfo returns the old ModIface
312 -- with the old GlobalRdrEnv (mi_globals).
313 ; let final_iface = new_iface{ mi_globals = Just rdr_env }
315 ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
317 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
318 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
319 i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
321 le_occ :: Name -> Name -> Bool
322 -- Compare lexicographically by OccName, *not* by unique, because
323 -- the latter is not stable across compilations
324 le_occ n1 n2 = nameOccName n1 <= nameOccName n2
326 dflags = hsc_dflags hsc_env
328 deliberatelyOmitted :: String -> a
329 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
331 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
333 flattenVectInfo (VectInfo { vectInfoVar = vVar
334 , vectInfoTyCon = vTyCon
337 ifaceVectInfoVar = [ Var.varName v
338 | (v, _) <- varEnvElts vVar],
339 ifaceVectInfoTyCon = [ tyConName t
340 | (t, t_v) <- nameEnvElts vTyCon
342 ifaceVectInfoTyConReuse = [ tyConName t
343 | (t, t_v) <- nameEnvElts vTyCon
347 -----------------------------
348 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
349 writeIfaceFile dflags location new_iface
350 = do createDirectoryHierarchy (takeDirectory hi_file_path)
351 writeBinIface dflags hi_file_path new_iface
352 where hi_file_path = ml_hi_file location
355 -- -----------------------------------------------------------------------------
356 -- Look up parents and versions of Names
358 -- This is like a global version of the mi_hash_fn field in each ModIface.
359 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
360 -- the parent and version info.
363 :: HscEnv -- needed to look up versions
364 -> ExternalPackageState -- ditto
365 -> (Name -> Fingerprint)
366 mkHashFun hsc_env eps
369 mod = ASSERT2( isExternalName name, ppr name ) nameModule name
370 occ = nameOccName name
371 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
372 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
374 snd (mi_hash_fn iface occ `orElse`
375 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
377 hpt = hsc_HPT hsc_env
380 -- ---------------------------------------------------------------------------
381 -- Compute fingerprints for the interface
385 -> Maybe Fingerprint -- the old fingerprint, if any
386 -> ModIface -- The new interface (lacking decls)
387 -> [IfaceDecl] -- The new decls
388 -> IO (ModIface, -- Updated interface
389 Bool) -- True <=> no changes at all;
390 -- no need to write Iface
392 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
394 eps <- hscEPS hsc_env
396 -- The ABI of a declaration represents everything that is made
397 -- visible about the declaration that a client can depend on.
398 -- see IfaceDeclABI below.
399 declABI :: IfaceDecl -> IfaceDeclABI
400 declABI decl = (this_mod, decl, extras)
401 where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
403 edges :: [(IfaceDeclABI, Unique, [Unique])]
404 edges = [ (abi, getUnique (ifName decl), out)
406 , let abi = declABI decl
407 , let out = localOccs $ freeNamesDeclABI abi
410 name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
411 localOccs = map (getUnique . getParent . getOccName)
412 . filter ((== this_mod) . name_module)
414 where getParent occ = lookupOccEnv parent_map occ `orElse` occ
416 -- maps OccNames to their parents in the current module.
417 -- e.g. a reference to a constructor must be turned into a reference
418 -- to the TyCon for the purposes of calculating dependencies.
419 parent_map :: OccEnv OccName
420 parent_map = foldr extend emptyOccEnv new_decls
422 extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
425 -- strongly-connected groups of declarations, in dependency order
426 groups = stronglyConnCompFromEdgedVertices edges
428 global_hash_fn = mkHashFun hsc_env eps
430 -- how to output Names when generating the data to fingerprint.
431 -- Here we want to output the fingerprint for each top-level
432 -- Name, whether it comes from the current module or another
433 -- module. In this way, the fingerprint for a declaration will
434 -- change if the fingerprint for anything it refers to (transitively)
436 mk_put_name :: (OccEnv (OccName,Fingerprint))
437 -> BinHandle -> Name -> IO ()
438 mk_put_name local_env bh name
439 | isWiredInName name = putNameLiterally bh name
440 -- wired-in names don't have fingerprints
442 = ASSERT2( isExternalName name, ppr name )
443 let hash | nameModule name /= this_mod = global_hash_fn name
445 snd (lookupOccEnv local_env (getOccName name)
446 `orElse` pprPanic "urk! lookup local fingerprint"
447 (ppr name)) -- (undefined,fingerprint0))
448 -- This panic indicates that we got the dependency
449 -- analysis wrong, because we needed a fingerprint for
450 -- an entity that wasn't in the environment. To debug
451 -- it, turn the panic into a trace, uncomment the
452 -- pprTraces below, run the compile again, and inspect
453 -- the output and the generated .hi file with
458 -- take a strongly-connected group of declarations and compute
461 fingerprint_group :: (OccEnv (OccName,Fingerprint),
462 [(Fingerprint,IfaceDecl)])
464 -> IO (OccEnv (OccName,Fingerprint),
465 [(Fingerprint,IfaceDecl)])
467 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
468 = do let hash_fn = mk_put_name local_env
470 -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
471 hash <- computeFingerprint dflags hash_fn abi
472 return (extend_hash_env (hash,decl) local_env,
473 (hash,decl) : decls_w_hashes)
475 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
476 = do let decls = map abiDecl abis
477 local_env' = foldr extend_hash_env local_env
478 (zip (repeat fingerprint0) decls)
479 hash_fn = mk_put_name local_env'
480 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
481 let stable_abis = sortBy cmp_abiNames abis
482 -- put the cycle in a canonical order
483 hash <- computeFingerprint dflags hash_fn stable_abis
484 let pairs = zip (repeat hash) decls
485 return (foldr extend_hash_env local_env pairs,
486 pairs ++ decls_w_hashes)
488 extend_hash_env :: (Fingerprint,IfaceDecl)
489 -> OccEnv (OccName,Fingerprint)
490 -> OccEnv (OccName,Fingerprint)
491 extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
494 item = (decl_name, hash)
495 env1 = extendOccEnv env0 decl_name item
496 add_imp bndr env = extendOccEnv env bndr item
499 (local_env, decls_w_hashes) <-
500 foldM fingerprint_group (emptyOccEnv, []) groups
502 -- when calculating fingerprints, we always need to use canonical
503 -- ordering for lists of things. In particular, the mi_deps has various
504 -- lists of modules and suchlike, so put these all in canonical order:
505 let sorted_deps = sortDependencies (mi_deps iface0)
507 -- the export hash of a module depends on the orphan hashes of the
508 -- orphan modules below us in the dependency tree. This is the way
509 -- that changes in orphans get propagated all the way up the
510 -- dependency tree. We only care about orphan modules in the current
511 -- package, because changes to orphans outside this package will be
512 -- tracked by the usage on the ABI hash of package modules that we import.
513 let orph_mods = filter ((== this_pkg) . modulePackageId)
514 $ dep_orphs sorted_deps
515 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
517 orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
518 (map IfaceInstABI orph_insts, orph_rules, fam_insts)
520 -- the export list hash doesn't depend on the fingerprints of
521 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
522 export_hash <- computeFingerprint dflags putNameLiterally
526 dep_pkgs (mi_deps iface0))
527 -- dep_pkgs: see "Package Version Changes" on
528 -- wiki/Commentary/Compiler/RecompilationAvoidance
530 -- put the declarations in a canonical order, sorted by OccName
531 let sorted_decls = Map.elems $ Map.fromList $
532 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
534 -- the ABI hash depends on:
540 mod_hash <- computeFingerprint dflags putNameLiterally
541 (map fst sorted_decls,
546 -- The interface hash depends on:
547 -- - the ABI hash, plus
551 iface_hash <- computeFingerprint dflags putNameLiterally
558 no_change_at_all = Just iface_hash == mb_old_fingerprint
560 final_iface = iface0 {
561 mi_mod_hash = mod_hash,
562 mi_iface_hash = iface_hash,
563 mi_exp_hash = export_hash,
564 mi_orphan_hash = orphan_hash,
565 mi_orphan = not (null orph_rules && null orph_insts),
566 mi_finsts = not . null $ mi_fam_insts iface0,
567 mi_decls = sorted_decls,
568 mi_hash_fn = lookupOccEnv local_env }
570 return (final_iface, no_change_at_all)
573 this_mod = mi_module iface0
574 dflags = hsc_dflags hsc_env
575 this_pkg = thisPackage dflags
576 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
577 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
578 -- ToDo: shouldn't we be splitting fam_insts into orphans and
580 fam_insts = mi_fam_insts iface0
581 fix_fn = mi_fix_fn iface0
584 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
585 getOrphanHashes hsc_env mods = do
586 eps <- hscEPS hsc_env
588 hpt = hsc_HPT hsc_env
590 dflags = hsc_dflags hsc_env
592 case lookupIfaceByModule dflags hpt pit mod of
593 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
594 Just iface -> mi_orphan_hash iface
596 return (map get_orph_hash mods)
599 sortDependencies :: Dependencies -> Dependencies
601 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
602 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
603 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
604 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
608 %************************************************************************
610 The ABI of an IfaceDecl
612 %************************************************************************
614 Note [The ABI of an IfaceDecl]
615 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
616 The ABI of a declaration consists of:
618 (a) the full name of the identifier (inc. module and package,
619 because these are used to construct the symbol name by which
620 the identifier is known externally).
622 (b) the declaration itself, as exposed to clients. That is, the
623 definition of an Id is included in the fingerprint only if
624 it is made available as as unfolding in the interface.
626 (c) the fixity of the identifier
628 (e) for classes: instances, fixity & rules for methods
629 (f) for datatypes: instances, fixity & rules for constrs
631 Items (c)-(f) are not stored in the IfaceDecl, but instead appear
632 elsewhere in the interface file. But they are *fingerprinted* with
633 the Id itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
634 and fingerprinting that as part of the Id.
637 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
640 = IfaceIdExtras Fixity [IfaceRule]
641 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
642 | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
643 | IfaceSynExtras Fixity
644 | IfaceOtherDeclExtras
646 abiDecl :: IfaceDeclABI -> IfaceDecl
647 abiDecl (_, decl, _) = decl
649 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
650 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
651 ifName (abiDecl abi2)
653 freeNamesDeclABI :: IfaceDeclABI -> NameSet
654 freeNamesDeclABI (_mod, decl, extras) =
655 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
657 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
658 freeNamesDeclExtras (IfaceIdExtras _ rules)
659 = unionManyNameSets (map freeNamesIfRule rules)
660 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
661 = unionManyNameSets (map freeNamesSub subs)
662 freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
663 = unionManyNameSets (map freeNamesSub subs)
664 freeNamesDeclExtras (IfaceSynExtras _)
666 freeNamesDeclExtras IfaceOtherDeclExtras
669 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
670 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
672 instance Outputable IfaceDeclExtras where
673 ppr IfaceOtherDeclExtras = empty
674 ppr (IfaceIdExtras fix rules) = ppr_id_extras fix rules
675 ppr (IfaceSynExtras fix) = ppr fix
676 ppr (IfaceDataExtras fix insts stuff) = vcat [ppr fix, ppr_insts insts,
677 ppr_id_extras_s stuff]
678 ppr (IfaceClassExtras fix insts stuff) = vcat [ppr fix, ppr_insts insts,
679 ppr_id_extras_s stuff]
681 ppr_insts :: [IfaceInstABI] -> SDoc
682 ppr_insts _ = ptext (sLit "<insts>")
684 ppr_id_extras_s :: [(Fixity, [IfaceRule])] -> SDoc
685 ppr_id_extras_s stuff = vcat [ppr_id_extras f r | (f,r)<- stuff]
687 ppr_id_extras :: Fixity -> [IfaceRule] -> SDoc
688 ppr_id_extras fix rules = ppr fix $$ vcat (map ppr rules)
690 -- This instance is used only to compute fingerprints
691 instance Binary IfaceDeclExtras where
692 get _bh = panic "no get for IfaceDeclExtras"
693 put_ bh (IfaceIdExtras fix rules) = do
694 putByte bh 1; put_ bh fix; put_ bh rules
695 put_ bh (IfaceDataExtras fix insts cons) = do
696 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
697 put_ bh (IfaceClassExtras fix insts methods) = do
698 putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
699 put_ bh (IfaceSynExtras fix) = do
700 putByte bh 4; put_ bh fix
701 put_ bh IfaceOtherDeclExtras = do
704 declExtras :: (OccName -> Fixity)
705 -> OccEnv [IfaceRule]
706 -> OccEnv [IfaceInst]
710 declExtras fix_fn rule_env inst_env decl
712 IfaceId{} -> IfaceIdExtras (fix_fn n)
713 (lookupOccEnvL rule_env n)
714 IfaceData{ifCons=cons} ->
715 IfaceDataExtras (fix_fn n)
716 (map IfaceInstABI $ lookupOccEnvL inst_env n)
717 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
718 IfaceClass{ifSigs=sigs} ->
719 IfaceClassExtras (fix_fn n)
720 (map IfaceInstABI $ lookupOccEnvL inst_env n)
721 [id_extras op | IfaceClassOp op _ _ <- sigs]
722 IfaceSyn{} -> IfaceSynExtras (fix_fn n)
723 _other -> IfaceOtherDeclExtras
726 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
729 -- When hashing an instance, we hash only its structure, not the
730 -- fingerprints of the things it mentions. See the section on instances
731 -- in the commentary,
732 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
734 newtype IfaceInstABI = IfaceInstABI IfaceInst
736 instance Binary IfaceInstABI where
737 get = panic "no get for IfaceInstABI"
738 put_ bh (IfaceInstABI inst) = do
739 let ud = getUserData bh
740 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
743 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
744 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
746 -- used when we want to fingerprint a structure without depending on the
747 -- fingerprints of external Names that it refers to.
748 putNameLiterally :: BinHandle -> Name -> IO ()
749 putNameLiterally bh name = ASSERT( isExternalName name )
750 do { put_ bh $! nameModule name
751 ; put_ bh $! nameOccName name }
753 computeFingerprint :: Binary a
755 -> (BinHandle -> Name -> IO ())
759 computeFingerprint _dflags put_name a = do
760 bh <- openBinMem (3*1024) -- just less than a block
761 ud <- newWriteState put_name putFS
762 bh <- return $ setUserData bh ud
767 -- for testing: use the md5sum command to generate fingerprints and
768 -- compare the results against our built-in version.
769 fp' <- oldMD5 dflags bh
770 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
773 oldMD5 dflags bh = do
774 tmp <- newTempName dflags "bin"
776 tmp2 <- newTempName dflags "md5"
777 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
780 ExitFailure _ -> ghcError (PhaseFailed cmd r)
782 hash_str <- readFile tmp2
783 return $! readHexFingerprint hash_str
786 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
787 instOrphWarn unqual inst
788 = mkWarnMsg (getSrcSpan inst) unqual $
789 hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
791 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
792 ruleOrphWarn unqual mod rule
793 = mkWarnMsg silly_loc unqual $
794 ptext (sLit "Orphan rule:") <+> ppr rule
796 silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
797 -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
798 -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
800 ----------------------
801 -- mkOrphMap partitions instance decls or rules into
802 -- (a) an OccEnv for ones that are not orphans,
803 -- mapping the local OccName to a list of its decls
804 -- (b) a list of orphan decls
805 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
806 -- Nothing for an orphan decl
807 -> [decl] -- Sorted into canonical order
808 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
809 -- each sublist in canonical order
810 [decl]) -- Orphan decls; in canonical order
811 mkOrphMap get_key decls
812 = foldl go (emptyOccEnv, []) decls
814 go (non_orphs, orphs) d
815 | Just occ <- get_key d
816 = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
817 | otherwise = (non_orphs, d:orphs)
821 %************************************************************************
823 Keeping track of what we've slurped, and fingerprints
825 %************************************************************************
828 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
829 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
830 = do { eps <- hscEPS hsc_env
831 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
832 dir_imp_mods used_names
833 ; usages `seqList` return usages }
834 -- seq the list of Usages returned: occasionally these
835 -- don't get evaluated for a while and we can end up hanging on to
836 -- the entire collection of Ifaces.
838 mk_usage_info :: PackageIfaceTable
844 mk_usage_info pit hsc_env this_mod direct_imports used_names
845 = mapCatMaybes mkUsage usage_mods
847 hpt = hsc_HPT hsc_env
848 dflags = hsc_dflags hsc_env
849 this_pkg = thisPackage dflags
851 used_mods = moduleEnvKeys ent_map
852 dir_imp_mods = (moduleEnvKeys direct_imports)
853 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
854 usage_mods = sortBy stableModuleCmp all_mods
855 -- canonical order is imported, to avoid interface-file
858 -- ent_map groups together all the things imported and used
859 -- from a particular module
860 ent_map :: ModuleEnv [OccName]
861 ent_map = foldNameSet add_mv emptyModuleEnv used_names
864 | isWiredInName name = mv_map -- ignore wired-in names
866 = case nameModule_maybe name of
867 Nothing -> pprPanic "mkUsageInfo: internal name?" (ppr name)
868 Just mod -> -- This lambda function is really just a
869 -- specialised (++); originally came about to
870 -- avoid quadratic behaviour (trac #2680)
871 extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod [occ]
872 where occ = nameOccName name
874 -- We want to create a Usage for a home module if
875 -- a) we used something from it; has something in used_names
876 -- b) we imported it, even if we used nothing from it
877 -- (need to recompile if its export list changes: export_fprint)
878 mkUsage :: Module -> Maybe Usage
880 | isNothing maybe_iface -- We can't depend on it if we didn't
881 -- load its interface.
882 || mod == this_mod -- We don't care about usages of
883 -- things in *this* module
886 | modulePackageId mod /= this_pkg
887 = Just UsagePackageModule{ usg_mod = mod,
888 usg_mod_hash = mod_hash }
889 -- for package modules, we record the module hash only
892 && isNothing export_hash
893 && not is_direct_import
895 = Nothing -- Record no usage info
896 -- for directly-imported modules, we always want to record a usage
897 -- on the orphan hash. This is what triggers a recompilation if
898 -- an orphan is added or removed somewhere below us in the future.
901 = Just UsageHomeModule {
902 usg_mod_name = moduleName mod,
903 usg_mod_hash = mod_hash,
904 usg_exports = export_hash,
905 usg_entities = Map.toList ent_hashs }
907 maybe_iface = lookupIfaceByModule dflags hpt pit mod
908 -- In one-shot mode, the interfaces for home-package
909 -- modules accumulate in the PIT not HPT. Sigh.
911 is_direct_import = mod `elemModuleEnv` direct_imports
913 Just iface = maybe_iface
914 finsts_mod = mi_finsts iface
915 hash_env = mi_hash_fn iface
916 mod_hash = mi_mod_hash iface
917 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
918 | otherwise = Nothing
920 used_occs = lookupModuleEnv ent_map mod `orElse` []
922 -- Making a Map here ensures that (a) we remove duplicates
923 -- when we have usages on several subordinates of a single parent,
924 -- and (b) that the usages emerge in a canonical order, which
925 -- is why we use Map rather than OccEnv: Map works
926 -- using Ord on the OccNames, which is a lexicographic ordering.
927 ent_hashs :: Map OccName Fingerprint
928 ent_hashs = Map.fromList (map lookup_occ used_occs)
932 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
935 depend_on_exports mod =
936 case lookupModuleEnv direct_imports mod of
938 -- Even if we used 'import M ()', we have to register a
939 -- usage on the export list because we are sensitive to
940 -- changes in orphan instances/rules.
942 -- In GHC 6.8.x the above line read "True", and in
943 -- fact it recorded a dependency on *all* the
944 -- modules underneath in the dependency tree. This
945 -- happens to make orphans work right, but is too
946 -- expensive: it'll read too many interface files.
947 -- The 'isNothing maybe_iface' check above saved us
948 -- from generating many of these usages (at least in
949 -- one-shot mode), but that's even more bogus!
953 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
954 mkIfaceAnnotations = map mkIfaceAnnotation
956 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
957 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
958 ifAnnotatedTarget = fmap nameOccName target,
959 ifAnnotatedValue = serialized
964 mkIfaceExports :: [AvailInfo]
965 -> [(Module, [GenAvailInfo OccName])]
966 -- Group by module and sort by occurrence
967 mkIfaceExports exports
968 = [ (mod, Map.elems avails)
969 | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
970 (moduleEnvToList groupFM)
971 -- NB. the Map.toList is in a random order,
972 -- because Ord Module is not a predictable
973 -- ordering. Hence we perform a final sort
974 -- using the stable Module ordering.
977 -- Group by the module where the exported entities are defined
978 -- (which may not be the same for all Names in an Avail)
979 -- Deliberately use Map rather than UniqFM so we
980 -- get a canonical ordering
981 groupFM :: ModuleEnv (Map FastString (GenAvailInfo OccName))
982 groupFM = foldl add emptyModuleEnv exports
984 add_one :: ModuleEnv (Map FastString (GenAvailInfo OccName))
985 -> Module -> GenAvailInfo OccName
986 -> ModuleEnv (Map FastString (GenAvailInfo OccName))
987 add_one env mod avail
988 -- XXX Is there a need to flip Map.union here?
989 = extendModuleEnvWith (flip Map.union) env mod
990 (Map.singleton (occNameFS (availName avail)) avail)
992 -- NB: we should not get T(X) and T(Y) in the export list
993 -- else the Map.union will simply discard one! They
994 -- should have been combined by now.
996 = ASSERT( isExternalName n )
997 add_one env (nameModule n) (Avail (nameOccName n))
999 add env (AvailTC tc ns)
1000 = ASSERT( all isExternalName ns )
1001 foldl add_for_mod env mods
1003 tc_occ = nameOccName tc
1004 mods = nub (map nameModule ns)
1005 -- Usually just one, but see Note [Original module]
1008 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
1009 -- NB. sort the children, we need a canonical order
1011 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
1014 Note [Orignal module]
1015 ~~~~~~~~~~~~~~~~~~~~~
1017 module X where { data family T }
1018 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
1019 The exported Avail from Y will look like
1022 - only MkT is brought into scope by the data instance;
1023 - but the parent (used for grouping and naming in T(..) exports) is X.T
1024 - and in this case we export X.T too
1026 In the result of MkIfaceExports, the names are grouped by defining module,
1027 so we may need to split up a single Avail into multiple ones.
1030 %************************************************************************
1032 Load the old interface file for this module (unless
1033 we have it aleady), and check whether it is up to date
1036 %************************************************************************
1039 checkOldIface :: HscEnv
1041 -> Bool -- Source unchanged
1042 -> Maybe ModIface -- Old interface from compilation manager, if any
1043 -> IO (RecompileRequired, Maybe ModIface)
1045 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1046 = do { showPass (hsc_dflags hsc_env)
1047 ("Checking old interface for " ++
1048 showSDoc (ppr (ms_mod mod_summary))) ;
1050 ; initIfaceCheck hsc_env $
1051 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1054 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1055 -> IfG (Bool, Maybe ModIface)
1056 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1057 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
1058 { when (not source_unchanged)
1059 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1061 -- If the source has changed and we're in interactive mode, avoid reading
1062 -- an interface; just return the one we might have been supplied with.
1063 ; let dflags = hsc_dflags hsc_env
1064 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1065 return (outOfDate, maybe_iface)
1067 case maybe_iface of {
1068 Just old_iface -> do -- Use the one we already have
1069 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1070 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1071 ; return (recomp, Just old_iface) }
1075 -- Try and read the old interface for the current module
1076 -- from the .hi file left from the last time we compiled it
1077 { let iface_path = msHiFilePath mod_summary
1078 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1079 ; case read_result of {
1080 Failed err -> do -- Old interface file not found, or garbled; give up
1081 { traceIf (text "FYI: cannot read old interface file:"
1083 ; return (outOfDate, Nothing) }
1085 ; Succeeded iface -> do
1087 -- We have got the old iface; check its versions
1088 { traceIf (text "Read the interface file" <+> text iface_path)
1089 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1090 ; return (recomp, Just iface)
1095 @recompileRequired@ is called from the HscMain. It checks whether
1096 a recompilation is required. It needs access to the persistent state,
1097 finder, etc, because it may have to load lots of interface files to
1098 check their versions.
1101 type RecompileRequired = Bool
1102 upToDate, outOfDate :: Bool
1103 upToDate = False -- Recompile not required
1104 outOfDate = True -- Recompile required
1106 checkVersions :: HscEnv
1107 -> Bool -- True <=> source unchanged
1109 -> ModIface -- Old interface
1110 -> IfG RecompileRequired
1111 checkVersions hsc_env source_unchanged mod_summary iface
1112 | not source_unchanged
1115 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1116 ppr (mi_module iface) <> colon)
1118 ; recomp <- checkDependencies hsc_env mod_summary iface
1119 ; if recomp then return outOfDate else do {
1121 -- Source code unchanged and no errors yet... carry on
1123 -- First put the dependent-module info, read from the old
1124 -- interface, into the envt, so that when we look for
1125 -- interfaces we look for the right one (.hi or .hi-boot)
1127 -- It's just temporary because either the usage check will succeed
1128 -- (in which case we are done with this module) or it'll fail (in which
1129 -- case we'll compile the module from scratch anyhow).
1131 -- We do this regardless of compilation mode, although in --make mode
1132 -- all the dependent modules should be in the HPT already, so it's
1134 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1136 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1137 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1140 -- This is a bit of a hack really
1141 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1142 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1145 -- If the direct imports of this module are resolved to targets that
1146 -- are not among the dependencies of the previous interface file,
1147 -- then we definitely need to recompile. This catches cases like
1148 -- - an exposed package has been upgraded
1149 -- - we are compiling with different package flags
1150 -- - a home module that was shadowing a package module has been removed
1151 -- - a new home module has been added that shadows a package module
1154 -- Returns True if recompilation is required.
1155 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1156 checkDependencies hsc_env summary iface
1157 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1159 prev_dep_mods = dep_mods (mi_deps iface)
1160 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1162 this_pkg = thisPackage (hsc_dflags hsc_env)
1164 orM = foldr f (return False)
1165 where f m rest = do b <- m; if b then return True else rest
1167 dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
1168 find_res <- liftIO $ findImportedModule hsc_env mod pkg
1172 -> if moduleName mod `notElem` map fst prev_dep_mods
1173 then do traceHiDiffs $
1174 text "imported module " <> quotes (ppr mod) <>
1175 text " not among previous dependencies"
1180 -> if pkg `notElem` prev_dep_pkgs
1181 then do traceHiDiffs $
1182 text "imported module " <> quotes (ppr mod) <>
1183 text " is from package " <> quotes (ppr pkg) <>
1184 text ", which is not among previous dependencies"
1188 where pkg = modulePackageId mod
1189 _otherwise -> return outOfDate
1191 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1192 -> IfG RecompileRequired
1193 needInterface mod continue
1194 = do -- Load the imported interface if possible
1195 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1196 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1198 mb_iface <- loadInterface doc_str mod ImportBySystem
1199 -- Load the interface, but don't complain on failure;
1200 -- Instead, get an Either back which we can test
1203 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1205 -- Couldn't find or parse a module mentioned in the
1206 -- old interface file. Don't complain: it might
1207 -- just be that the current module doesn't need that
1208 -- import and it's been deleted
1209 Succeeded iface -> continue iface
1212 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1213 -- Given the usage information extracted from the old
1214 -- M.hi file for the module being compiled, figure out
1215 -- whether M needs to be recompiled.
1217 checkModUsage _this_pkg UsagePackageModule{
1219 usg_mod_hash = old_mod_hash }
1220 = needInterface mod $ \iface -> do
1221 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1222 -- We only track the ABI hash of package modules, rather than
1223 -- individual entity usages, so if the ABI hash changes we must
1224 -- recompile. This is safe but may entail more recompilation when
1225 -- a dependent package has changed.
1227 checkModUsage this_pkg UsageHomeModule{
1228 usg_mod_name = mod_name,
1229 usg_mod_hash = old_mod_hash,
1230 usg_exports = maybe_old_export_hash,
1231 usg_entities = old_decl_hash }
1233 let mod = mkModule this_pkg mod_name
1234 needInterface mod $ \iface -> do
1237 new_mod_hash = mi_mod_hash iface
1238 new_decl_hash = mi_hash_fn iface
1239 new_export_hash = mi_exp_hash iface
1242 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1243 if not recompile then return upToDate else do
1245 -- CHECK EXPORT LIST
1246 checkMaybeHash maybe_old_export_hash new_export_hash
1247 (ptext (sLit " Export list changed")) $ do
1249 -- CHECK ITEMS ONE BY ONE
1250 recompile <- checkList [ checkEntityUsage new_decl_hash u
1251 | u <- old_decl_hash]
1253 then return outOfDate -- This one failed, so just bail out now
1254 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1256 ------------------------
1257 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1258 checkModuleFingerprint old_mod_hash new_mod_hash
1259 | new_mod_hash == old_mod_hash
1260 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1263 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1264 old_mod_hash new_mod_hash
1266 ------------------------
1267 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1268 -> IfG RecompileRequired -> IfG RecompileRequired
1269 checkMaybeHash maybe_old_hash new_hash doc continue
1270 | Just hash <- maybe_old_hash, hash /= new_hash
1271 = out_of_date_hash doc hash new_hash
1275 ------------------------
1276 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1277 -> (OccName, Fingerprint)
1279 checkEntityUsage new_hash (name,old_hash)
1280 = case new_hash name of
1282 Nothing -> -- We used it before, but it ain't there now
1283 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1285 Just (_, new_hash) -- It's there, but is it up to date?
1286 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1288 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1291 up_to_date, out_of_date :: SDoc -> IfG Bool
1292 up_to_date msg = traceHiDiffs msg >> return upToDate
1293 out_of_date msg = traceHiDiffs msg >> return outOfDate
1295 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1296 out_of_date_hash msg old_hash new_hash
1297 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1299 ----------------------
1300 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1301 -- This helper is used in two places
1302 checkList [] = return upToDate
1303 checkList (check:checks) = do recompile <- check
1305 then return outOfDate
1306 else checkList checks
1309 %************************************************************************
1311 Converting things to their Iface equivalents
1313 %************************************************************************
1316 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1317 -- Assumption: the thing is already tidied, so that locally-bound names
1318 -- (lambdas, for-alls) already have non-clashing OccNames
1319 -- Reason: Iface stuff uses OccNames, and the conversion here does
1320 -- not do tidying on the way
1321 tyThingToIfaceDecl (AnId id)
1322 = IfaceId { ifName = getOccName id,
1323 ifType = toIfaceType (idType id),
1324 ifIdDetails = toIfaceIdDetails (idDetails id),
1325 ifIdInfo = toIfaceIdInfo (idInfo id) }
1327 tyThingToIfaceDecl (AClass clas)
1328 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1329 ifName = getOccName clas,
1330 ifTyVars = toIfaceTvBndrs clas_tyvars,
1331 ifFDs = map toIfaceFD clas_fds,
1332 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1333 ifSigs = map toIfaceClassOp op_stuff,
1334 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1336 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1337 = classExtraBigSig clas
1338 tycon = classTyCon clas
1340 toIfaceClassOp (sel_id, def_meth)
1341 = ASSERT(sel_tyvars == clas_tyvars)
1342 IfaceClassOp (getOccName sel_id) (toDmSpec def_meth) (toIfaceType op_ty)
1344 -- Be careful when splitting the type, because of things
1345 -- like class Foo a where
1346 -- op :: (?x :: String) => a -> a
1347 -- and class Baz a where
1348 -- op :: (Ord a) => a -> a
1349 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1350 op_ty = funResultTy rho_ty
1352 toDmSpec NoDefMeth = NoDM
1353 toDmSpec GenDefMeth = GenericDM
1354 toDmSpec (DefMeth _) = VanillaDM
1356 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1358 tyThingToIfaceDecl (ATyCon tycon)
1360 = IfaceSyn { ifName = getOccName tycon,
1361 ifTyVars = toIfaceTvBndrs tyvars,
1364 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1368 = IfaceData { ifName = getOccName tycon,
1369 ifTyVars = toIfaceTvBndrs tyvars,
1370 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1371 ifCons = ifaceConDecls (algTyConRhs tycon),
1372 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1373 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1374 ifGeneric = tyConHasGenerics tycon,
1375 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1377 | isForeignTyCon tycon
1378 = IfaceForeign { ifName = getOccName tycon,
1379 ifExtName = tyConExtName tycon }
1381 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1383 tyvars = tyConTyVars tycon
1385 = case synTyConRhs tycon of
1386 SynFamilyTyCon -> (Nothing, toIfaceType (synTyConResKind tycon))
1387 SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1389 ifaceConDecls (NewTyCon { data_con = con }) =
1390 IfNewTyCon (ifaceConDecl con)
1391 ifaceConDecls (DataTyCon { data_cons = cons }) =
1392 IfDataTyCon (map ifaceConDecl cons)
1393 ifaceConDecls DataFamilyTyCon {} = IfOpenDataTyCon
1394 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1395 -- The last case happens when a TyCon has been trimmed during tidying
1396 -- Furthermore, tyThingToIfaceDecl is also used
1397 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1398 -- AbstractTyCon case is perfectly sensible.
1400 ifaceConDecl data_con
1401 = IfCon { ifConOcc = getOccName (dataConName data_con),
1402 ifConInfix = dataConIsInfix data_con,
1403 ifConWrapper = isJust (dataConWrapId_maybe data_con),
1404 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1405 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1406 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1407 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1408 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1409 ifConFields = map getOccName
1410 (dataConFieldLabels data_con),
1411 ifConStricts = dataConStrictMarks data_con }
1413 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1415 famInstToIface Nothing = Nothing
1416 famInstToIface (Just (famTyCon, instTys)) =
1417 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1419 tyThingToIfaceDecl (ADataCon dc)
1420 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1423 getFS :: NamedThing a => a -> FastString
1424 getFS x = occNameFS (getOccName x)
1426 --------------------------
1427 instanceToIfaceInst :: Instance -> IfaceInst
1428 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1429 is_cls = cls_name, is_tcs = mb_tcs })
1430 = ASSERT( cls_name == className cls )
1431 IfaceInst { ifDFun = dfun_name,
1433 ifInstCls = cls_name,
1434 ifInstTys = map do_rough mb_tcs,
1437 do_rough Nothing = Nothing
1438 do_rough (Just n) = Just (toIfaceTyCon_name n)
1440 dfun_name = idName dfun_id
1441 mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1442 is_local name = nameIsLocalOrFrom mod name
1444 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1445 (_, cls, tys) = tcSplitDFunTy (idType dfun_id)
1446 -- Slightly awkward: we need the Class to get the fundeps
1447 (tvs, fds) = classTvsFds cls
1448 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1449 orph | is_local cls_name = Just (nameOccName cls_name)
1450 | all isJust mb_ns = ASSERT( not (null mb_ns) ) head mb_ns
1451 | otherwise = Nothing
1453 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1454 -- that is not in the "determined" arguments
1455 mb_ns | null fds = [choose_one arg_names]
1456 | otherwise = map do_one fds
1457 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1458 , not (tv `elem` rtvs)]
1460 choose_one :: [NameSet] -> Maybe OccName
1461 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1463 (n : _) -> Just (nameOccName n)
1465 --------------------------
1466 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1467 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1470 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1471 , ifFamInstFam = fam
1472 , ifFamInstTys = map do_rough mb_tcs }
1474 do_rough Nothing = Nothing
1475 do_rough (Just n) = Just (toIfaceTyCon_name n)
1477 --------------------------
1478 toIfaceLetBndr :: Id -> IfaceLetBndr
1479 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1480 (toIfaceType (idType id))
1481 (toIfaceIdInfo (idInfo id))
1482 -- Put into the interface file any IdInfo that CoreTidy.tidyLetBndr
1483 -- has left on the Id. See Note [IdInfo on nested let-bindings] in IfaceSyn
1485 --------------------------
1486 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
1487 toIfaceIdDetails VanillaId = IfVanillaId
1488 toIfaceIdDetails (DFunId {}) = IfDFunId
1489 toIfaceIdDetails (RecSelId { sel_naughty = n
1490 , sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
1491 toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
1492 IfVanillaId -- Unexpected
1494 toIfaceIdInfo :: IdInfo -> IfaceIdInfo
1495 toIfaceIdInfo id_info
1496 = case catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1497 inline_hsinfo, unfold_hsinfo] of
1499 infos -> HasInfo infos
1500 -- NB: strictness must appear in the list before unfolding
1501 -- See TcIface.tcUnfolding
1503 ------------ Arity --------------
1504 arity_info = arityInfo id_info
1505 arity_hsinfo | arity_info == 0 = Nothing
1506 | otherwise = Just (HsArity arity_info)
1508 ------------ Caf Info --------------
1509 caf_info = cafInfo id_info
1510 caf_hsinfo = case caf_info of
1511 NoCafRefs -> Just HsNoCafRefs
1514 ------------ Strictness --------------
1515 -- No point in explicitly exporting TopSig
1516 strict_hsinfo = case strictnessInfo id_info of
1517 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1520 ------------ Unfolding --------------
1521 unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
1522 loop_breaker = isNonRuleLoopBreaker (occInfo id_info)
1524 ------------ Inline prag --------------
1525 inline_prag = inlinePragInfo id_info
1526 inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1527 | otherwise = Just (HsInline inline_prag)
1529 --------------------------
1530 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
1531 toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
1532 , uf_src = src, uf_guidance = guidance })
1533 = Just $ HsUnfold lb $
1537 UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok if_rhs
1538 _other -> IfCoreUnfold True if_rhs
1539 InlineWrapper w | isExternalName n -> IfExtWrapper arity n
1540 | otherwise -> IfLclWrapper arity (getFS n)
1543 InlineCompulsory -> IfCompulsory if_rhs
1544 InlineRhs -> IfCoreUnfold False if_rhs
1545 -- Yes, even if guidance is UnfNever, expose the unfolding
1546 -- If we didn't want to expose the unfolding, TidyPgm would
1547 -- have stuck in NoUnfolding. For supercompilation we want
1548 -- to see that unfolding!
1550 if_rhs = toIfaceExpr rhs
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,
1570 = IfaceRule { ifRuleName = name, ifActivation = act,
1571 ifRuleBndrs = map toIfaceBndr bndrs,
1573 ifRuleArgs = map do_arg args,
1574 ifRuleRhs = toIfaceExpr rhs,
1578 -- For type args we must remove synonyms from the outermost
1579 -- level. Reason: so that when we read it back in we'll
1580 -- construct the same ru_rough field as we have right now;
1582 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1583 do_arg arg = toIfaceExpr arg
1585 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1586 -- A rule is an orphan only if none of the variables
1587 -- mentioned on its left-hand side are locally defined
1588 lhs_names = fn : nameSetToList (exprsFreeNames args)
1589 -- No need to delete bndrs, because
1590 -- exprsFreeNames finds only External names
1592 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1593 (n : _) -> Just (nameOccName n)
1596 bogusIfaceRule :: Name -> IfaceRule
1597 bogusIfaceRule id_name
1598 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1599 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1600 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing, ifRuleAuto = True }
1602 ---------------------
1603 toIfaceExpr :: CoreExpr -> IfaceExpr
1604 toIfaceExpr (Var v) = toIfaceVar v
1605 toIfaceExpr (Lit l) = IfaceLit l
1606 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1607 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1608 toIfaceExpr (App f a) = toIfaceApp f [a]
1609 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1610 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1611 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1612 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1614 ---------------------
1615 toIfaceNote :: Note -> IfaceNote
1616 toIfaceNote (SCC cc) = IfaceSCC cc
1617 toIfaceNote (CoreNote s) = IfaceCoreNote s
1619 ---------------------
1620 toIfaceBind :: Bind Id -> IfaceBinding
1621 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1622 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1624 ---------------------
1625 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1626 -> (IfaceConAlt, [FastString], IfaceExpr)
1627 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1629 ---------------------
1630 toIfaceCon :: AltCon -> IfaceConAlt
1631 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1632 | otherwise = IfaceDataAlt (getName dc)
1634 tc = dataConTyCon dc
1636 toIfaceCon (LitAlt l) = IfaceLitAlt l
1637 toIfaceCon DEFAULT = IfaceDefault
1639 ---------------------
1640 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1641 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1642 toIfaceApp (Var v) as
1643 = case isDataConWorkId_maybe v of
1644 -- We convert the *worker* for tuples into IfaceTuples
1645 Just dc | isTupleTyCon tc && saturated
1646 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1648 val_args = dropWhile isTypeArg as
1649 saturated = val_args `lengthIs` idArity v
1650 tup_args = map toIfaceExpr val_args
1651 tc = dataConTyCon dc
1653 _ -> mkIfaceApps (toIfaceVar v) as
1655 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1657 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1658 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1660 ---------------------
1661 toIfaceVar :: Id -> IfaceExpr
1663 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1664 -- Foreign calls have special syntax
1665 | isExternalName name = IfaceExt name
1666 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1668 | otherwise = IfaceLcl (getFS name)