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 -- This instance is used only to compute fingerprints
664 instance Binary IfaceDeclExtras where
665 get _bh = panic "no get for IfaceDeclExtras"
666 put_ bh (IfaceIdExtras fix rules) = do
667 putByte bh 1; put_ bh fix; put_ bh rules
668 put_ bh (IfaceDataExtras fix insts cons) = do
669 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
670 put_ bh (IfaceClassExtras fix insts methods) = do
671 putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
672 put_ bh (IfaceSynExtras fix) = do
673 putByte bh 4; put_ bh fix
674 put_ bh IfaceOtherDeclExtras = do
677 declExtras :: (OccName -> Fixity)
678 -> OccEnv [IfaceRule]
679 -> OccEnv [IfaceInst]
683 declExtras fix_fn rule_env inst_env decl
685 IfaceId{} -> IfaceIdExtras (fix_fn n)
686 (lookupOccEnvL rule_env n)
687 IfaceData{ifCons=cons} ->
688 IfaceDataExtras (fix_fn n)
689 (map IfaceInstABI $ lookupOccEnvL inst_env n)
690 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
691 IfaceClass{ifSigs=sigs} ->
692 IfaceClassExtras (fix_fn n)
693 (map IfaceInstABI $ lookupOccEnvL inst_env n)
694 [id_extras op | IfaceClassOp op _ _ <- sigs]
695 IfaceSyn{} -> IfaceSynExtras (fix_fn n)
696 _other -> IfaceOtherDeclExtras
699 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
702 -- When hashing an instance, we hash only its structure, not the
703 -- fingerprints of the things it mentions. See the section on instances
704 -- in the commentary,
705 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
707 newtype IfaceInstABI = IfaceInstABI IfaceInst
709 instance Binary IfaceInstABI where
710 get = panic "no get for IfaceInstABI"
711 put_ bh (IfaceInstABI inst) = do
712 let ud = getUserData bh
713 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
716 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
717 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
719 -- used when we want to fingerprint a structure without depending on the
720 -- fingerprints of external Names that it refers to.
721 putNameLiterally :: BinHandle -> Name -> IO ()
722 putNameLiterally bh name = ASSERT( isExternalName name )
723 do { put_ bh $! nameModule name
724 ; put_ bh $! nameOccName name }
726 computeFingerprint :: Binary a
728 -> (BinHandle -> Name -> IO ())
732 computeFingerprint _dflags put_name a = do
733 bh <- openBinMem (3*1024) -- just less than a block
734 ud <- newWriteState put_name putFS
735 bh <- return $ setUserData bh ud
740 -- for testing: use the md5sum command to generate fingerprints and
741 -- compare the results against our built-in version.
742 fp' <- oldMD5 dflags bh
743 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
746 oldMD5 dflags bh = do
747 tmp <- newTempName dflags "bin"
749 tmp2 <- newTempName dflags "md5"
750 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
753 ExitFailure _ -> ghcError (PhaseFailed cmd r)
755 hash_str <- readFile tmp2
756 return $! readHexFingerprint hash_str
759 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
760 instOrphWarn unqual inst
761 = mkWarnMsg (getSrcSpan inst) unqual $
762 hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
764 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
765 ruleOrphWarn unqual mod rule
766 = mkWarnMsg silly_loc unqual $
767 ptext (sLit "Orphan rule:") <+> ppr rule
769 silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
770 -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
771 -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
773 ----------------------
774 -- mkOrphMap partitions instance decls or rules into
775 -- (a) an OccEnv for ones that are not orphans,
776 -- mapping the local OccName to a list of its decls
777 -- (b) a list of orphan decls
778 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
779 -- Nothing for an orphan decl
780 -> [decl] -- Sorted into canonical order
781 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
782 -- each sublist in canonical order
783 [decl]) -- Orphan decls; in canonical order
784 mkOrphMap get_key decls
785 = foldl go (emptyOccEnv, []) decls
787 go (non_orphs, orphs) d
788 | Just occ <- get_key d
789 = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
790 | otherwise = (non_orphs, d:orphs)
794 %************************************************************************
796 Keeping track of what we've slurped, and fingerprints
798 %************************************************************************
801 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
802 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
803 = do { eps <- hscEPS hsc_env
804 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
805 dir_imp_mods used_names
806 ; usages `seqList` return usages }
807 -- seq the list of Usages returned: occasionally these
808 -- don't get evaluated for a while and we can end up hanging on to
809 -- the entire collection of Ifaces.
811 mk_usage_info :: PackageIfaceTable
817 mk_usage_info pit hsc_env this_mod direct_imports used_names
818 = mapCatMaybes mkUsage usage_mods
820 hpt = hsc_HPT hsc_env
821 dflags = hsc_dflags hsc_env
822 this_pkg = thisPackage dflags
824 used_mods = moduleEnvKeys ent_map
825 dir_imp_mods = (moduleEnvKeys direct_imports)
826 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
827 usage_mods = sortBy stableModuleCmp all_mods
828 -- canonical order is imported, to avoid interface-file
831 -- ent_map groups together all the things imported and used
832 -- from a particular module
833 ent_map :: ModuleEnv [OccName]
834 ent_map = foldNameSet add_mv emptyModuleEnv used_names
837 | isWiredInName name = mv_map -- ignore wired-in names
839 = case nameModule_maybe name of
840 Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
841 Just mod -> -- We use this fiddly lambda function rather than
842 -- (++) as the argument to extendModuleEnv_C to
843 -- avoid quadratic behaviour (trac #2680)
844 extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
845 where occ = nameOccName name
847 -- We want to create a Usage for a home module if
848 -- a) we used something from it; has something in used_names
849 -- b) we imported it, even if we used nothing from it
850 -- (need to recompile if its export list changes: export_fprint)
851 mkUsage :: Module -> Maybe Usage
853 | isNothing maybe_iface -- We can't depend on it if we didn't
854 -- load its interface.
855 || mod == this_mod -- We don't care about usages of
856 -- things in *this* module
859 | modulePackageId mod /= this_pkg
860 = Just UsagePackageModule{ usg_mod = mod,
861 usg_mod_hash = mod_hash }
862 -- for package modules, we record the module hash only
865 && isNothing export_hash
866 && not is_direct_import
868 = Nothing -- Record no usage info
869 -- for directly-imported modules, we always want to record a usage
870 -- on the orphan hash. This is what triggers a recompilation if
871 -- an orphan is added or removed somewhere below us in the future.
874 = Just UsageHomeModule {
875 usg_mod_name = moduleName mod,
876 usg_mod_hash = mod_hash,
877 usg_exports = export_hash,
878 usg_entities = fmToList ent_hashs }
880 maybe_iface = lookupIfaceByModule dflags hpt pit mod
881 -- In one-shot mode, the interfaces for home-package
882 -- modules accumulate in the PIT not HPT. Sigh.
884 is_direct_import = mod `elemModuleEnv` direct_imports
886 Just iface = maybe_iface
887 finsts_mod = mi_finsts iface
888 hash_env = mi_hash_fn iface
889 mod_hash = mi_mod_hash iface
890 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
891 | otherwise = Nothing
893 used_occs = lookupModuleEnv ent_map mod `orElse` []
895 -- Making a FiniteMap here ensures that (a) we remove duplicates
896 -- when we have usages on several subordinates of a single parent,
897 -- and (b) that the usages emerge in a canonical order, which
898 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
899 -- using Ord on the OccNames, which is a lexicographic ordering.
900 ent_hashs :: FiniteMap OccName Fingerprint
901 ent_hashs = listToFM (map lookup_occ used_occs)
905 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
908 depend_on_exports mod =
909 case lookupModuleEnv direct_imports mod of
911 -- Even if we used 'import M ()', we have to register a
912 -- usage on the export list because we are sensitive to
913 -- changes in orphan instances/rules.
915 -- In GHC 6.8.x the above line read "True", and in
916 -- fact it recorded a dependency on *all* the
917 -- modules underneath in the dependency tree. This
918 -- happens to make orphans work right, but is too
919 -- expensive: it'll read too many interface files.
920 -- The 'isNothing maybe_iface' check above saved us
921 -- from generating many of these usages (at least in
922 -- one-shot mode), but that's even more bogus!
926 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
927 mkIfaceAnnotations = map mkIfaceAnnotation
929 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
930 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
931 ifAnnotatedTarget = fmap nameOccName target,
932 ifAnnotatedValue = serialized
937 mkIfaceExports :: [AvailInfo]
938 -> [(Module, [GenAvailInfo OccName])]
939 -- Group by module and sort by occurrence
940 mkIfaceExports exports
941 = [ (mod, eltsFM avails)
942 | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
943 (moduleEnvToList groupFM)
944 -- NB. the fmToList is in a random order,
945 -- because Ord Module is not a predictable
946 -- ordering. Hence we perform a final sort
947 -- using the stable Module ordering.
950 -- Group by the module where the exported entities are defined
951 -- (which may not be the same for all Names in an Avail)
952 -- Deliberately use FiniteMap rather than UniqFM so we
953 -- get a canonical ordering
954 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
955 groupFM = foldl add emptyModuleEnv exports
957 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
958 -> Module -> GenAvailInfo OccName
959 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
960 add_one env mod avail
961 = extendModuleEnv_C plusFM env mod
962 (unitFM (occNameFS (availName avail)) avail)
964 -- NB: we should not get T(X) and T(Y) in the export list
965 -- else the plusFM will simply discard one! They
966 -- should have been combined by now.
968 = ASSERT( isExternalName n )
969 add_one env (nameModule n) (Avail (nameOccName n))
971 add env (AvailTC tc ns)
972 = ASSERT( all isExternalName ns )
973 foldl add_for_mod env mods
975 tc_occ = nameOccName tc
976 mods = nub (map nameModule ns)
977 -- Usually just one, but see Note [Original module]
980 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
981 -- NB. sort the children, we need a canonical order
983 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
986 Note [Orignal module]
987 ~~~~~~~~~~~~~~~~~~~~~
989 module X where { data family T }
990 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
991 The exported Avail from Y will look like
994 - only MkT is brought into scope by the data instance;
995 - but the parent (used for grouping and naming in T(..) exports) is X.T
996 - and in this case we export X.T too
998 In the result of MkIfaceExports, the names are grouped by defining module,
999 so we may need to split up a single Avail into multiple ones.
1002 %************************************************************************
1004 Load the old interface file for this module (unless
1005 we have it aleady), and check whether it is up to date
1008 %************************************************************************
1011 checkOldIface :: HscEnv
1013 -> Bool -- Source unchanged
1014 -> Maybe ModIface -- Old interface from compilation manager, if any
1015 -> IO (RecompileRequired, Maybe ModIface)
1017 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1018 = do { showPass (hsc_dflags hsc_env)
1019 ("Checking old interface for " ++
1020 showSDoc (ppr (ms_mod mod_summary))) ;
1022 ; initIfaceCheck hsc_env $
1023 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1026 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1027 -> IfG (Bool, Maybe ModIface)
1028 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1029 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
1030 { when (not source_unchanged)
1031 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1033 -- If the source has changed and we're in interactive mode, avoid reading
1034 -- an interface; just return the one we might have been supplied with.
1035 ; let dflags = hsc_dflags hsc_env
1036 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1037 return (outOfDate, maybe_iface)
1039 case maybe_iface of {
1040 Just old_iface -> do -- Use the one we already have
1041 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1042 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1043 ; return (recomp, Just old_iface) }
1047 -- Try and read the old interface for the current module
1048 -- from the .hi file left from the last time we compiled it
1049 { let iface_path = msHiFilePath mod_summary
1050 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1051 ; case read_result of {
1052 Failed err -> do -- Old interface file not found, or garbled; give up
1053 { traceIf (text "FYI: cannot read old interface file:"
1055 ; return (outOfDate, Nothing) }
1057 ; Succeeded iface -> do
1059 -- We have got the old iface; check its versions
1060 { traceIf (text "Read the interface file" <+> text iface_path)
1061 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1062 ; return (recomp, Just iface)
1067 @recompileRequired@ is called from the HscMain. It checks whether
1068 a recompilation is required. It needs access to the persistent state,
1069 finder, etc, because it may have to load lots of interface files to
1070 check their versions.
1073 type RecompileRequired = Bool
1074 upToDate, outOfDate :: Bool
1075 upToDate = False -- Recompile not required
1076 outOfDate = True -- Recompile required
1078 checkVersions :: HscEnv
1079 -> Bool -- True <=> source unchanged
1081 -> ModIface -- Old interface
1082 -> IfG RecompileRequired
1083 checkVersions hsc_env source_unchanged mod_summary iface
1084 | not source_unchanged
1087 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1088 ppr (mi_module iface) <> colon)
1090 ; recomp <- checkDependencies hsc_env mod_summary iface
1091 ; if recomp then return outOfDate else do {
1093 -- Source code unchanged and no errors yet... carry on
1095 -- First put the dependent-module info, read from the old
1096 -- interface, into the envt, so that when we look for
1097 -- interfaces we look for the right one (.hi or .hi-boot)
1099 -- It's just temporary because either the usage check will succeed
1100 -- (in which case we are done with this module) or it'll fail (in which
1101 -- case we'll compile the module from scratch anyhow).
1103 -- We do this regardless of compilation mode, although in --make mode
1104 -- all the dependent modules should be in the HPT already, so it's
1106 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1108 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1109 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1112 -- This is a bit of a hack really
1113 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1114 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1117 -- If the direct imports of this module are resolved to targets that
1118 -- are not among the dependencies of the previous interface file,
1119 -- then we definitely need to recompile. This catches cases like
1120 -- - an exposed package has been upgraded
1121 -- - we are compiling with different package flags
1122 -- - a home module that was shadowing a package module has been removed
1123 -- - a new home module has been added that shadows a package module
1126 -- Returns True if recompilation is required.
1127 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1128 checkDependencies hsc_env summary iface
1129 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1131 prev_dep_mods = dep_mods (mi_deps iface)
1132 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1134 this_pkg = thisPackage (hsc_dflags hsc_env)
1136 orM = foldr f (return False)
1137 where f m rest = do b <- m; if b then return True else rest
1139 dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
1140 find_res <- liftIO $ findImportedModule hsc_env mod pkg
1144 -> if moduleName mod `notElem` map fst prev_dep_mods
1145 then do traceHiDiffs $
1146 text "imported module " <> quotes (ppr mod) <>
1147 text " not among previous dependencies"
1152 -> if pkg `notElem` prev_dep_pkgs
1153 then do traceHiDiffs $
1154 text "imported module " <> quotes (ppr mod) <>
1155 text " is from package " <> quotes (ppr pkg) <>
1156 text ", which is not among previous dependencies"
1160 where pkg = modulePackageId mod
1161 _otherwise -> return outOfDate
1163 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1164 -> IfG RecompileRequired
1165 needInterface mod continue
1166 = do -- Load the imported interface if possible
1167 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1168 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1170 mb_iface <- loadInterface doc_str mod ImportBySystem
1171 -- Load the interface, but don't complain on failure;
1172 -- Instead, get an Either back which we can test
1175 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1177 -- Couldn't find or parse a module mentioned in the
1178 -- old interface file. Don't complain: it might
1179 -- just be that the current module doesn't need that
1180 -- import and it's been deleted
1181 Succeeded iface -> continue iface
1184 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1185 -- Given the usage information extracted from the old
1186 -- M.hi file for the module being compiled, figure out
1187 -- whether M needs to be recompiled.
1189 checkModUsage _this_pkg UsagePackageModule{
1191 usg_mod_hash = old_mod_hash }
1192 = needInterface mod $ \iface -> do
1193 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1194 -- We only track the ABI hash of package modules, rather than
1195 -- individual entity usages, so if the ABI hash changes we must
1196 -- recompile. This is safe but may entail more recompilation when
1197 -- a dependent package has changed.
1199 checkModUsage this_pkg UsageHomeModule{
1200 usg_mod_name = mod_name,
1201 usg_mod_hash = old_mod_hash,
1202 usg_exports = maybe_old_export_hash,
1203 usg_entities = old_decl_hash }
1205 let mod = mkModule this_pkg mod_name
1206 needInterface mod $ \iface -> do
1209 new_mod_hash = mi_mod_hash iface
1210 new_decl_hash = mi_hash_fn iface
1211 new_export_hash = mi_exp_hash iface
1214 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1215 if not recompile then return upToDate else do
1217 -- CHECK EXPORT LIST
1218 checkMaybeHash maybe_old_export_hash new_export_hash
1219 (ptext (sLit " Export list changed")) $ do
1221 -- CHECK ITEMS ONE BY ONE
1222 recompile <- checkList [ checkEntityUsage new_decl_hash u
1223 | u <- old_decl_hash]
1225 then return outOfDate -- This one failed, so just bail out now
1226 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1228 ------------------------
1229 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1230 checkModuleFingerprint old_mod_hash new_mod_hash
1231 | new_mod_hash == old_mod_hash
1232 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1235 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1236 old_mod_hash new_mod_hash
1238 ------------------------
1239 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1240 -> IfG RecompileRequired -> IfG RecompileRequired
1241 checkMaybeHash maybe_old_hash new_hash doc continue
1242 | Just hash <- maybe_old_hash, hash /= new_hash
1243 = out_of_date_hash doc hash new_hash
1247 ------------------------
1248 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1249 -> (OccName, Fingerprint)
1251 checkEntityUsage new_hash (name,old_hash)
1252 = case new_hash name of
1254 Nothing -> -- We used it before, but it ain't there now
1255 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1257 Just (_, new_hash) -- It's there, but is it up to date?
1258 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1260 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1263 up_to_date, out_of_date :: SDoc -> IfG Bool
1264 up_to_date msg = traceHiDiffs msg >> return upToDate
1265 out_of_date msg = traceHiDiffs msg >> return outOfDate
1267 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1268 out_of_date_hash msg old_hash new_hash
1269 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1271 ----------------------
1272 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1273 -- This helper is used in two places
1274 checkList [] = return upToDate
1275 checkList (check:checks) = do recompile <- check
1277 then return outOfDate
1278 else checkList checks
1281 %************************************************************************
1283 Converting things to their Iface equivalents
1285 %************************************************************************
1288 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1289 -- Assumption: the thing is already tidied, so that locally-bound names
1290 -- (lambdas, for-alls) already have non-clashing OccNames
1291 -- Reason: Iface stuff uses OccNames, and the conversion here does
1292 -- not do tidying on the way
1293 tyThingToIfaceDecl (AnId id)
1294 = IfaceId { ifName = getOccName id,
1295 ifType = toIfaceType (idType id),
1296 ifIdDetails = toIfaceIdDetails (idDetails id),
1299 info = case toIfaceIdInfo (idInfo id) of
1301 items -> HasInfo items
1303 tyThingToIfaceDecl (AClass clas)
1304 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1305 ifName = getOccName clas,
1306 ifTyVars = toIfaceTvBndrs clas_tyvars,
1307 ifFDs = map toIfaceFD clas_fds,
1308 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1309 ifSigs = map toIfaceClassOp op_stuff,
1310 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1312 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1313 = classExtraBigSig clas
1314 tycon = classTyCon clas
1316 toIfaceClassOp (sel_id, def_meth)
1317 = ASSERT(sel_tyvars == clas_tyvars)
1318 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1320 -- Be careful when splitting the type, because of things
1321 -- like class Foo a where
1322 -- op :: (?x :: String) => a -> a
1323 -- and class Baz a where
1324 -- op :: (Ord a) => a -> a
1325 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1326 op_ty = funResultTy rho_ty
1328 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1330 tyThingToIfaceDecl (ATyCon tycon)
1332 = IfaceSyn { ifName = getOccName tycon,
1333 ifTyVars = toIfaceTvBndrs tyvars,
1336 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1340 = IfaceData { ifName = getOccName tycon,
1341 ifTyVars = toIfaceTvBndrs tyvars,
1342 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1343 ifCons = ifaceConDecls (algTyConRhs tycon),
1344 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1345 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1346 ifGeneric = tyConHasGenerics tycon,
1347 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1349 | isForeignTyCon tycon
1350 = IfaceForeign { ifName = getOccName tycon,
1351 ifExtName = tyConExtName tycon }
1353 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1355 tyvars = tyConTyVars tycon
1357 = case synTyConRhs tycon of
1358 OpenSynTyCon ki _ -> (Nothing, toIfaceType ki)
1359 SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1361 ifaceConDecls (NewTyCon { data_con = con }) =
1362 IfNewTyCon (ifaceConDecl con)
1363 ifaceConDecls (DataTyCon { data_cons = cons }) =
1364 IfDataTyCon (map ifaceConDecl cons)
1365 ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
1366 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1367 -- The last case happens when a TyCon has been trimmed during tidying
1368 -- Furthermore, tyThingToIfaceDecl is also used
1369 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1370 -- AbstractTyCon case is perfectly sensible.
1372 ifaceConDecl data_con
1373 = IfCon { ifConOcc = getOccName (dataConName data_con),
1374 ifConInfix = dataConIsInfix data_con,
1375 ifConWrapper = isJust (dataConWrapId_maybe data_con),
1376 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1377 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1378 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1379 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1380 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1381 ifConFields = map getOccName
1382 (dataConFieldLabels data_con),
1383 ifConStricts = dataConStrictMarks data_con }
1385 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1387 famInstToIface Nothing = Nothing
1388 famInstToIface (Just (famTyCon, instTys)) =
1389 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1391 tyThingToIfaceDecl (ADataCon dc)
1392 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1395 getFS :: NamedThing a => a -> FastString
1396 getFS x = occNameFS (getOccName x)
1398 --------------------------
1399 instanceToIfaceInst :: Instance -> IfaceInst
1400 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1401 is_cls = cls_name, is_tcs = mb_tcs })
1402 = ASSERT( cls_name == className cls )
1403 IfaceInst { ifDFun = dfun_name,
1405 ifInstCls = cls_name,
1406 ifInstTys = map do_rough mb_tcs,
1409 do_rough Nothing = Nothing
1410 do_rough (Just n) = Just (toIfaceTyCon_name n)
1412 dfun_name = idName dfun_id
1413 mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1414 is_local name = nameIsLocalOrFrom mod name
1416 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1417 (_, cls, tys) = tcSplitDFunTy (idType dfun_id)
1418 -- Slightly awkward: we need the Class to get the fundeps
1419 (tvs, fds) = classTvsFds cls
1420 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1421 orph | is_local cls_name = Just (nameOccName cls_name)
1422 | all isJust mb_ns = ASSERT( not (null mb_ns) ) head mb_ns
1423 | otherwise = Nothing
1425 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1426 -- that is not in the "determined" arguments
1427 mb_ns | null fds = [choose_one arg_names]
1428 | otherwise = map do_one fds
1429 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1430 , not (tv `elem` rtvs)]
1432 choose_one :: [NameSet] -> Maybe OccName
1433 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1435 (n : _) -> Just (nameOccName n)
1437 --------------------------
1438 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1439 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1442 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1443 , ifFamInstFam = fam
1444 , ifFamInstTys = map do_rough mb_tcs }
1446 do_rough Nothing = Nothing
1447 do_rough (Just n) = Just (toIfaceTyCon_name n)
1449 --------------------------
1450 toIfaceLetBndr :: Id -> IfaceLetBndr
1451 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1452 (toIfaceType (idType id))
1455 -- Stripped-down version of tcIfaceIdInfo
1456 -- Change this if you want to export more IdInfo for
1457 -- non-top-level Ids. Don't forget to change
1458 -- CoreTidy.tidyLetBndr too!
1460 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1462 inline_prag = inlinePragInfo id_info
1463 prag_info | isDefaultInlinePragma inline_prag = NoInfo
1464 | otherwise = HasInfo [HsInline inline_prag]
1466 --------------------------
1467 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
1468 toIfaceIdDetails VanillaId = IfVanillaId
1469 toIfaceIdDetails (DFunId {}) = IfDFunId
1470 toIfaceIdDetails (RecSelId { sel_naughty = n
1471 , sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
1472 toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
1473 IfVanillaId -- Unexpected
1475 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1476 toIfaceIdInfo id_info
1477 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1478 inline_hsinfo, unfold_hsinfo]
1479 -- NB: strictness must be before unfolding
1480 -- See TcIface.tcUnfolding
1482 ------------ Arity --------------
1483 arity_info = arityInfo id_info
1484 arity_hsinfo | arity_info == 0 = Nothing
1485 | otherwise = Just (HsArity arity_info)
1487 ------------ Caf Info --------------
1488 caf_info = cafInfo id_info
1489 caf_hsinfo = case caf_info of
1490 NoCafRefs -> Just HsNoCafRefs
1493 ------------ Strictness --------------
1494 -- No point in explicitly exporting TopSig
1495 strict_hsinfo = case strictnessInfo id_info of
1496 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1499 ------------ Unfolding --------------
1500 unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
1501 loop_breaker = isNonRuleLoopBreaker (occInfo id_info)
1503 ------------ Inline prag --------------
1504 inline_prag = inlinePragInfo id_info
1505 inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1506 | otherwise = Just (HsInline inline_prag)
1508 --------------------------
1509 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
1510 toIfUnfolding lb unf@(CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
1511 , uf_src = src, uf_guidance = guidance })
1512 = Just $ HsUnfold lb $
1516 UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok (toIfaceExpr rhs)
1517 _other -> pprPanic "toIfUnfolding" (ppr unf)
1518 InlineWrapper w -> IfWrapper arity (idName w)
1519 InlineCompulsory -> IfCompulsory (toIfaceExpr rhs)
1520 InlineRhs -> IfCoreUnfold (toIfaceExpr rhs)
1521 -- Yes, even if guidance is UnfNever, expose the unfolding
1522 -- If we didn't want to expose the unfolding, TidyPgm would
1523 -- have stuck in NoUnfolding. For supercompilation we want
1524 -- to see that unfolding!
1526 toIfUnfolding lb (DFunUnfolding _con ops)
1527 = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
1528 -- No need to serialise the data constructor;
1529 -- we can recover it from the type of the dfun
1534 --------------------------
1535 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1536 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1537 = pprTrace "toHsRule: builtin" (ppr fn) $
1540 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1541 ru_act = act, ru_bndrs = bndrs,
1542 ru_args = args, ru_rhs = rhs })
1543 = IfaceRule { ifRuleName = name, ifActivation = act,
1544 ifRuleBndrs = map toIfaceBndr bndrs,
1546 ifRuleArgs = map do_arg args,
1547 ifRuleRhs = toIfaceExpr rhs,
1550 -- For type args we must remove synonyms from the outermost
1551 -- level. Reason: so that when we read it back in we'll
1552 -- construct the same ru_rough field as we have right now;
1554 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1555 do_arg arg = toIfaceExpr arg
1557 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1558 -- A rule is an orphan only if none of the variables
1559 -- mentioned on its left-hand side are locally defined
1560 lhs_names = fn : nameSetToList (exprsFreeNames args)
1561 -- No need to delete bndrs, because
1562 -- exprsFreeNames finds only External names
1564 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1565 (n : _) -> Just (nameOccName n)
1568 bogusIfaceRule :: Name -> IfaceRule
1569 bogusIfaceRule id_name
1570 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1571 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1572 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1574 ---------------------
1575 toIfaceExpr :: CoreExpr -> IfaceExpr
1576 toIfaceExpr (Var v) = toIfaceVar v
1577 toIfaceExpr (Lit l) = IfaceLit l
1578 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1579 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1580 toIfaceExpr (App f a) = toIfaceApp f [a]
1581 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1582 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1583 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1584 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1586 ---------------------
1587 toIfaceNote :: Note -> IfaceNote
1588 toIfaceNote (SCC cc) = IfaceSCC cc
1589 toIfaceNote (CoreNote s) = IfaceCoreNote s
1591 ---------------------
1592 toIfaceBind :: Bind Id -> IfaceBinding
1593 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1594 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1596 ---------------------
1597 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1598 -> (IfaceConAlt, [FastString], IfaceExpr)
1599 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1601 ---------------------
1602 toIfaceCon :: AltCon -> IfaceConAlt
1603 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1604 | otherwise = IfaceDataAlt (getName dc)
1606 tc = dataConTyCon dc
1608 toIfaceCon (LitAlt l) = IfaceLitAlt l
1609 toIfaceCon DEFAULT = IfaceDefault
1611 ---------------------
1612 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1613 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1614 toIfaceApp (Var v) as
1615 = case isDataConWorkId_maybe v of
1616 -- We convert the *worker* for tuples into IfaceTuples
1617 Just dc | isTupleTyCon tc && saturated
1618 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1620 val_args = dropWhile isTypeArg as
1621 saturated = val_args `lengthIs` idArity v
1622 tup_args = map toIfaceExpr val_args
1623 tc = dataConTyCon dc
1625 _ -> mkIfaceApps (toIfaceVar v) as
1627 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1629 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1630 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1632 ---------------------
1633 toIfaceVar :: Id -> IfaceExpr
1635 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1636 -- Foreign calls have special syntax
1637 | isExternalName name = IfaceExt name
1638 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1640 | otherwise = IfaceLcl (getFS name)