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"
87 import BasicTypes hiding ( SuccessFlag(..) )
90 import Util hiding ( eqListBy )
103 import System.FilePath
108 %************************************************************************
110 \subsection{Completing an interface}
112 %************************************************************************
116 -> Maybe Fingerprint -- The old fingerprint, if we have it
117 -> ModDetails -- The trimmed, tidied interface
118 -> ModGuts -- Usages, deprecations, etc
120 Maybe (ModIface, -- The new one
121 Bool)) -- True <=> there was an old Iface, and the
122 -- new one is identical, so no need
125 mkIface hsc_env maybe_old_fingerprint mod_details
126 ModGuts{ mg_module = this_mod,
128 mg_used_names = used_names,
130 mg_dir_imps = dir_imp_mods,
131 mg_rdr_env = rdr_env,
132 mg_fix_env = fix_env,
134 mg_hpc_info = hpc_info }
135 = mkIface_ hsc_env maybe_old_fingerprint
136 this_mod is_boot used_names deps rdr_env
137 fix_env warns hpc_info dir_imp_mods mod_details
139 -- | make an interface from the results of typechecking only. Useful
140 -- for non-optimising compilation, or where we aren't generating any
141 -- object code at all ('HscNothing').
143 -> Maybe Fingerprint -- The old fingerprint, if we have it
144 -> ModDetails -- gotten from mkBootModDetails, probably
145 -> TcGblEnv -- Usages, deprecations, etc
146 -> IO (Messages, Maybe (ModIface, Bool))
147 mkIfaceTc hsc_env maybe_old_fingerprint mod_details
148 tc_result@TcGblEnv{ tcg_mod = this_mod,
150 tcg_imports = imports,
151 tcg_rdr_env = rdr_env,
152 tcg_fix_env = fix_env,
154 tcg_hpc = other_hpc_info
157 used_names <- mkUsedNames tc_result
158 deps <- mkDependencies tc_result
159 let hpc_info = emptyHpcInfo other_hpc_info
160 mkIface_ hsc_env maybe_old_fingerprint
161 this_mod (isHsBoot hsc_src) used_names deps rdr_env
162 fix_env warns hpc_info (imp_mods imports) mod_details
165 mkUsedNames :: TcGblEnv -> IO NameSet
167 TcGblEnv{ tcg_inst_uses = dfun_uses_var,
171 dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
172 return (allUses dus `unionNameSets` dfun_uses)
174 mkDependencies :: TcGblEnv -> IO Dependencies
176 TcGblEnv{ tcg_mod = mod,
177 tcg_imports = imports,
181 th_used <- readIORef th_var -- Whether TH is used
183 dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
184 -- M.hi-boot can be in the imp_dep_mods, but we must remove
185 -- it before recording the modules on which this one depends!
186 -- (We want to retain M.hi-boot in imp_dep_mods so that
187 -- loadHiBootInterface can see if M's direct imports depend
188 -- on M.hi-boot, and hence that we should do the hi-boot consistency
191 -- Modules don't compare lexicographically usually,
192 -- but we want them to do so here.
193 le_mod :: Module -> Module -> Bool
194 le_mod m1 m2 = moduleNameFS (moduleName m1)
195 <= moduleNameFS (moduleName m2)
197 le_dep_mod :: (ModuleName, IsBootInterface)
198 -> (ModuleName, IsBootInterface) -> Bool
199 le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
202 pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
203 | otherwise = imp_dep_pkgs imports
205 return Deps { dep_mods = sortLe le_dep_mod dep_mods,
206 dep_pkgs = sortLe (<=) pkgs,
207 dep_orphs = sortLe le_mod (imp_orphs imports),
208 dep_finsts = sortLe le_mod (imp_finsts imports) }
209 -- sort to get into canonical order
212 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
213 -> NameSet -> Dependencies -> GlobalRdrEnv
214 -> NameEnv FixItem -> Warnings -> HpcInfo
217 -> IO (Messages, Maybe (ModIface, Bool))
218 mkIface_ hsc_env maybe_old_fingerprint
219 this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
221 ModDetails{ md_insts = insts,
222 md_fam_insts = fam_insts,
225 md_vect_info = vect_info,
227 md_exports = exports }
228 -- NB: notice that mkIface does not look at the bindings
229 -- only at the TypeEnv. The previous Tidy phase has
230 -- put exactly the info into the TypeEnv that we want
231 -- to expose in the interface
233 = do { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
235 ; let { entities = typeEnvElts type_env ;
236 decls = [ tyThingToIfaceDecl entity
237 | entity <- entities,
238 let name = getName entity,
239 not (isImplicitTyThing entity),
240 -- No implicit Ids and class tycons in the interface file
241 not (isWiredInName name),
242 -- Nor wired-in things; the compiler knows about them anyhow
243 nameIsLocalOrFrom this_mod name ]
244 -- Sigh: see Note [Root-main Id] in TcRnDriver
246 ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
248 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
249 ; iface_insts = map instanceToIfaceInst insts
250 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
251 ; iface_vect_info = flattenVectInfo vect_info
253 ; intermediate_iface = ModIface {
254 mi_module = this_mod,
258 mi_exports = mkIfaceExports exports,
260 -- Sort these lexicographically, so that
261 -- the result is stable across compilations
262 mi_insts = sortLe le_inst iface_insts,
263 mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
264 mi_rules = sortLe le_rule iface_rules,
266 mi_vect_info = iface_vect_info,
268 mi_fixities = fixities,
270 mi_anns = mkIfaceAnnotations anns,
271 mi_globals = Just rdr_env,
273 -- Left out deliberately: filled in by addVersionInfo
274 mi_iface_hash = fingerprint0,
275 mi_mod_hash = fingerprint0,
276 mi_exp_hash = fingerprint0,
277 mi_orphan_hash = fingerprint0,
278 mi_orphan = False, -- Always set by addVersionInfo, but
279 -- it's a strict field, so we can't omit it.
280 mi_finsts = False, -- Ditto
281 mi_decls = deliberatelyOmitted "decls",
282 mi_hash_fn = deliberatelyOmitted "hash_fn",
283 mi_hpc = isHpcUsed hpc_info,
285 -- And build the cached values
286 mi_warn_fn = mkIfaceWarnCache warns,
287 mi_fix_fn = mkIfaceFixCache fixities }
290 ; (new_iface, no_change_at_all)
291 <- {-# SCC "versioninfo" #-}
292 addFingerprints hsc_env maybe_old_fingerprint
293 intermediate_iface decls
295 -- Warn about orphans
296 ; let orph_warnings --- Laziness means no work done unless -fwarn-orphans
297 | dopt Opt_WarnOrphans dflags = rule_warns `unionBags` inst_warns
298 | otherwise = emptyBag
299 errs_and_warns = (orph_warnings, emptyBag)
300 unqual = mkPrintUnqualified dflags rdr_env
301 inst_warns = listToBag [ instOrphWarn unqual d
302 | (d,i) <- insts `zip` iface_insts
303 , isNothing (ifInstOrph i) ]
304 rule_warns = listToBag [ ruleOrphWarn unqual this_mod r
306 , isNothing (ifRuleOrph r) ]
308 ; if errorsFound dflags errs_and_warns
309 then return ( errs_and_warns, Nothing )
312 -- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
315 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
316 (pprModIface new_iface)
318 -- bug #1617: on reload we weren't updating the PrintUnqualified
319 -- correctly. This stems from the fact that the interface had
320 -- not changed, so addVersionInfo returns the old ModIface
321 -- with the old GlobalRdrEnv (mi_globals).
322 ; let final_iface = new_iface{ mi_globals = Just rdr_env }
324 ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
326 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
327 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
328 i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
330 le_occ :: Name -> Name -> Bool
331 -- Compare lexicographically by OccName, *not* by unique, because
332 -- the latter is not stable across compilations
333 le_occ n1 n2 = nameOccName n1 <= nameOccName n2
335 dflags = hsc_dflags hsc_env
336 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
337 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
339 flattenVectInfo (VectInfo { vectInfoVar = vVar
340 , vectInfoTyCon = vTyCon
343 ifaceVectInfoVar = [ Var.varName v
344 | (v, _) <- varEnvElts vVar],
345 ifaceVectInfoTyCon = [ tyConName t
346 | (t, t_v) <- nameEnvElts vTyCon
348 ifaceVectInfoTyConReuse = [ tyConName t
349 | (t, t_v) <- nameEnvElts vTyCon
353 -----------------------------
354 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
355 writeIfaceFile dflags location new_iface
356 = do createDirectoryHierarchy (takeDirectory hi_file_path)
357 writeBinIface dflags hi_file_path new_iface
358 where hi_file_path = ml_hi_file location
361 -- -----------------------------------------------------------------------------
362 -- Look up parents and versions of Names
364 -- This is like a global version of the mi_hash_fn field in each ModIface.
365 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
366 -- the parent and version info.
369 :: HscEnv -- needed to look up versions
370 -> ExternalPackageState -- ditto
371 -> (Name -> Fingerprint)
372 mkHashFun hsc_env eps
375 mod = ASSERT2( isExternalName name, ppr name ) nameModule name
376 occ = nameOccName name
377 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
378 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
380 snd (mi_hash_fn iface occ `orElse`
381 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
383 hpt = hsc_HPT hsc_env
386 -- ---------------------------------------------------------------------------
387 -- Compute fingerprints for the interface
391 -> Maybe Fingerprint -- the old fingerprint, if any
392 -> ModIface -- The new interface (lacking decls)
393 -> [IfaceDecl] -- The new decls
394 -> IO (ModIface, -- Updated interface
395 Bool) -- True <=> no changes at all;
396 -- no need to write Iface
398 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
400 eps <- hscEPS hsc_env
402 -- the ABI of a declaration represents everything that is made
403 -- visible about the declaration that a client can depend on.
404 -- see IfaceDeclABI below.
405 declABI :: IfaceDecl -> IfaceDeclABI
406 declABI decl = (this_mod, decl, extras)
407 where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
409 edges :: [(IfaceDeclABI, Unique, [Unique])]
410 edges = [ (abi, getUnique (ifName decl), out)
412 , let abi = declABI decl
413 , let out = localOccs $ freeNamesDeclABI abi
416 name_module n = ASSERT( isExternalName n ) nameModule n
417 localOccs = map (getUnique . getParent . getOccName)
418 . filter ((== this_mod) . name_module)
420 where getParent occ = lookupOccEnv parent_map occ `orElse` occ
422 -- maps OccNames to their parents in the current module.
423 -- e.g. a reference to a constructor must be turned into a reference
424 -- to the TyCon for the purposes of calculating dependencies.
425 parent_map :: OccEnv OccName
426 parent_map = foldr extend emptyOccEnv new_decls
428 extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
431 -- strongly-connected groups of declarations, in dependency order
432 groups = stronglyConnCompFromEdgedVertices edges
434 global_hash_fn = mkHashFun hsc_env eps
436 -- how to output Names when generating the data to fingerprint.
437 -- Here we want to output the fingerprint for each top-level
438 -- Name, whether it comes from the current module or another
439 -- module. In this way, the fingerprint for a declaration will
440 -- change if the fingerprint for anything it refers to (transitively)
442 mk_put_name :: (OccEnv (OccName,Fingerprint))
443 -> BinHandle -> Name -> IO ()
444 mk_put_name local_env bh name
445 | isWiredInName name = putNameLiterally bh name
446 -- wired-in names don't have fingerprints
448 = ASSERT( isExternalName name )
449 let hash | nameModule name /= this_mod = global_hash_fn name
451 snd (lookupOccEnv local_env (getOccName name)
452 `orElse` pprPanic "urk! lookup local fingerprint"
453 (ppr name)) -- (undefined,fingerprint0))
454 -- This panic indicates that we got the dependency
455 -- analysis wrong, because we needed a fingerprint for
456 -- an entity that wasn't in the environment. To debug
457 -- it, turn the panic into a trace, uncomment the
458 -- pprTraces below, run the compile again, and inspect
459 -- the output and the generated .hi file with
464 -- take a strongly-connected group of declarations and compute
467 fingerprint_group :: (OccEnv (OccName,Fingerprint),
468 [(Fingerprint,IfaceDecl)])
470 -> IO (OccEnv (OccName,Fingerprint),
471 [(Fingerprint,IfaceDecl)])
473 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
474 = do let hash_fn = mk_put_name local_env
476 -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
477 hash <- computeFingerprint dflags hash_fn abi
478 return (extend_hash_env (hash,decl) local_env,
479 (hash,decl) : decls_w_hashes)
481 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
482 = do let decls = map abiDecl abis
483 local_env' = foldr extend_hash_env local_env
484 (zip (repeat fingerprint0) decls)
485 hash_fn = mk_put_name local_env'
486 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
487 let stable_abis = sortBy cmp_abiNames abis
488 -- put the cycle in a canonical order
489 hash <- computeFingerprint dflags hash_fn stable_abis
490 let pairs = zip (repeat hash) decls
491 return (foldr extend_hash_env local_env pairs,
492 pairs ++ decls_w_hashes)
494 extend_hash_env :: (Fingerprint,IfaceDecl)
495 -> OccEnv (OccName,Fingerprint)
496 -> OccEnv (OccName,Fingerprint)
497 extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
500 item = (decl_name, hash)
501 env1 = extendOccEnv env0 decl_name item
502 add_imp bndr env = extendOccEnv env bndr item
505 (local_env, decls_w_hashes) <-
506 foldM fingerprint_group (emptyOccEnv, []) groups
508 -- when calculating fingerprints, we always need to use canonical
509 -- ordering for lists of things. In particular, the mi_deps has various
510 -- lists of modules and suchlike, so put these all in canonical order:
511 let sorted_deps = sortDependencies (mi_deps iface0)
513 -- the export hash of a module depends on the orphan hashes of the
514 -- orphan modules below us in the dependeny tree. This is the way
515 -- that changes in orphans get propagated all the way up the
516 -- dependency tree. We only care about orphan modules in the current
517 -- package, because changes to orphans outside this package will be
518 -- tracked by the usage on the ABI hash of package modules that we import.
519 let orph_mods = filter ((== this_pkg) . modulePackageId)
520 $ dep_orphs sorted_deps
521 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
523 orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
524 (map IfaceInstABI orph_insts, orph_rules, fam_insts)
526 -- the export list hash doesn't depend on the fingerprints of
527 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
528 export_hash <- computeFingerprint dflags putNameLiterally
529 (mi_exports iface0, orphan_hash, dep_orphan_hashes)
531 -- put the declarations in a canonical order, sorted by OccName
532 let sorted_decls = eltsFM $ listToFM $
533 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
535 -- the ABI hash depends on:
541 mod_hash <- computeFingerprint dflags putNameLiterally
542 (map fst sorted_decls,
547 -- The interface hash depends on:
548 -- - the ABI hash, plus
552 iface_hash <- computeFingerprint dflags putNameLiterally
559 no_change_at_all = Just iface_hash == mb_old_fingerprint
561 final_iface = iface0 {
562 mi_mod_hash = mod_hash,
563 mi_iface_hash = iface_hash,
564 mi_exp_hash = export_hash,
565 mi_orphan_hash = orphan_hash,
566 mi_orphan = not (null orph_rules && null orph_insts),
567 mi_finsts = not . null $ mi_fam_insts iface0,
568 mi_decls = sorted_decls,
569 mi_hash_fn = lookupOccEnv local_env }
571 return (final_iface, no_change_at_all)
574 this_mod = mi_module iface0
575 dflags = hsc_dflags hsc_env
576 this_pkg = thisPackage dflags
577 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
578 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
579 -- ToDo: shouldn't we be splitting fam_insts into orphans and
581 fam_insts = mi_fam_insts iface0
582 fix_fn = mi_fix_fn iface0
585 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
586 getOrphanHashes hsc_env mods = do
587 eps <- hscEPS hsc_env
589 hpt = hsc_HPT hsc_env
591 dflags = hsc_dflags hsc_env
593 case lookupIfaceByModule dflags hpt pit mod of
594 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
595 Just iface -> mi_orphan_hash iface
597 return (map get_orph_hash mods)
600 sortDependencies :: Dependencies -> Dependencies
602 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
603 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
604 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
605 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
607 -- The ABI of a declaration consists of:
608 -- the full name of the identifier (inc. module and package, because
609 -- these are used to construct the symbol name by which the
610 -- identifier is known externally).
611 -- the fixity of the identifier
612 -- the declaration itself, as exposed to clients. That is, the
613 -- definition of an Id is included in the fingerprint only if
614 -- it is made available as as unfolding in the interface.
616 -- for classes: instances, fixity & rules for methods
617 -- for datatypes: instances, fixity & rules for constrs
618 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
620 abiDecl :: IfaceDeclABI -> IfaceDecl
621 abiDecl (_, decl, _) = decl
623 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
624 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
625 ifName (abiDecl abi2)
627 freeNamesDeclABI :: IfaceDeclABI -> NameSet
628 freeNamesDeclABI (_mod, decl, extras) =
629 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
632 = IfaceIdExtras Fixity [IfaceRule]
633 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
634 | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
635 | IfaceSynExtras Fixity
636 | IfaceOtherDeclExtras
638 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
639 freeNamesDeclExtras (IfaceIdExtras _ rules)
640 = unionManyNameSets (map freeNamesIfRule rules)
641 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
642 = unionManyNameSets (map freeNamesSub subs)
643 freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
644 = unionManyNameSets (map freeNamesSub subs)
645 freeNamesDeclExtras (IfaceSynExtras _)
647 freeNamesDeclExtras IfaceOtherDeclExtras
650 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
651 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
653 instance Binary IfaceDeclExtras where
654 get _bh = panic "no get for IfaceDeclExtras"
655 put_ bh (IfaceIdExtras fix rules) = do
656 putByte bh 1; put_ bh fix; put_ bh rules
657 put_ bh (IfaceDataExtras fix insts cons) = do
658 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
659 put_ bh (IfaceClassExtras fix insts methods) = do
660 putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
661 put_ bh (IfaceSynExtras fix) = do
662 putByte bh 4; put_ bh fix
663 put_ bh IfaceOtherDeclExtras = do
666 declExtras :: (OccName -> Fixity)
667 -> OccEnv [IfaceRule]
668 -> OccEnv [IfaceInst]
672 declExtras fix_fn rule_env inst_env decl
674 IfaceId{} -> IfaceIdExtras (fix_fn n)
675 (lookupOccEnvL rule_env n)
676 IfaceData{ifCons=cons} ->
677 IfaceDataExtras (fix_fn n)
678 (map IfaceInstABI $ lookupOccEnvL inst_env n)
679 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
680 IfaceClass{ifSigs=sigs} ->
681 IfaceClassExtras (fix_fn n)
682 (map IfaceInstABI $ lookupOccEnvL inst_env n)
683 [id_extras op | IfaceClassOp op _ _ <- sigs]
684 IfaceSyn{} -> IfaceSynExtras (fix_fn n)
685 _other -> IfaceOtherDeclExtras
688 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
691 -- When hashing an instance, we hash only its structure, not the
692 -- fingerprints of the things it mentions. See the section on instances
693 -- in the commentary,
694 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
696 newtype IfaceInstABI = IfaceInstABI IfaceInst
698 instance Binary IfaceInstABI where
699 get = panic "no get for IfaceInstABI"
700 put_ bh (IfaceInstABI inst) = do
701 let ud = getUserData bh
702 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
705 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
706 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
708 -- used when we want to fingerprint a structure without depending on the
709 -- fingerprints of external Names that it refers to.
710 putNameLiterally :: BinHandle -> Name -> IO ()
711 putNameLiterally bh name = ASSERT( isExternalName name )
712 do { put_ bh $! nameModule name
713 ; put_ bh $! nameOccName name }
715 computeFingerprint :: Binary a
717 -> (BinHandle -> Name -> IO ())
721 computeFingerprint _dflags put_name a = do
722 bh <- openBinMem (3*1024) -- just less than a block
723 ud <- newWriteState put_name putFS
724 bh <- return $ setUserData bh ud
729 -- for testing: use the md5sum command to generate fingerprints and
730 -- compare the results against our built-in version.
731 fp' <- oldMD5 dflags bh
732 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
735 oldMD5 dflags bh = do
736 tmp <- newTempName dflags "bin"
738 tmp2 <- newTempName dflags "md5"
739 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
742 ExitFailure _ -> ghcError (PhaseFailed cmd r)
744 hash_str <- readFile tmp2
745 return $! readHexFingerprint hash_str
748 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
749 instOrphWarn unqual inst
750 = mkWarnMsg (getSrcSpan inst) unqual $
751 hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
753 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
754 ruleOrphWarn unqual mod rule
755 = mkWarnMsg silly_loc unqual $
756 ptext (sLit "Orphan rule:") <+> ppr rule
758 silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 0)
759 -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
760 -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
762 ----------------------
763 -- mkOrphMap partitions instance decls or rules into
764 -- (a) an OccEnv for ones that are not orphans,
765 -- mapping the local OccName to a list of its decls
766 -- (b) a list of orphan decls
767 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
768 -- Nothing for an orphan decl
769 -> [decl] -- Sorted into canonical order
770 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
771 -- each sublist in canonical order
772 [decl]) -- Orphan decls; in canonical order
773 mkOrphMap get_key decls
774 = foldl go (emptyOccEnv, []) decls
776 go (non_orphs, orphs) d
777 | Just occ <- get_key d
778 = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
779 | otherwise = (non_orphs, d:orphs)
783 %*********************************************************
785 \subsection{Keeping track of what we've slurped, and fingerprints}
787 %*********************************************************
791 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
792 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
793 = do { eps <- hscEPS hsc_env
794 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
795 dir_imp_mods used_names
796 ; usages `seqList` return usages }
797 -- seq the list of Usages returned: occasionally these
798 -- don't get evaluated for a while and we can end up hanging on to
799 -- the entire collection of Ifaces.
801 mk_usage_info :: PackageIfaceTable
807 mk_usage_info pit hsc_env this_mod direct_imports used_names
808 = mapCatMaybes mkUsage usage_mods
810 hpt = hsc_HPT hsc_env
811 dflags = hsc_dflags hsc_env
812 this_pkg = thisPackage dflags
814 used_mods = moduleEnvKeys ent_map
815 dir_imp_mods = (moduleEnvKeys direct_imports)
816 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
817 usage_mods = sortBy stableModuleCmp all_mods
818 -- canonical order is imported, to avoid interface-file
821 -- ent_map groups together all the things imported and used
822 -- from a particular module
823 ent_map :: ModuleEnv [OccName]
824 ent_map = foldNameSet add_mv emptyModuleEnv used_names
827 | isWiredInName name = mv_map -- ignore wired-in names
829 = case nameModule_maybe name of
830 Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
831 Just mod -> -- We use this fiddly lambda function rather than
832 -- (++) as the argument to extendModuleEnv_C to
833 -- avoid quadratic behaviour (trac #2680)
834 extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
835 where occ = nameOccName name
837 -- We want to create a Usage for a home module if
838 -- a) we used something from it; has something in used_names
839 -- b) we imported it, even if we used nothing from it
840 -- (need to recompile if its export list changes: export_fprint)
841 mkUsage :: Module -> Maybe Usage
843 | isNothing maybe_iface -- We can't depend on it if we didn't
844 -- load its interface.
845 || mod == this_mod -- We don't care about usages of
846 -- things in *this* module
849 | modulePackageId mod /= this_pkg
850 = Just UsagePackageModule{ usg_mod = mod,
851 usg_mod_hash = mod_hash }
852 -- for package modules, we record the module hash only
855 && isNothing export_hash
856 && not is_direct_import
858 = Nothing -- Record no usage info
859 -- for directly-imported modules, we always want to record a usage
860 -- on the orphan hash. This is what triggers a recompilation if
861 -- an orphan is added or removed somewhere below us in the future.
864 = Just UsageHomeModule {
865 usg_mod_name = moduleName mod,
866 usg_mod_hash = mod_hash,
867 usg_exports = export_hash,
868 usg_entities = fmToList ent_hashs }
870 maybe_iface = lookupIfaceByModule dflags hpt pit mod
871 -- In one-shot mode, the interfaces for home-package
872 -- modules accumulate in the PIT not HPT. Sigh.
874 is_direct_import = mod `elemModuleEnv` direct_imports
876 Just iface = maybe_iface
877 finsts_mod = mi_finsts iface
878 hash_env = mi_hash_fn iface
879 mod_hash = mi_mod_hash iface
880 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
881 | otherwise = Nothing
883 used_occs = lookupModuleEnv ent_map mod `orElse` []
885 -- Making a FiniteMap here ensures that (a) we remove duplicates
886 -- when we have usages on several subordinates of a single parent,
887 -- and (b) that the usages emerge in a canonical order, which
888 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
889 -- using Ord on the OccNames, which is a lexicographic ordering.
890 ent_hashs :: FiniteMap OccName Fingerprint
891 ent_hashs = listToFM (map lookup_occ used_occs)
895 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
898 depend_on_exports mod =
899 case lookupModuleEnv direct_imports mod of
901 -- Even if we used 'import M ()', we have to register a
902 -- usage on the export list because we are sensitive to
903 -- changes in orphan instances/rules.
905 -- In GHC 6.8.x the above line read "True", and in
906 -- fact it recorded a dependency on *all* the
907 -- modules underneath in the dependency tree. This
908 -- happens to make orphans work right, but is too
909 -- expensive: it'll read too many interface files.
910 -- The 'isNothing maybe_iface' check above saved us
911 -- from generating many of these usages (at least in
912 -- one-shot mode), but that's even more bogus!
916 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
917 mkIfaceAnnotations = map mkIfaceAnnotation
919 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
920 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
921 ifAnnotatedTarget = fmap nameOccName target,
922 ifAnnotatedValue = serialized
927 mkIfaceExports :: [AvailInfo]
928 -> [(Module, [GenAvailInfo OccName])]
929 -- Group by module and sort by occurrence
930 -- This keeps the list in canonical order
931 mkIfaceExports exports
932 = [ (mod, eltsFM avails)
933 | (mod, avails) <- fmToList groupFM
936 -- Group by the module where the exported entities are defined
937 -- (which may not be the same for all Names in an Avail)
938 -- Deliberately use FiniteMap rather than UniqFM so we
939 -- get a canonical ordering
940 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
941 groupFM = foldl add emptyModuleEnv exports
943 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
944 -> Module -> GenAvailInfo OccName
945 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
946 add_one env mod avail
947 = extendModuleEnv_C plusFM env mod
948 (unitFM (occNameFS (availName avail)) avail)
950 -- NB: we should not get T(X) and T(Y) in the export list
951 -- else the plusFM will simply discard one! They
952 -- should have been combined by now.
954 = ASSERT( isExternalName n )
955 add_one env (nameModule n) (Avail (nameOccName n))
957 add env (AvailTC tc ns)
958 = ASSERT( all isExternalName ns )
959 foldl add_for_mod env mods
961 tc_occ = nameOccName tc
962 mods = nub (map nameModule ns)
963 -- Usually just one, but see Note [Original module]
966 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
967 -- NB. sort the children, we need a canonical order
969 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
972 Note [Orignal module]
973 ~~~~~~~~~~~~~~~~~~~~~
975 module X where { data family T }
976 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
977 The exported Avail from Y will look like
980 - only MkT is brought into scope by the data instance;
981 - but the parent (used for grouping and naming in T(..) exports) is X.T
982 - and in this case we export X.T too
984 In the result of MkIfaceExports, the names are grouped by defining module,
985 so we may need to split up a single Avail into multiple ones.
988 %************************************************************************
990 Load the old interface file for this module (unless
991 we have it aleady), and check whether it is up to date
994 %************************************************************************
997 checkOldIface :: HscEnv
999 -> Bool -- Source unchanged
1000 -> Maybe ModIface -- Old interface from compilation manager, if any
1001 -> IO (RecompileRequired, Maybe ModIface)
1003 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1004 = do { showPass (hsc_dflags hsc_env)
1005 ("Checking old interface for " ++
1006 showSDoc (ppr (ms_mod mod_summary))) ;
1008 ; initIfaceCheck hsc_env $
1009 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1012 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1013 -> IfG (Bool, Maybe ModIface)
1014 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1015 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
1016 { when (not source_unchanged)
1017 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1019 -- If the source has changed and we're in interactive mode, avoid reading
1020 -- an interface; just return the one we might have been supplied with.
1021 ; let dflags = hsc_dflags hsc_env
1022 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1023 return (outOfDate, maybe_iface)
1025 case maybe_iface of {
1026 Just old_iface -> do -- Use the one we already have
1027 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1028 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1029 ; return (recomp, Just old_iface) }
1033 -- Try and read the old interface for the current module
1034 -- from the .hi file left from the last time we compiled it
1035 { let iface_path = msHiFilePath mod_summary
1036 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1037 ; case read_result of {
1038 Failed err -> do -- Old interface file not found, or garbled; give up
1039 { traceIf (text "FYI: cannot read old interface file:"
1041 ; return (outOfDate, Nothing) }
1043 ; Succeeded iface -> do
1045 -- We have got the old iface; check its versions
1046 { traceIf (text "Read the interface file" <+> text iface_path)
1047 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1048 ; return (recomp, Just iface)
1053 @recompileRequired@ is called from the HscMain. It checks whether
1054 a recompilation is required. It needs access to the persistent state,
1055 finder, etc, because it may have to load lots of interface files to
1056 check their versions.
1059 type RecompileRequired = Bool
1060 upToDate, outOfDate :: Bool
1061 upToDate = False -- Recompile not required
1062 outOfDate = True -- Recompile required
1064 checkVersions :: HscEnv
1065 -> Bool -- True <=> source unchanged
1067 -> ModIface -- Old interface
1068 -> IfG RecompileRequired
1069 checkVersions hsc_env source_unchanged mod_summary iface
1070 | not source_unchanged
1073 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1074 ppr (mi_module iface) <> colon)
1076 ; recomp <- checkDependencies hsc_env mod_summary iface
1077 ; if recomp then return outOfDate else do {
1079 -- Source code unchanged and no errors yet... carry on
1081 -- First put the dependent-module info, read from the old
1082 -- interface, into the envt, so that when we look for
1083 -- interfaces we look for the right one (.hi or .hi-boot)
1085 -- It's just temporary because either the usage check will succeed
1086 -- (in which case we are done with this module) or it'll fail (in which
1087 -- case we'll compile the module from scratch anyhow).
1089 -- We do this regardless of compilation mode, although in --make mode
1090 -- all the dependent modules should be in the HPT already, so it's
1092 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1094 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1095 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1098 -- This is a bit of a hack really
1099 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1100 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1103 -- If the direct imports of this module are resolved to targets that
1104 -- are not among the dependencies of the previous interface file,
1105 -- then we definitely need to recompile. This catches cases like
1106 -- - an exposed package has been upgraded
1107 -- - we are compiling with different package flags
1108 -- - a home module that was shadowing a package module has been removed
1109 -- - a new home module has been added that shadows a package module
1112 -- Returns True if recompilation is required.
1113 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1114 checkDependencies hsc_env summary iface
1115 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1117 prev_dep_mods = dep_mods (mi_deps iface)
1118 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1120 this_pkg = thisPackage (hsc_dflags hsc_env)
1122 orM = foldr f (return False)
1123 where f m rest = do b <- m; if b then return True else rest
1125 dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
1126 find_res <- liftIO $ findImportedModule hsc_env mod pkg
1130 -> if moduleName mod `notElem` map fst prev_dep_mods
1131 then do traceHiDiffs $
1132 text "imported module " <> quotes (ppr mod) <>
1133 text " not among previous dependencies"
1138 -> if pkg `notElem` prev_dep_pkgs
1139 then do traceHiDiffs $
1140 text "imported module " <> quotes (ppr mod) <>
1141 text " is from package " <> quotes (ppr pkg) <>
1142 text ", which is not among previous dependencies"
1146 where pkg = modulePackageId mod
1147 _otherwise -> return outOfDate
1149 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1150 -> IfG RecompileRequired
1151 needInterface mod continue
1152 = do -- Load the imported interface if possible
1153 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1154 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1156 mb_iface <- loadInterface doc_str mod ImportBySystem
1157 -- Load the interface, but don't complain on failure;
1158 -- Instead, get an Either back which we can test
1161 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1163 -- Couldn't find or parse a module mentioned in the
1164 -- old interface file. Don't complain: it might
1165 -- just be that the current module doesn't need that
1166 -- import and it's been deleted
1167 Succeeded iface -> continue iface
1170 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1171 -- Given the usage information extracted from the old
1172 -- M.hi file for the module being compiled, figure out
1173 -- whether M needs to be recompiled.
1175 checkModUsage _this_pkg UsagePackageModule{
1177 usg_mod_hash = old_mod_hash }
1178 = needInterface mod $ \iface -> do
1179 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1180 -- We only track the ABI hash of package modules, rather than
1181 -- individual entity usages, so if the ABI hash changes we must
1182 -- recompile. This is safe but may entail more recompilation when
1183 -- a dependent package has changed.
1185 checkModUsage this_pkg UsageHomeModule{
1186 usg_mod_name = mod_name,
1187 usg_mod_hash = old_mod_hash,
1188 usg_exports = maybe_old_export_hash,
1189 usg_entities = old_decl_hash }
1191 let mod = mkModule this_pkg mod_name
1192 needInterface mod $ \iface -> do
1195 new_mod_hash = mi_mod_hash iface
1196 new_decl_hash = mi_hash_fn iface
1197 new_export_hash = mi_exp_hash iface
1200 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1201 if not recompile then return upToDate else do
1203 -- CHECK EXPORT LIST
1204 checkMaybeHash maybe_old_export_hash new_export_hash
1205 (ptext (sLit " Export list changed")) $ do
1207 -- CHECK ITEMS ONE BY ONE
1208 recompile <- checkList [ checkEntityUsage new_decl_hash u
1209 | u <- old_decl_hash]
1211 then return outOfDate -- This one failed, so just bail out now
1212 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1214 ------------------------
1215 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1216 checkModuleFingerprint old_mod_hash new_mod_hash
1217 | new_mod_hash == old_mod_hash
1218 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1221 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1222 old_mod_hash new_mod_hash
1224 ------------------------
1225 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1226 -> IfG RecompileRequired -> IfG RecompileRequired
1227 checkMaybeHash maybe_old_hash new_hash doc continue
1228 | Just hash <- maybe_old_hash, hash /= new_hash
1229 = out_of_date_hash doc hash new_hash
1233 ------------------------
1234 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1235 -> (OccName, Fingerprint)
1237 checkEntityUsage new_hash (name,old_hash)
1238 = case new_hash name of
1240 Nothing -> -- We used it before, but it ain't there now
1241 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1243 Just (_, new_hash) -- It's there, but is it up to date?
1244 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1246 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1249 up_to_date, out_of_date :: SDoc -> IfG Bool
1250 up_to_date msg = traceHiDiffs msg >> return upToDate
1251 out_of_date msg = traceHiDiffs msg >> return outOfDate
1253 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1254 out_of_date_hash msg old_hash new_hash
1255 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1257 ----------------------
1258 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1259 -- This helper is used in two places
1260 checkList [] = return upToDate
1261 checkList (check:checks) = do recompile <- check
1263 then return outOfDate
1264 else checkList checks
1267 %************************************************************************
1269 Converting things to their Iface equivalents
1271 %************************************************************************
1274 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1275 -- Assumption: the thing is already tidied, so that locally-bound names
1276 -- (lambdas, for-alls) already have non-clashing OccNames
1277 -- Reason: Iface stuff uses OccNames, and the conversion here does
1278 -- not do tidying on the way
1279 tyThingToIfaceDecl (AnId id)
1280 = IfaceId { ifName = getOccName id,
1281 ifType = toIfaceType (idType id),
1282 ifIdDetails = toIfaceIdDetails (idDetails id),
1285 info = case toIfaceIdInfo (idInfo id) of
1287 items -> HasInfo items
1289 tyThingToIfaceDecl (AClass clas)
1290 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1291 ifName = getOccName clas,
1292 ifTyVars = toIfaceTvBndrs clas_tyvars,
1293 ifFDs = map toIfaceFD clas_fds,
1294 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1295 ifSigs = map toIfaceClassOp op_stuff,
1296 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1298 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1299 = classExtraBigSig clas
1300 tycon = classTyCon clas
1302 toIfaceClassOp (sel_id, def_meth)
1303 = ASSERT(sel_tyvars == clas_tyvars)
1304 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1306 -- Be careful when splitting the type, because of things
1307 -- like class Foo a where
1308 -- op :: (?x :: String) => a -> a
1309 -- and class Baz a where
1310 -- op :: (Ord a) => a -> a
1311 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1312 op_ty = funResultTy rho_ty
1314 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1316 tyThingToIfaceDecl (ATyCon tycon)
1318 = IfaceSyn { ifName = getOccName tycon,
1319 ifTyVars = toIfaceTvBndrs tyvars,
1322 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1326 = IfaceData { ifName = getOccName tycon,
1327 ifTyVars = toIfaceTvBndrs tyvars,
1328 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1329 ifCons = ifaceConDecls (algTyConRhs tycon),
1330 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1331 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1332 ifGeneric = tyConHasGenerics tycon,
1333 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1335 | isForeignTyCon tycon
1336 = IfaceForeign { ifName = getOccName tycon,
1337 ifExtName = tyConExtName tycon }
1339 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1341 tyvars = tyConTyVars tycon
1343 = case synTyConRhs tycon of
1344 OpenSynTyCon ki _ -> (Nothing, toIfaceType ki)
1345 SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1347 ifaceConDecls (NewTyCon { data_con = con }) =
1348 IfNewTyCon (ifaceConDecl con)
1349 ifaceConDecls (DataTyCon { data_cons = cons }) =
1350 IfDataTyCon (map ifaceConDecl cons)
1351 ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
1352 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1353 -- The last case happens when a TyCon has been trimmed during tidying
1354 -- Furthermore, tyThingToIfaceDecl is also used
1355 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1356 -- AbstractTyCon case is perfectly sensible.
1358 ifaceConDecl data_con
1359 = IfCon { ifConOcc = getOccName (dataConName data_con),
1360 ifConInfix = dataConIsInfix data_con,
1361 ifConWrapper = isJust (dataConWrapId_maybe data_con),
1362 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1363 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1364 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1365 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1366 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1367 ifConFields = map getOccName
1368 (dataConFieldLabels data_con),
1369 ifConStricts = dataConStrictMarks data_con }
1371 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1373 famInstToIface Nothing = Nothing
1374 famInstToIface (Just (famTyCon, instTys)) =
1375 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1377 tyThingToIfaceDecl (ADataCon dc)
1378 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1381 getFS :: NamedThing a => a -> FastString
1382 getFS x = occNameFS (getOccName x)
1384 --------------------------
1385 instanceToIfaceInst :: Instance -> IfaceInst
1386 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1387 is_cls = cls_name, is_tcs = mb_tcs })
1388 = ASSERT( cls_name == className cls )
1389 IfaceInst { ifDFun = dfun_name,
1391 ifInstCls = cls_name,
1392 ifInstTys = map do_rough mb_tcs,
1395 do_rough Nothing = Nothing
1396 do_rough (Just n) = Just (toIfaceTyCon_name n)
1398 dfun_name = idName dfun_id
1399 mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1400 is_local name = nameIsLocalOrFrom mod name
1402 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1403 (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1404 -- Slightly awkward: we need the Class to get the fundeps
1405 (tvs, fds) = classTvsFds cls
1406 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1407 orph | is_local cls_name = Just (nameOccName cls_name)
1408 | all isJust mb_ns = head mb_ns
1409 | otherwise = Nothing
1411 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1412 -- that is not in the "determined" arguments
1413 mb_ns | null fds = [choose_one arg_names]
1414 | otherwise = map do_one fds
1415 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1416 , not (tv `elem` rtvs)]
1418 choose_one :: [NameSet] -> Maybe OccName
1419 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1421 (n : _) -> Just (nameOccName n)
1423 --------------------------
1424 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1425 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1428 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1429 , ifFamInstFam = fam
1430 , ifFamInstTys = map do_rough mb_tcs }
1432 do_rough Nothing = Nothing
1433 do_rough (Just n) = Just (toIfaceTyCon_name n)
1435 --------------------------
1436 toIfaceLetBndr :: Id -> IfaceLetBndr
1437 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1438 (toIfaceType (idType id))
1441 -- Stripped-down version of tcIfaceIdInfo
1442 -- Change this if you want to export more IdInfo for
1443 -- non-top-level Ids. Don't forget to change
1444 -- CoreTidy.tidyLetBndr too!
1446 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1448 inline_prag = inlinePragInfo id_info
1449 prag_info | isDefaultInlinePragma inline_prag = NoInfo
1450 | otherwise = HasInfo [HsInline inline_prag]
1452 --------------------------
1453 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
1454 toIfaceIdDetails VanillaId = IfVanillaId
1455 toIfaceIdDetails DFunId = IfVanillaId
1456 toIfaceIdDetails (RecSelId { sel_naughty = n }) = IfRecSelId n
1457 toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
1458 IfVanillaId -- Unexpected
1460 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1461 toIfaceIdInfo id_info
1462 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1463 inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
1465 ------------ Arity --------------
1466 arity_info = arityInfo id_info
1467 arity_hsinfo | arity_info == 0 = Nothing
1468 | otherwise = Just (HsArity arity_info)
1470 ------------ Caf Info --------------
1471 caf_info = cafInfo id_info
1472 caf_hsinfo = case caf_info of
1473 NoCafRefs -> Just HsNoCafRefs
1476 ------------ Strictness --------------
1477 -- No point in explicitly exporting TopSig
1478 strict_hsinfo = case newStrictnessInfo id_info of
1479 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1482 ------------ Worker --------------
1483 work_info = workerInfo id_info
1484 has_worker = workerExists work_info
1485 wrkr_hsinfo = case work_info of
1486 HasWorker work_id wrap_arity ->
1487 Just (HsWorker ((idName work_id)) wrap_arity)
1490 ------------ Unfolding --------------
1491 -- The unfolding is redundant if there is a worker
1492 unfold_info = unfoldingInfo id_info
1493 rhs = unfoldingTemplate unfold_info
1494 no_unfolding = neverUnfold unfold_info
1495 -- The CoreTidy phase retains unfolding info iff
1496 -- we want to expose the unfolding, taking into account
1497 -- unconditional NOINLINE, etc. See TidyPgm.addExternal
1498 unfold_hsinfo | no_unfolding = Nothing
1499 | has_worker = Nothing -- Unfolding is implicit
1500 | otherwise = Just (HsUnfold (toIfaceExpr rhs))
1502 ------------ Inline prag --------------
1503 inline_prag = inlinePragInfo id_info
1504 inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1505 | no_unfolding && not has_worker
1506 && isFunLike (inlinePragmaRuleMatchInfo inline_prag)
1508 -- If the iface file give no unfolding info, we
1509 -- don't need to say when inlining is OK!
1510 | otherwise = Just (HsInline inline_prag)
1512 --------------------------
1513 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1514 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1515 = pprTrace "toHsRule: builtin" (ppr fn) $
1518 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1519 ru_act = act, ru_bndrs = bndrs,
1520 ru_args = args, ru_rhs = rhs })
1521 = IfaceRule { ifRuleName = name, ifActivation = act,
1522 ifRuleBndrs = map toIfaceBndr bndrs,
1524 ifRuleArgs = map do_arg args,
1525 ifRuleRhs = toIfaceExpr rhs,
1528 -- For type args we must remove synonyms from the outermost
1529 -- level. Reason: so that when we read it back in we'll
1530 -- construct the same ru_rough field as we have right now;
1532 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1533 do_arg arg = toIfaceExpr arg
1535 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1536 -- A rule is an orphan only if none of the variables
1537 -- mentioned on its left-hand side are locally defined
1538 lhs_names = fn : nameSetToList (exprsFreeNames args)
1539 -- No need to delete bndrs, because
1540 -- exprsFreeNames finds only External names
1542 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1543 (n : _) -> Just (nameOccName n)
1546 bogusIfaceRule :: Name -> IfaceRule
1547 bogusIfaceRule id_name
1548 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1549 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1550 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1552 ---------------------
1553 toIfaceExpr :: CoreExpr -> IfaceExpr
1554 toIfaceExpr (Var v) = toIfaceVar v
1555 toIfaceExpr (Lit l) = IfaceLit l
1556 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1557 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1558 toIfaceExpr (App f a) = toIfaceApp f [a]
1559 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1560 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1561 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1562 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1564 ---------------------
1565 toIfaceNote :: Note -> IfaceNote
1566 toIfaceNote (SCC cc) = IfaceSCC cc
1567 toIfaceNote InlineMe = IfaceInlineMe
1568 toIfaceNote (CoreNote s) = IfaceCoreNote s
1570 ---------------------
1571 toIfaceBind :: Bind Id -> IfaceBinding
1572 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1573 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1575 ---------------------
1576 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1577 -> (IfaceConAlt, [FastString], IfaceExpr)
1578 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1580 ---------------------
1581 toIfaceCon :: AltCon -> IfaceConAlt
1582 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1583 | otherwise = IfaceDataAlt (getName dc)
1585 tc = dataConTyCon dc
1587 toIfaceCon (LitAlt l) = IfaceLitAlt l
1588 toIfaceCon DEFAULT = IfaceDefault
1590 ---------------------
1591 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1592 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1593 toIfaceApp (Var v) as
1594 = case isDataConWorkId_maybe v of
1595 -- We convert the *worker* for tuples into IfaceTuples
1596 Just dc | isTupleTyCon tc && saturated
1597 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1599 val_args = dropWhile isTypeArg as
1600 saturated = val_args `lengthIs` idArity v
1601 tup_args = map toIfaceExpr val_args
1602 tc = dataConTyCon dc
1604 _ -> mkIfaceApps (toIfaceVar v) as
1606 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1608 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1609 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1611 ---------------------
1612 toIfaceVar :: Id -> IfaceExpr
1614 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1615 -- Foreign calls have special syntax
1616 | isExternalName name = IfaceExt name
1617 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1619 | otherwise = IfaceLcl (getFS name)