2 % (c) The University of Glasgow 2006-2008
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
10 mkIface, -- Build a ModIface from a ModGuts,
11 -- including computing version information
15 writeIfaceFile, -- Write the interface file
17 checkOldIface, -- See if recompilation is required, by
18 -- comparing version information
20 tyThingToIfaceDecl -- Converting things to their Iface equivalents
24 -----------------------------------------------
25 Recompilation checking
26 -----------------------------------------------
28 A complete description of how recompilation checking works can be
29 found in the wiki commentary:
31 http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
33 Please read the above page for a top-down description of how this all
34 works. Notes below cover specific issues related to the implementation.
38 * In the mi_usages information in an interface, we record the
39 fingerprint of each free variable of the module
41 * In mkIface, we compute the fingerprint of each exported thing A.f.
42 For each external thing that A.f refers to, we include the fingerprint
43 of the external reference when computing the fingerprint of A.f. So
44 if anything that A.f depends on changes, then A.f's fingerprint will
47 * In checkOldIface we compare the mi_usages for the module with
48 the actual fingerprint for all each thing recorded in mi_usages
51 #include "HsVersions.h"
85 import BasicTypes hiding ( SuccessFlag(..) )
88 import Util hiding ( eqListBy )
100 import System.FilePath
105 %************************************************************************
107 \subsection{Completing an interface}
109 %************************************************************************
113 -> Maybe Fingerprint -- The old fingerprint, if we have it
114 -> ModDetails -- The trimmed, tidied interface
115 -> ModGuts -- Usages, deprecations, etc
117 Maybe (ModIface, -- The new one
118 Bool)) -- True <=> there was an old Iface, and the
119 -- new one is identical, so no need
122 mkIface hsc_env maybe_old_fingerprint mod_details
123 ModGuts{ mg_module = this_mod,
125 mg_used_names = used_names,
127 mg_dir_imps = dir_imp_mods,
128 mg_rdr_env = rdr_env,
129 mg_fix_env = fix_env,
131 mg_hpc_info = hpc_info }
132 = mkIface_ hsc_env maybe_old_fingerprint
133 this_mod is_boot used_names deps rdr_env
134 fix_env warns hpc_info dir_imp_mods mod_details
136 -- | make an interface from the results of typechecking only. Useful
137 -- for non-optimising compilation, or where we aren't generating any
138 -- object code at all ('HscNothing').
140 -> Maybe Fingerprint -- The old fingerprint, if we have it
141 -> ModDetails -- gotten from mkBootModDetails, probably
142 -> TcGblEnv -- Usages, deprecations, etc
143 -> IO (Messages, Maybe (ModIface, Bool))
144 mkIfaceTc hsc_env maybe_old_fingerprint mod_details
145 tc_result@TcGblEnv{ tcg_mod = this_mod,
147 tcg_imports = imports,
148 tcg_rdr_env = rdr_env,
149 tcg_fix_env = fix_env,
151 tcg_hpc = other_hpc_info
154 used_names <- mkUsedNames tc_result
155 deps <- mkDependencies tc_result
156 let hpc_info = emptyHpcInfo other_hpc_info
157 mkIface_ hsc_env maybe_old_fingerprint
158 this_mod (isHsBoot hsc_src) used_names deps rdr_env
159 fix_env warns hpc_info (imp_mods imports) mod_details
162 mkUsedNames :: TcGblEnv -> IO NameSet
164 TcGblEnv{ tcg_inst_uses = dfun_uses_var,
168 dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
169 return (allUses dus `unionNameSets` dfun_uses)
171 mkDependencies :: TcGblEnv -> IO Dependencies
173 TcGblEnv{ tcg_mod = mod,
174 tcg_imports = imports,
178 th_used <- readIORef th_var -- Whether TH is used
180 dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
181 -- M.hi-boot can be in the imp_dep_mods, but we must remove
182 -- it before recording the modules on which this one depends!
183 -- (We want to retain M.hi-boot in imp_dep_mods so that
184 -- loadHiBootInterface can see if M's direct imports depend
185 -- on M.hi-boot, and hence that we should do the hi-boot consistency
188 pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
189 | otherwise = imp_dep_pkgs imports
191 return Deps { dep_mods = sortBy (stableModuleNameCmp `on` fst) dep_mods,
192 dep_pkgs = sortBy stablePackageIdCmp pkgs,
193 dep_orphs = sortBy stableModuleCmp (imp_orphs imports),
194 dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
195 -- sort to get into canonical order
196 -- NB. remember to use lexicographic ordering
198 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
199 -> NameSet -> Dependencies -> GlobalRdrEnv
200 -> NameEnv FixItem -> Warnings -> HpcInfo
203 -> IO (Messages, Maybe (ModIface, Bool))
204 mkIface_ hsc_env maybe_old_fingerprint
205 this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
207 ModDetails{ md_insts = insts,
208 md_fam_insts = fam_insts,
211 md_vect_info = vect_info,
213 md_exports = exports }
214 -- NB: notice that mkIface does not look at the bindings
215 -- only at the TypeEnv. The previous Tidy phase has
216 -- put exactly the info into the TypeEnv that we want
217 -- to expose in the interface
219 = do { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
221 ; let { entities = typeEnvElts type_env ;
222 decls = [ tyThingToIfaceDecl entity
223 | entity <- entities,
224 let name = getName entity,
225 not (isImplicitTyThing entity),
226 -- No implicit Ids and class tycons in the interface file
227 not (isWiredInName name),
228 -- Nor wired-in things; the compiler knows about them anyhow
229 nameIsLocalOrFrom this_mod name ]
230 -- Sigh: see Note [Root-main Id] in TcRnDriver
232 ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
234 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
235 ; iface_insts = map instanceToIfaceInst insts
236 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
237 ; iface_vect_info = flattenVectInfo vect_info
239 ; intermediate_iface = ModIface {
240 mi_module = this_mod,
244 mi_exports = mkIfaceExports exports,
246 -- Sort these lexicographically, so that
247 -- the result is stable across compilations
248 mi_insts = sortLe le_inst iface_insts,
249 mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
250 mi_rules = sortLe le_rule iface_rules,
252 mi_vect_info = iface_vect_info,
254 mi_fixities = fixities,
256 mi_anns = mkIfaceAnnotations anns,
257 mi_globals = Just rdr_env,
259 -- Left out deliberately: filled in by addVersionInfo
260 mi_iface_hash = fingerprint0,
261 mi_mod_hash = fingerprint0,
262 mi_exp_hash = fingerprint0,
263 mi_orphan_hash = fingerprint0,
264 mi_orphan = False, -- Always set by addVersionInfo, but
265 -- it's a strict field, so we can't omit it.
266 mi_finsts = False, -- Ditto
267 mi_decls = deliberatelyOmitted "decls",
268 mi_hash_fn = deliberatelyOmitted "hash_fn",
269 mi_hpc = isHpcUsed hpc_info,
271 -- And build the cached values
272 mi_warn_fn = mkIfaceWarnCache warns,
273 mi_fix_fn = mkIfaceFixCache fixities }
276 ; (new_iface, no_change_at_all)
277 <- {-# SCC "versioninfo" #-}
278 addFingerprints hsc_env maybe_old_fingerprint
279 intermediate_iface decls
281 -- Warn about orphans
282 ; let orph_warnings --- Laziness means no work done unless -fwarn-orphans
283 | dopt Opt_WarnOrphans dflags = rule_warns `unionBags` inst_warns
284 | otherwise = emptyBag
285 errs_and_warns = (orph_warnings, emptyBag)
286 unqual = mkPrintUnqualified dflags rdr_env
287 inst_warns = listToBag [ instOrphWarn unqual d
288 | (d,i) <- insts `zip` iface_insts
289 , isNothing (ifInstOrph i) ]
290 rule_warns = listToBag [ ruleOrphWarn unqual this_mod r
292 , isNothing (ifRuleOrph r) ]
294 ; if errorsFound dflags errs_and_warns
295 then return ( errs_and_warns, Nothing )
298 -- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
301 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
302 (pprModIface new_iface)
304 -- bug #1617: on reload we weren't updating the PrintUnqualified
305 -- correctly. This stems from the fact that the interface had
306 -- not changed, so addVersionInfo returns the old ModIface
307 -- with the old GlobalRdrEnv (mi_globals).
308 ; let final_iface = new_iface{ mi_globals = Just rdr_env }
310 ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
312 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
313 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
314 i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
316 le_occ :: Name -> Name -> Bool
317 -- Compare lexicographically by OccName, *not* by unique, because
318 -- the latter is not stable across compilations
319 le_occ n1 n2 = nameOccName n1 <= nameOccName n2
321 dflags = hsc_dflags hsc_env
322 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
323 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
325 flattenVectInfo (VectInfo { vectInfoVar = vVar
326 , vectInfoTyCon = vTyCon
329 ifaceVectInfoVar = [ Var.varName v
330 | (v, _) <- varEnvElts vVar],
331 ifaceVectInfoTyCon = [ tyConName t
332 | (t, t_v) <- nameEnvElts vTyCon
334 ifaceVectInfoTyConReuse = [ tyConName t
335 | (t, t_v) <- nameEnvElts vTyCon
339 -----------------------------
340 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
341 writeIfaceFile dflags location new_iface
342 = do createDirectoryHierarchy (takeDirectory hi_file_path)
343 writeBinIface dflags hi_file_path new_iface
344 where hi_file_path = ml_hi_file location
347 -- -----------------------------------------------------------------------------
348 -- Look up parents and versions of Names
350 -- This is like a global version of the mi_hash_fn field in each ModIface.
351 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
352 -- the parent and version info.
355 :: HscEnv -- needed to look up versions
356 -> ExternalPackageState -- ditto
357 -> (Name -> Fingerprint)
358 mkHashFun hsc_env eps
361 mod = ASSERT2( isExternalName name, ppr name ) nameModule name
362 occ = nameOccName name
363 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
364 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
366 snd (mi_hash_fn iface occ `orElse`
367 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
369 hpt = hsc_HPT hsc_env
372 -- ---------------------------------------------------------------------------
373 -- Compute fingerprints for the interface
377 -> Maybe Fingerprint -- the old fingerprint, if any
378 -> ModIface -- The new interface (lacking decls)
379 -> [IfaceDecl] -- The new decls
380 -> IO (ModIface, -- Updated interface
381 Bool) -- True <=> no changes at all;
382 -- no need to write Iface
384 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
386 eps <- hscEPS hsc_env
388 -- the ABI of a declaration represents everything that is made
389 -- visible about the declaration that a client can depend on.
390 -- see IfaceDeclABI below.
391 declABI :: IfaceDecl -> IfaceDeclABI
392 declABI decl = (this_mod, decl, extras)
393 where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
395 edges :: [(IfaceDeclABI, Unique, [Unique])]
396 edges = [ (abi, getUnique (ifName decl), out)
398 , let abi = declABI decl
399 , let out = localOccs $ freeNamesDeclABI abi
402 name_module n = ASSERT( isExternalName n ) nameModule n
403 localOccs = map (getUnique . getParent . getOccName)
404 . filter ((== this_mod) . name_module)
406 where getParent occ = lookupOccEnv parent_map occ `orElse` occ
408 -- maps OccNames to their parents in the current module.
409 -- e.g. a reference to a constructor must be turned into a reference
410 -- to the TyCon for the purposes of calculating dependencies.
411 parent_map :: OccEnv OccName
412 parent_map = foldr extend emptyOccEnv new_decls
414 extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
417 -- strongly-connected groups of declarations, in dependency order
418 groups = stronglyConnCompFromEdgedVertices edges
420 global_hash_fn = mkHashFun hsc_env eps
422 -- how to output Names when generating the data to fingerprint.
423 -- Here we want to output the fingerprint for each top-level
424 -- Name, whether it comes from the current module or another
425 -- module. In this way, the fingerprint for a declaration will
426 -- change if the fingerprint for anything it refers to (transitively)
428 mk_put_name :: (OccEnv (OccName,Fingerprint))
429 -> BinHandle -> Name -> IO ()
430 mk_put_name local_env bh name
431 | isWiredInName name = putNameLiterally bh name
432 -- wired-in names don't have fingerprints
434 = ASSERT( isExternalName name )
435 let hash | nameModule name /= this_mod = global_hash_fn name
437 snd (lookupOccEnv local_env (getOccName name)
438 `orElse` pprPanic "urk! lookup local fingerprint"
439 (ppr name)) -- (undefined,fingerprint0))
440 -- This panic indicates that we got the dependency
441 -- analysis wrong, because we needed a fingerprint for
442 -- an entity that wasn't in the environment. To debug
443 -- it, turn the panic into a trace, uncomment the
444 -- pprTraces below, run the compile again, and inspect
445 -- the output and the generated .hi file with
450 -- take a strongly-connected group of declarations and compute
453 fingerprint_group :: (OccEnv (OccName,Fingerprint),
454 [(Fingerprint,IfaceDecl)])
456 -> IO (OccEnv (OccName,Fingerprint),
457 [(Fingerprint,IfaceDecl)])
459 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
460 = do let hash_fn = mk_put_name local_env
462 -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
463 hash <- computeFingerprint dflags hash_fn abi
464 return (extend_hash_env (hash,decl) local_env,
465 (hash,decl) : decls_w_hashes)
467 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
468 = do let decls = map abiDecl abis
469 local_env' = foldr extend_hash_env local_env
470 (zip (repeat fingerprint0) decls)
471 hash_fn = mk_put_name local_env'
472 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
473 let stable_abis = sortBy cmp_abiNames abis
474 -- put the cycle in a canonical order
475 hash <- computeFingerprint dflags hash_fn stable_abis
476 let pairs = zip (repeat hash) decls
477 return (foldr extend_hash_env local_env pairs,
478 pairs ++ decls_w_hashes)
480 extend_hash_env :: (Fingerprint,IfaceDecl)
481 -> OccEnv (OccName,Fingerprint)
482 -> OccEnv (OccName,Fingerprint)
483 extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
486 item = (decl_name, hash)
487 env1 = extendOccEnv env0 decl_name item
488 add_imp bndr env = extendOccEnv env bndr item
491 (local_env, decls_w_hashes) <-
492 foldM fingerprint_group (emptyOccEnv, []) groups
494 -- when calculating fingerprints, we always need to use canonical
495 -- ordering for lists of things. In particular, the mi_deps has various
496 -- lists of modules and suchlike, so put these all in canonical order:
497 let sorted_deps = sortDependencies (mi_deps iface0)
499 -- the export hash of a module depends on the orphan hashes of the
500 -- orphan modules below us in the dependeny tree. This is the way
501 -- that changes in orphans get propagated all the way up the
502 -- dependency tree. We only care about orphan modules in the current
503 -- package, because changes to orphans outside this package will be
504 -- tracked by the usage on the ABI hash of package modules that we import.
505 let orph_mods = filter ((== this_pkg) . modulePackageId)
506 $ dep_orphs sorted_deps
507 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
509 orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
510 (map IfaceInstABI orph_insts, orph_rules, fam_insts)
512 -- the export list hash doesn't depend on the fingerprints of
513 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
514 export_hash <- computeFingerprint dflags putNameLiterally
515 (mi_exports iface0, orphan_hash, dep_orphan_hashes)
517 -- put the declarations in a canonical order, sorted by OccName
518 let sorted_decls = eltsFM $ listToFM $
519 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
521 -- the ABI hash depends on:
527 mod_hash <- computeFingerprint dflags putNameLiterally
528 (map fst sorted_decls,
533 -- The interface hash depends on:
534 -- - the ABI hash, plus
538 iface_hash <- computeFingerprint dflags putNameLiterally
545 no_change_at_all = Just iface_hash == mb_old_fingerprint
547 final_iface = iface0 {
548 mi_mod_hash = mod_hash,
549 mi_iface_hash = iface_hash,
550 mi_exp_hash = export_hash,
551 mi_orphan_hash = orphan_hash,
552 mi_orphan = not (null orph_rules && null orph_insts),
553 mi_finsts = not . null $ mi_fam_insts iface0,
554 mi_decls = sorted_decls,
555 mi_hash_fn = lookupOccEnv local_env }
557 return (final_iface, no_change_at_all)
560 this_mod = mi_module iface0
561 dflags = hsc_dflags hsc_env
562 this_pkg = thisPackage dflags
563 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
564 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
565 -- ToDo: shouldn't we be splitting fam_insts into orphans and
567 fam_insts = mi_fam_insts iface0
568 fix_fn = mi_fix_fn iface0
571 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
572 getOrphanHashes hsc_env mods = do
573 eps <- hscEPS hsc_env
575 hpt = hsc_HPT hsc_env
577 dflags = hsc_dflags hsc_env
579 case lookupIfaceByModule dflags hpt pit mod of
580 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
581 Just iface -> mi_orphan_hash iface
583 return (map get_orph_hash mods)
586 sortDependencies :: Dependencies -> Dependencies
588 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
589 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
590 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
591 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
593 -- The ABI of a declaration consists of:
594 -- the full name of the identifier (inc. module and package, because
595 -- these are used to construct the symbol name by which the
596 -- identifier is known externally).
597 -- the fixity of the identifier
598 -- the declaration itself, as exposed to clients. That is, the
599 -- definition of an Id is included in the fingerprint only if
600 -- it is made available as as unfolding in the interface.
602 -- for classes: instances, fixity & rules for methods
603 -- for datatypes: instances, fixity & rules for constrs
604 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
606 abiDecl :: IfaceDeclABI -> IfaceDecl
607 abiDecl (_, decl, _) = decl
609 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
610 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
611 ifName (abiDecl abi2)
613 freeNamesDeclABI :: IfaceDeclABI -> NameSet
614 freeNamesDeclABI (_mod, decl, extras) =
615 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
618 = IfaceIdExtras Fixity [IfaceRule]
619 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
620 | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
621 | IfaceSynExtras Fixity
622 | IfaceOtherDeclExtras
624 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
625 freeNamesDeclExtras (IfaceIdExtras _ rules)
626 = unionManyNameSets (map freeNamesIfRule rules)
627 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
628 = unionManyNameSets (map freeNamesSub subs)
629 freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
630 = unionManyNameSets (map freeNamesSub subs)
631 freeNamesDeclExtras (IfaceSynExtras _)
633 freeNamesDeclExtras IfaceOtherDeclExtras
636 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
637 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
639 instance Binary IfaceDeclExtras where
640 get _bh = panic "no get for IfaceDeclExtras"
641 put_ bh (IfaceIdExtras fix rules) = do
642 putByte bh 1; put_ bh fix; put_ bh rules
643 put_ bh (IfaceDataExtras fix insts cons) = do
644 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
645 put_ bh (IfaceClassExtras fix insts methods) = do
646 putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
647 put_ bh (IfaceSynExtras fix) = do
648 putByte bh 4; put_ bh fix
649 put_ bh IfaceOtherDeclExtras = do
652 declExtras :: (OccName -> Fixity)
653 -> OccEnv [IfaceRule]
654 -> OccEnv [IfaceInst]
658 declExtras fix_fn rule_env inst_env decl
660 IfaceId{} -> IfaceIdExtras (fix_fn n)
661 (lookupOccEnvL rule_env n)
662 IfaceData{ifCons=cons} ->
663 IfaceDataExtras (fix_fn n)
664 (map IfaceInstABI $ lookupOccEnvL inst_env n)
665 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
666 IfaceClass{ifSigs=sigs} ->
667 IfaceClassExtras (fix_fn n)
668 (map IfaceInstABI $ lookupOccEnvL inst_env n)
669 [id_extras op | IfaceClassOp op _ _ <- sigs]
670 IfaceSyn{} -> IfaceSynExtras (fix_fn n)
671 _other -> IfaceOtherDeclExtras
674 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
677 -- When hashing an instance, we hash only its structure, not the
678 -- fingerprints of the things it mentions. See the section on instances
679 -- in the commentary,
680 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
682 newtype IfaceInstABI = IfaceInstABI IfaceInst
684 instance Binary IfaceInstABI where
685 get = panic "no get for IfaceInstABI"
686 put_ bh (IfaceInstABI inst) = do
687 let ud = getUserData bh
688 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
691 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
692 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
694 -- used when we want to fingerprint a structure without depending on the
695 -- fingerprints of external Names that it refers to.
696 putNameLiterally :: BinHandle -> Name -> IO ()
697 putNameLiterally bh name = ASSERT( isExternalName name )
698 do { put_ bh $! nameModule name
699 ; put_ bh $! nameOccName name }
701 computeFingerprint :: Binary a
703 -> (BinHandle -> Name -> IO ())
707 computeFingerprint _dflags put_name a = do
708 bh <- openBinMem (3*1024) -- just less than a block
709 ud <- newWriteState put_name putFS
710 bh <- return $ setUserData bh ud
715 -- for testing: use the md5sum command to generate fingerprints and
716 -- compare the results against our built-in version.
717 fp' <- oldMD5 dflags bh
718 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
721 oldMD5 dflags bh = do
722 tmp <- newTempName dflags "bin"
724 tmp2 <- newTempName dflags "md5"
725 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
728 ExitFailure _ -> ghcError (PhaseFailed cmd r)
730 hash_str <- readFile tmp2
731 return $! readHexFingerprint hash_str
734 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
735 instOrphWarn unqual inst
736 = mkWarnMsg (getSrcSpan inst) unqual $
737 hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
739 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
740 ruleOrphWarn unqual mod rule
741 = mkWarnMsg silly_loc unqual $
742 ptext (sLit "Orphan rule:") <+> ppr rule
744 silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 0)
745 -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
746 -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
748 ----------------------
749 -- mkOrphMap partitions instance decls or rules into
750 -- (a) an OccEnv for ones that are not orphans,
751 -- mapping the local OccName to a list of its decls
752 -- (b) a list of orphan decls
753 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
754 -- Nothing for an orphan decl
755 -> [decl] -- Sorted into canonical order
756 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
757 -- each sublist in canonical order
758 [decl]) -- Orphan decls; in canonical order
759 mkOrphMap get_key decls
760 = foldl go (emptyOccEnv, []) decls
762 go (non_orphs, orphs) d
763 | Just occ <- get_key d
764 = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
765 | otherwise = (non_orphs, d:orphs)
769 %*********************************************************
771 \subsection{Keeping track of what we've slurped, and fingerprints}
773 %*********************************************************
777 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
778 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
779 = do { eps <- hscEPS hsc_env
780 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
781 dir_imp_mods used_names
782 ; usages `seqList` return usages }
783 -- seq the list of Usages returned: occasionally these
784 -- don't get evaluated for a while and we can end up hanging on to
785 -- the entire collection of Ifaces.
787 mk_usage_info :: PackageIfaceTable
793 mk_usage_info pit hsc_env this_mod direct_imports used_names
794 = mapCatMaybes mkUsage usage_mods
796 hpt = hsc_HPT hsc_env
797 dflags = hsc_dflags hsc_env
798 this_pkg = thisPackage dflags
800 used_mods = moduleEnvKeys ent_map
801 dir_imp_mods = (moduleEnvKeys direct_imports)
802 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
803 usage_mods = sortBy stableModuleCmp all_mods
804 -- canonical order is imported, to avoid interface-file
807 -- ent_map groups together all the things imported and used
808 -- from a particular module
809 ent_map :: ModuleEnv [OccName]
810 ent_map = foldNameSet add_mv emptyModuleEnv used_names
813 | isWiredInName name = mv_map -- ignore wired-in names
815 = case nameModule_maybe name of
816 Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
817 Just mod -> -- We use this fiddly lambda function rather than
818 -- (++) as the argument to extendModuleEnv_C to
819 -- avoid quadratic behaviour (trac #2680)
820 extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
821 where occ = nameOccName name
823 -- We want to create a Usage for a home module if
824 -- a) we used something from it; has something in used_names
825 -- b) we imported it, even if we used nothing from it
826 -- (need to recompile if its export list changes: export_fprint)
827 mkUsage :: Module -> Maybe Usage
829 | isNothing maybe_iface -- We can't depend on it if we didn't
830 -- load its interface.
831 || mod == this_mod -- We don't care about usages of
832 -- things in *this* module
835 | modulePackageId mod /= this_pkg
836 = Just UsagePackageModule{ usg_mod = mod,
837 usg_mod_hash = mod_hash }
838 -- for package modules, we record the module hash only
841 && isNothing export_hash
842 && not is_direct_import
844 = Nothing -- Record no usage info
845 -- for directly-imported modules, we always want to record a usage
846 -- on the orphan hash. This is what triggers a recompilation if
847 -- an orphan is added or removed somewhere below us in the future.
850 = Just UsageHomeModule {
851 usg_mod_name = moduleName mod,
852 usg_mod_hash = mod_hash,
853 usg_exports = export_hash,
854 usg_entities = fmToList ent_hashs }
856 maybe_iface = lookupIfaceByModule dflags hpt pit mod
857 -- In one-shot mode, the interfaces for home-package
858 -- modules accumulate in the PIT not HPT. Sigh.
860 is_direct_import = mod `elemModuleEnv` direct_imports
862 Just iface = maybe_iface
863 finsts_mod = mi_finsts iface
864 hash_env = mi_hash_fn iface
865 mod_hash = mi_mod_hash iface
866 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
867 | otherwise = Nothing
869 used_occs = lookupModuleEnv ent_map mod `orElse` []
871 -- Making a FiniteMap here ensures that (a) we remove duplicates
872 -- when we have usages on several subordinates of a single parent,
873 -- and (b) that the usages emerge in a canonical order, which
874 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
875 -- using Ord on the OccNames, which is a lexicographic ordering.
876 ent_hashs :: FiniteMap OccName Fingerprint
877 ent_hashs = listToFM (map lookup_occ used_occs)
881 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
884 depend_on_exports mod =
885 case lookupModuleEnv direct_imports mod of
887 -- Even if we used 'import M ()', we have to register a
888 -- usage on the export list because we are sensitive to
889 -- changes in orphan instances/rules.
891 -- In GHC 6.8.x the above line read "True", and in
892 -- fact it recorded a dependency on *all* the
893 -- modules underneath in the dependency tree. This
894 -- happens to make orphans work right, but is too
895 -- expensive: it'll read too many interface files.
896 -- The 'isNothing maybe_iface' check above saved us
897 -- from generating many of these usages (at least in
898 -- one-shot mode), but that's even more bogus!
902 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
903 mkIfaceAnnotations = map mkIfaceAnnotation
905 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
906 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
907 ifAnnotatedTarget = fmap nameOccName target,
908 ifAnnotatedValue = serialized
913 mkIfaceExports :: [AvailInfo]
914 -> [(Module, [GenAvailInfo OccName])]
915 -- Group by module and sort by occurrence
916 mkIfaceExports exports
917 = [ (mod, eltsFM avails)
918 | (mod, avails) <- sortBy (stableModuleCmp `on` fst) (fmToList groupFM)
919 -- NB. the fmToList is in a random order,
920 -- because Ord Module is not a predictable
921 -- ordering. Hence we perform a final sort
922 -- using the stable Module ordering.
925 -- Group by the module where the exported entities are defined
926 -- (which may not be the same for all Names in an Avail)
927 -- Deliberately use FiniteMap rather than UniqFM so we
928 -- get a canonical ordering
929 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
930 groupFM = foldl add emptyModuleEnv exports
932 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
933 -> Module -> GenAvailInfo OccName
934 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
935 add_one env mod avail
936 = extendModuleEnv_C plusFM env mod
937 (unitFM (occNameFS (availName avail)) avail)
939 -- NB: we should not get T(X) and T(Y) in the export list
940 -- else the plusFM will simply discard one! They
941 -- should have been combined by now.
943 = ASSERT( isExternalName n )
944 add_one env (nameModule n) (Avail (nameOccName n))
946 add env (AvailTC tc ns)
947 = ASSERT( all isExternalName ns )
948 foldl add_for_mod env mods
950 tc_occ = nameOccName tc
951 mods = nub (map nameModule ns)
952 -- Usually just one, but see Note [Original module]
955 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
956 -- NB. sort the children, we need a canonical order
958 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
961 Note [Orignal module]
962 ~~~~~~~~~~~~~~~~~~~~~
964 module X where { data family T }
965 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
966 The exported Avail from Y will look like
969 - only MkT is brought into scope by the data instance;
970 - but the parent (used for grouping and naming in T(..) exports) is X.T
971 - and in this case we export X.T too
973 In the result of MkIfaceExports, the names are grouped by defining module,
974 so we may need to split up a single Avail into multiple ones.
977 %************************************************************************
979 Load the old interface file for this module (unless
980 we have it aleady), and check whether it is up to date
983 %************************************************************************
986 checkOldIface :: HscEnv
988 -> Bool -- Source unchanged
989 -> Maybe ModIface -- Old interface from compilation manager, if any
990 -> IO (RecompileRequired, Maybe ModIface)
992 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
993 = do { showPass (hsc_dflags hsc_env)
994 ("Checking old interface for " ++
995 showSDoc (ppr (ms_mod mod_summary))) ;
997 ; initIfaceCheck hsc_env $
998 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1001 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1002 -> IfG (Bool, Maybe ModIface)
1003 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1004 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
1005 { when (not source_unchanged)
1006 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1008 -- If the source has changed and we're in interactive mode, avoid reading
1009 -- an interface; just return the one we might have been supplied with.
1010 ; let dflags = hsc_dflags hsc_env
1011 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1012 return (outOfDate, maybe_iface)
1014 case maybe_iface of {
1015 Just old_iface -> do -- Use the one we already have
1016 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1017 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1018 ; return (recomp, Just old_iface) }
1022 -- Try and read the old interface for the current module
1023 -- from the .hi file left from the last time we compiled it
1024 { let iface_path = msHiFilePath mod_summary
1025 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1026 ; case read_result of {
1027 Failed err -> do -- Old interface file not found, or garbled; give up
1028 { traceIf (text "FYI: cannot read old interface file:"
1030 ; return (outOfDate, Nothing) }
1032 ; Succeeded iface -> do
1034 -- We have got the old iface; check its versions
1035 { traceIf (text "Read the interface file" <+> text iface_path)
1036 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1037 ; return (recomp, Just iface)
1042 @recompileRequired@ is called from the HscMain. It checks whether
1043 a recompilation is required. It needs access to the persistent state,
1044 finder, etc, because it may have to load lots of interface files to
1045 check their versions.
1048 type RecompileRequired = Bool
1049 upToDate, outOfDate :: Bool
1050 upToDate = False -- Recompile not required
1051 outOfDate = True -- Recompile required
1053 checkVersions :: HscEnv
1054 -> Bool -- True <=> source unchanged
1056 -> ModIface -- Old interface
1057 -> IfG RecompileRequired
1058 checkVersions hsc_env source_unchanged mod_summary iface
1059 | not source_unchanged
1062 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1063 ppr (mi_module iface) <> colon)
1065 ; recomp <- checkDependencies hsc_env mod_summary iface
1066 ; if recomp then return outOfDate else do {
1068 -- Source code unchanged and no errors yet... carry on
1070 -- First put the dependent-module info, read from the old
1071 -- interface, into the envt, so that when we look for
1072 -- interfaces we look for the right one (.hi or .hi-boot)
1074 -- It's just temporary because either the usage check will succeed
1075 -- (in which case we are done with this module) or it'll fail (in which
1076 -- case we'll compile the module from scratch anyhow).
1078 -- We do this regardless of compilation mode, although in --make mode
1079 -- all the dependent modules should be in the HPT already, so it's
1081 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1083 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1084 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1087 -- This is a bit of a hack really
1088 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1089 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1092 -- If the direct imports of this module are resolved to targets that
1093 -- are not among the dependencies of the previous interface file,
1094 -- then we definitely need to recompile. This catches cases like
1095 -- - an exposed package has been upgraded
1096 -- - we are compiling with different package flags
1097 -- - a home module that was shadowing a package module has been removed
1098 -- - a new home module has been added that shadows a package module
1101 -- Returns True if recompilation is required.
1102 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1103 checkDependencies hsc_env summary iface
1104 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1106 prev_dep_mods = dep_mods (mi_deps iface)
1107 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1109 this_pkg = thisPackage (hsc_dflags hsc_env)
1111 orM = foldr f (return False)
1112 where f m rest = do b <- m; if b then return True else rest
1114 dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
1115 find_res <- liftIO $ findImportedModule hsc_env mod pkg
1119 -> if moduleName mod `notElem` map fst prev_dep_mods
1120 then do traceHiDiffs $
1121 text "imported module " <> quotes (ppr mod) <>
1122 text " not among previous dependencies"
1127 -> if pkg `notElem` prev_dep_pkgs
1128 then do traceHiDiffs $
1129 text "imported module " <> quotes (ppr mod) <>
1130 text " is from package " <> quotes (ppr pkg) <>
1131 text ", which is not among previous dependencies"
1135 where pkg = modulePackageId mod
1136 _otherwise -> return outOfDate
1138 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1139 -> IfG RecompileRequired
1140 needInterface mod continue
1141 = do -- Load the imported interface if possible
1142 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1143 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1145 mb_iface <- loadInterface doc_str mod ImportBySystem
1146 -- Load the interface, but don't complain on failure;
1147 -- Instead, get an Either back which we can test
1150 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1152 -- Couldn't find or parse a module mentioned in the
1153 -- old interface file. Don't complain: it might
1154 -- just be that the current module doesn't need that
1155 -- import and it's been deleted
1156 Succeeded iface -> continue iface
1159 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1160 -- Given the usage information extracted from the old
1161 -- M.hi file for the module being compiled, figure out
1162 -- whether M needs to be recompiled.
1164 checkModUsage _this_pkg UsagePackageModule{
1166 usg_mod_hash = old_mod_hash }
1167 = needInterface mod $ \iface -> do
1168 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1169 -- We only track the ABI hash of package modules, rather than
1170 -- individual entity usages, so if the ABI hash changes we must
1171 -- recompile. This is safe but may entail more recompilation when
1172 -- a dependent package has changed.
1174 checkModUsage this_pkg UsageHomeModule{
1175 usg_mod_name = mod_name,
1176 usg_mod_hash = old_mod_hash,
1177 usg_exports = maybe_old_export_hash,
1178 usg_entities = old_decl_hash }
1180 let mod = mkModule this_pkg mod_name
1181 needInterface mod $ \iface -> do
1184 new_mod_hash = mi_mod_hash iface
1185 new_decl_hash = mi_hash_fn iface
1186 new_export_hash = mi_exp_hash iface
1189 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1190 if not recompile then return upToDate else do
1192 -- CHECK EXPORT LIST
1193 checkMaybeHash maybe_old_export_hash new_export_hash
1194 (ptext (sLit " Export list changed")) $ do
1196 -- CHECK ITEMS ONE BY ONE
1197 recompile <- checkList [ checkEntityUsage new_decl_hash u
1198 | u <- old_decl_hash]
1200 then return outOfDate -- This one failed, so just bail out now
1201 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1203 ------------------------
1204 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1205 checkModuleFingerprint old_mod_hash new_mod_hash
1206 | new_mod_hash == old_mod_hash
1207 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1210 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1211 old_mod_hash new_mod_hash
1213 ------------------------
1214 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1215 -> IfG RecompileRequired -> IfG RecompileRequired
1216 checkMaybeHash maybe_old_hash new_hash doc continue
1217 | Just hash <- maybe_old_hash, hash /= new_hash
1218 = out_of_date_hash doc hash new_hash
1222 ------------------------
1223 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1224 -> (OccName, Fingerprint)
1226 checkEntityUsage new_hash (name,old_hash)
1227 = case new_hash name of
1229 Nothing -> -- We used it before, but it ain't there now
1230 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1232 Just (_, new_hash) -- It's there, but is it up to date?
1233 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1235 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1238 up_to_date, out_of_date :: SDoc -> IfG Bool
1239 up_to_date msg = traceHiDiffs msg >> return upToDate
1240 out_of_date msg = traceHiDiffs msg >> return outOfDate
1242 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1243 out_of_date_hash msg old_hash new_hash
1244 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1246 ----------------------
1247 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1248 -- This helper is used in two places
1249 checkList [] = return upToDate
1250 checkList (check:checks) = do recompile <- check
1252 then return outOfDate
1253 else checkList checks
1256 %************************************************************************
1258 Converting things to their Iface equivalents
1260 %************************************************************************
1263 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1264 -- Assumption: the thing is already tidied, so that locally-bound names
1265 -- (lambdas, for-alls) already have non-clashing OccNames
1266 -- Reason: Iface stuff uses OccNames, and the conversion here does
1267 -- not do tidying on the way
1268 tyThingToIfaceDecl (AnId id)
1269 = IfaceId { ifName = getOccName id,
1270 ifType = toIfaceType (idType id),
1271 ifIdDetails = toIfaceIdDetails (idDetails id),
1274 info = case toIfaceIdInfo (idInfo id) of
1276 items -> HasInfo items
1278 tyThingToIfaceDecl (AClass clas)
1279 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1280 ifName = getOccName clas,
1281 ifTyVars = toIfaceTvBndrs clas_tyvars,
1282 ifFDs = map toIfaceFD clas_fds,
1283 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1284 ifSigs = map toIfaceClassOp op_stuff,
1285 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1287 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1288 = classExtraBigSig clas
1289 tycon = classTyCon clas
1291 toIfaceClassOp (sel_id, def_meth)
1292 = ASSERT(sel_tyvars == clas_tyvars)
1293 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1295 -- Be careful when splitting the type, because of things
1296 -- like class Foo a where
1297 -- op :: (?x :: String) => a -> a
1298 -- and class Baz a where
1299 -- op :: (Ord a) => a -> a
1300 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1301 op_ty = funResultTy rho_ty
1303 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1305 tyThingToIfaceDecl (ATyCon tycon)
1307 = IfaceSyn { ifName = getOccName tycon,
1308 ifTyVars = toIfaceTvBndrs tyvars,
1311 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1315 = IfaceData { ifName = getOccName tycon,
1316 ifTyVars = toIfaceTvBndrs tyvars,
1317 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1318 ifCons = ifaceConDecls (algTyConRhs tycon),
1319 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1320 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1321 ifGeneric = tyConHasGenerics tycon,
1322 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1324 | isForeignTyCon tycon
1325 = IfaceForeign { ifName = getOccName tycon,
1326 ifExtName = tyConExtName tycon }
1328 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1330 tyvars = tyConTyVars tycon
1332 = case synTyConRhs tycon of
1333 OpenSynTyCon ki _ -> (Nothing, toIfaceType ki)
1334 SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1336 ifaceConDecls (NewTyCon { data_con = con }) =
1337 IfNewTyCon (ifaceConDecl con)
1338 ifaceConDecls (DataTyCon { data_cons = cons }) =
1339 IfDataTyCon (map ifaceConDecl cons)
1340 ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
1341 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1342 -- The last case happens when a TyCon has been trimmed during tidying
1343 -- Furthermore, tyThingToIfaceDecl is also used
1344 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1345 -- AbstractTyCon case is perfectly sensible.
1347 ifaceConDecl data_con
1348 = IfCon { ifConOcc = getOccName (dataConName data_con),
1349 ifConInfix = dataConIsInfix data_con,
1350 ifConWrapper = isJust (dataConWrapId_maybe data_con),
1351 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1352 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1353 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1354 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1355 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1356 ifConFields = map getOccName
1357 (dataConFieldLabels data_con),
1358 ifConStricts = dataConStrictMarks data_con }
1360 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1362 famInstToIface Nothing = Nothing
1363 famInstToIface (Just (famTyCon, instTys)) =
1364 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1366 tyThingToIfaceDecl (ADataCon dc)
1367 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1370 getFS :: NamedThing a => a -> FastString
1371 getFS x = occNameFS (getOccName x)
1373 --------------------------
1374 instanceToIfaceInst :: Instance -> IfaceInst
1375 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1376 is_cls = cls_name, is_tcs = mb_tcs })
1377 = ASSERT( cls_name == className cls )
1378 IfaceInst { ifDFun = dfun_name,
1380 ifInstCls = cls_name,
1381 ifInstTys = map do_rough mb_tcs,
1384 do_rough Nothing = Nothing
1385 do_rough (Just n) = Just (toIfaceTyCon_name n)
1387 dfun_name = idName dfun_id
1388 mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1389 is_local name = nameIsLocalOrFrom mod name
1391 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1392 (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1393 -- Slightly awkward: we need the Class to get the fundeps
1394 (tvs, fds) = classTvsFds cls
1395 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1396 orph | is_local cls_name = Just (nameOccName cls_name)
1397 | all isJust mb_ns = head mb_ns
1398 | otherwise = Nothing
1400 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1401 -- that is not in the "determined" arguments
1402 mb_ns | null fds = [choose_one arg_names]
1403 | otherwise = map do_one fds
1404 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1405 , not (tv `elem` rtvs)]
1407 choose_one :: [NameSet] -> Maybe OccName
1408 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1410 (n : _) -> Just (nameOccName n)
1412 --------------------------
1413 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1414 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1417 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1418 , ifFamInstFam = fam
1419 , ifFamInstTys = map do_rough mb_tcs }
1421 do_rough Nothing = Nothing
1422 do_rough (Just n) = Just (toIfaceTyCon_name n)
1424 --------------------------
1425 toIfaceLetBndr :: Id -> IfaceLetBndr
1426 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1427 (toIfaceType (idType id))
1430 -- Stripped-down version of tcIfaceIdInfo
1431 -- Change this if you want to export more IdInfo for
1432 -- non-top-level Ids. Don't forget to change
1433 -- CoreTidy.tidyLetBndr too!
1435 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1437 inline_prag = inlinePragInfo id_info
1438 prag_info | isDefaultInlinePragma inline_prag = NoInfo
1439 | otherwise = HasInfo [HsInline inline_prag]
1441 --------------------------
1442 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
1443 toIfaceIdDetails VanillaId = IfVanillaId
1444 toIfaceIdDetails DFunId = IfVanillaId
1445 toIfaceIdDetails (RecSelId { sel_naughty = n
1446 , sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
1447 toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
1448 IfVanillaId -- Unexpected
1450 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1451 toIfaceIdInfo id_info
1452 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1453 inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
1455 ------------ Arity --------------
1456 arity_info = arityInfo id_info
1457 arity_hsinfo | arity_info == 0 = Nothing
1458 | otherwise = Just (HsArity arity_info)
1460 ------------ Caf Info --------------
1461 caf_info = cafInfo id_info
1462 caf_hsinfo = case caf_info of
1463 NoCafRefs -> Just HsNoCafRefs
1466 ------------ Strictness --------------
1467 -- No point in explicitly exporting TopSig
1468 strict_hsinfo = case newStrictnessInfo id_info of
1469 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1472 ------------ Worker --------------
1473 work_info = workerInfo id_info
1474 has_worker = workerExists work_info
1475 wrkr_hsinfo = case work_info of
1476 HasWorker work_id wrap_arity ->
1477 Just (HsWorker ((idName work_id)) wrap_arity)
1480 ------------ Unfolding --------------
1481 -- The unfolding is redundant if there is a worker
1482 unfold_info = unfoldingInfo id_info
1483 rhs = unfoldingTemplate unfold_info
1484 no_unfolding = neverUnfold unfold_info
1485 -- The CoreTidy phase retains unfolding info iff
1486 -- we want to expose the unfolding, taking into account
1487 -- unconditional NOINLINE, etc. See TidyPgm.addExternal
1488 unfold_hsinfo | no_unfolding = Nothing
1489 | has_worker = Nothing -- Unfolding is implicit
1490 | otherwise = Just (HsUnfold (toIfaceExpr rhs))
1492 ------------ Inline prag --------------
1493 inline_prag = inlinePragInfo id_info
1494 inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1495 | no_unfolding && not has_worker
1496 && isFunLike (inlinePragmaRuleMatchInfo inline_prag)
1498 -- If the iface file give no unfolding info, we
1499 -- don't need to say when inlining is OK!
1500 | otherwise = Just (HsInline inline_prag)
1502 --------------------------
1503 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1504 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1505 = pprTrace "toHsRule: builtin" (ppr fn) $
1508 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1509 ru_act = act, ru_bndrs = bndrs,
1510 ru_args = args, ru_rhs = rhs })
1511 = IfaceRule { ifRuleName = name, ifActivation = act,
1512 ifRuleBndrs = map toIfaceBndr bndrs,
1514 ifRuleArgs = map do_arg args,
1515 ifRuleRhs = toIfaceExpr rhs,
1518 -- For type args we must remove synonyms from the outermost
1519 -- level. Reason: so that when we read it back in we'll
1520 -- construct the same ru_rough field as we have right now;
1522 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1523 do_arg arg = toIfaceExpr arg
1525 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1526 -- A rule is an orphan only if none of the variables
1527 -- mentioned on its left-hand side are locally defined
1528 lhs_names = fn : nameSetToList (exprsFreeNames args)
1529 -- No need to delete bndrs, because
1530 -- exprsFreeNames finds only External names
1532 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1533 (n : _) -> Just (nameOccName n)
1536 bogusIfaceRule :: Name -> IfaceRule
1537 bogusIfaceRule id_name
1538 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1539 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1540 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1542 ---------------------
1543 toIfaceExpr :: CoreExpr -> IfaceExpr
1544 toIfaceExpr (Var v) = toIfaceVar v
1545 toIfaceExpr (Lit l) = IfaceLit l
1546 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1547 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1548 toIfaceExpr (App f a) = toIfaceApp f [a]
1549 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1550 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1551 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1552 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1554 ---------------------
1555 toIfaceNote :: Note -> IfaceNote
1556 toIfaceNote (SCC cc) = IfaceSCC cc
1557 toIfaceNote InlineMe = IfaceInlineMe
1558 toIfaceNote (CoreNote s) = IfaceCoreNote s
1560 ---------------------
1561 toIfaceBind :: Bind Id -> IfaceBinding
1562 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1563 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1565 ---------------------
1566 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1567 -> (IfaceConAlt, [FastString], IfaceExpr)
1568 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1570 ---------------------
1571 toIfaceCon :: AltCon -> IfaceConAlt
1572 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1573 | otherwise = IfaceDataAlt (getName dc)
1575 tc = dataConTyCon dc
1577 toIfaceCon (LitAlt l) = IfaceLitAlt l
1578 toIfaceCon DEFAULT = IfaceDefault
1580 ---------------------
1581 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1582 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1583 toIfaceApp (Var v) as
1584 = case isDataConWorkId_maybe v of
1585 -- We convert the *worker* for tuples into IfaceTuples
1586 Just dc | isTupleTyCon tc && saturated
1587 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1589 val_args = dropWhile isTypeArg as
1590 saturated = val_args `lengthIs` idArity v
1591 tup_args = map toIfaceExpr val_args
1592 tc = dataConTyCon dc
1594 _ -> mkIfaceApps (toIfaceVar v) as
1596 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1598 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1599 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1601 ---------------------
1602 toIfaceVar :: Id -> IfaceExpr
1604 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1605 -- Foreign calls have special syntax
1606 | isExternalName name = IfaceExt name
1607 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1609 | otherwise = IfaceLcl (getFS name)