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 -- Modules don't compare lexicographically usually,
189 -- but we want them to do so here.
190 le_mod :: Module -> Module -> Bool
191 le_mod m1 m2 = moduleNameFS (moduleName m1)
192 <= moduleNameFS (moduleName m2)
194 le_dep_mod :: (ModuleName, IsBootInterface)
195 -> (ModuleName, IsBootInterface) -> Bool
196 le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
199 pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
200 | otherwise = imp_dep_pkgs imports
202 return Deps { dep_mods = sortLe le_dep_mod dep_mods,
203 dep_pkgs = sortLe (<=) pkgs,
204 dep_orphs = sortLe le_mod (imp_orphs imports),
205 dep_finsts = sortLe le_mod (imp_finsts imports) }
206 -- sort to get into canonical order
209 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
210 -> NameSet -> Dependencies -> GlobalRdrEnv
211 -> NameEnv FixItem -> Warnings -> HpcInfo
214 -> IO (Messages, Maybe (ModIface, Bool))
215 mkIface_ hsc_env maybe_old_fingerprint
216 this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
218 ModDetails{ md_insts = insts,
219 md_fam_insts = fam_insts,
222 md_vect_info = vect_info,
224 md_exports = exports }
225 -- NB: notice that mkIface does not look at the bindings
226 -- only at the TypeEnv. The previous Tidy phase has
227 -- put exactly the info into the TypeEnv that we want
228 -- to expose in the interface
230 = do { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
232 ; let { entities = typeEnvElts type_env ;
233 decls = [ tyThingToIfaceDecl entity
234 | entity <- entities,
235 let name = getName entity,
236 not (isImplicitTyThing entity),
237 -- No implicit Ids and class tycons in the interface file
238 not (isWiredInName name),
239 -- Nor wired-in things; the compiler knows about them anyhow
240 nameIsLocalOrFrom this_mod name ]
241 -- Sigh: see Note [Root-main Id] in TcRnDriver
243 ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
245 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
246 ; iface_insts = map instanceToIfaceInst insts
247 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
248 ; iface_vect_info = flattenVectInfo vect_info
250 ; intermediate_iface = ModIface {
251 mi_module = this_mod,
255 mi_exports = mkIfaceExports exports,
257 -- Sort these lexicographically, so that
258 -- the result is stable across compilations
259 mi_insts = sortLe le_inst iface_insts,
260 mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
261 mi_rules = sortLe le_rule iface_rules,
263 mi_vect_info = iface_vect_info,
265 mi_fixities = fixities,
267 mi_anns = mkIfaceAnnotations anns,
268 mi_globals = Just rdr_env,
270 -- Left out deliberately: filled in by addVersionInfo
271 mi_iface_hash = fingerprint0,
272 mi_mod_hash = fingerprint0,
273 mi_exp_hash = fingerprint0,
274 mi_orphan_hash = fingerprint0,
275 mi_orphan = False, -- Always set by addVersionInfo, but
276 -- it's a strict field, so we can't omit it.
277 mi_finsts = False, -- Ditto
278 mi_decls = deliberatelyOmitted "decls",
279 mi_hash_fn = deliberatelyOmitted "hash_fn",
280 mi_hpc = isHpcUsed hpc_info,
282 -- And build the cached values
283 mi_warn_fn = mkIfaceWarnCache warns,
284 mi_fix_fn = mkIfaceFixCache fixities }
287 ; (new_iface, no_change_at_all)
288 <- {-# SCC "versioninfo" #-}
289 addFingerprints hsc_env maybe_old_fingerprint
290 intermediate_iface decls
292 -- Warn about orphans
293 ; let orph_warnings --- Laziness means no work done unless -fwarn-orphans
294 | dopt Opt_WarnOrphans dflags = rule_warns `unionBags` inst_warns
295 | otherwise = emptyBag
296 errs_and_warns = (orph_warnings, emptyBag)
297 unqual = mkPrintUnqualified dflags rdr_env
298 inst_warns = listToBag [ instOrphWarn unqual d
299 | (d,i) <- insts `zip` iface_insts
300 , isNothing (ifInstOrph i) ]
301 rule_warns = listToBag [ ruleOrphWarn unqual this_mod r
303 , isNothing (ifRuleOrph r) ]
305 ; if errorsFound dflags errs_and_warns
306 then return ( errs_and_warns, Nothing )
309 -- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
312 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
313 (pprModIface new_iface)
315 -- bug #1617: on reload we weren't updating the PrintUnqualified
316 -- correctly. This stems from the fact that the interface had
317 -- not changed, so addVersionInfo returns the old ModIface
318 -- with the old GlobalRdrEnv (mi_globals).
319 ; let final_iface = new_iface{ mi_globals = Just rdr_env }
321 ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
323 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
324 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
325 i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
327 le_occ :: Name -> Name -> Bool
328 -- Compare lexicographically by OccName, *not* by unique, because
329 -- the latter is not stable across compilations
330 le_occ n1 n2 = nameOccName n1 <= nameOccName n2
332 dflags = hsc_dflags hsc_env
333 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
334 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
336 flattenVectInfo (VectInfo { vectInfoVar = vVar
337 , vectInfoTyCon = vTyCon
340 ifaceVectInfoVar = [ Var.varName v
341 | (v, _) <- varEnvElts vVar],
342 ifaceVectInfoTyCon = [ tyConName t
343 | (t, t_v) <- nameEnvElts vTyCon
345 ifaceVectInfoTyConReuse = [ tyConName t
346 | (t, t_v) <- nameEnvElts vTyCon
350 -----------------------------
351 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
352 writeIfaceFile dflags location new_iface
353 = do createDirectoryHierarchy (takeDirectory hi_file_path)
354 writeBinIface dflags hi_file_path new_iface
355 where hi_file_path = ml_hi_file location
358 -- -----------------------------------------------------------------------------
359 -- Look up parents and versions of Names
361 -- This is like a global version of the mi_hash_fn field in each ModIface.
362 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
363 -- the parent and version info.
366 :: HscEnv -- needed to look up versions
367 -> ExternalPackageState -- ditto
368 -> (Name -> Fingerprint)
369 mkHashFun hsc_env eps
372 mod = ASSERT2( isExternalName name, ppr name ) nameModule name
373 occ = nameOccName name
374 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
375 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
377 snd (mi_hash_fn iface occ `orElse`
378 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
380 hpt = hsc_HPT hsc_env
383 -- ---------------------------------------------------------------------------
384 -- Compute fingerprints for the interface
388 -> Maybe Fingerprint -- the old fingerprint, if any
389 -> ModIface -- The new interface (lacking decls)
390 -> [IfaceDecl] -- The new decls
391 -> IO (ModIface, -- Updated interface
392 Bool) -- True <=> no changes at all;
393 -- no need to write Iface
395 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
397 eps <- hscEPS hsc_env
399 -- the ABI of a declaration represents everything that is made
400 -- visible about the declaration that a client can depend on.
401 -- see IfaceDeclABI below.
402 declABI :: IfaceDecl -> IfaceDeclABI
403 declABI decl = (this_mod, decl, extras)
404 where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
406 edges :: [(IfaceDeclABI, Unique, [Unique])]
407 edges = [ (abi, getUnique (ifName decl), out)
409 , let abi = declABI decl
410 , let out = localOccs $ freeNamesDeclABI abi
413 name_module n = ASSERT( isExternalName n ) nameModule n
414 localOccs = map (getUnique . getParent . getOccName)
415 . filter ((== this_mod) . name_module)
417 where getParent occ = lookupOccEnv parent_map occ `orElse` occ
419 -- maps OccNames to their parents in the current module.
420 -- e.g. a reference to a constructor must be turned into a reference
421 -- to the TyCon for the purposes of calculating dependencies.
422 parent_map :: OccEnv OccName
423 parent_map = foldr extend emptyOccEnv new_decls
425 extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
428 -- strongly-connected groups of declarations, in dependency order
429 groups = stronglyConnCompFromEdgedVertices edges
431 global_hash_fn = mkHashFun hsc_env eps
433 -- how to output Names when generating the data to fingerprint.
434 -- Here we want to output the fingerprint for each top-level
435 -- Name, whether it comes from the current module or another
436 -- module. In this way, the fingerprint for a declaration will
437 -- change if the fingerprint for anything it refers to (transitively)
439 mk_put_name :: (OccEnv (OccName,Fingerprint))
440 -> BinHandle -> Name -> IO ()
441 mk_put_name local_env bh name
442 | isWiredInName name = putNameLiterally bh name
443 -- wired-in names don't have fingerprints
445 = ASSERT( isExternalName name )
446 let hash | nameModule name /= this_mod = global_hash_fn name
448 snd (lookupOccEnv local_env (getOccName name)
449 `orElse` pprPanic "urk! lookup local fingerprint"
450 (ppr name)) -- (undefined,fingerprint0))
451 -- This panic indicates that we got the dependency
452 -- analysis wrong, because we needed a fingerprint for
453 -- an entity that wasn't in the environment. To debug
454 -- it, turn the panic into a trace, uncomment the
455 -- pprTraces below, run the compile again, and inspect
456 -- the output and the generated .hi file with
461 -- take a strongly-connected group of declarations and compute
464 fingerprint_group :: (OccEnv (OccName,Fingerprint),
465 [(Fingerprint,IfaceDecl)])
467 -> IO (OccEnv (OccName,Fingerprint),
468 [(Fingerprint,IfaceDecl)])
470 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
471 = do let hash_fn = mk_put_name local_env
473 -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
474 hash <- computeFingerprint dflags hash_fn abi
475 return (extend_hash_env (hash,decl) local_env,
476 (hash,decl) : decls_w_hashes)
478 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
479 = do let decls = map abiDecl abis
480 local_env' = foldr extend_hash_env local_env
481 (zip (repeat fingerprint0) decls)
482 hash_fn = mk_put_name local_env'
483 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
484 let stable_abis = sortBy cmp_abiNames abis
485 -- put the cycle in a canonical order
486 hash <- computeFingerprint dflags hash_fn stable_abis
487 let pairs = zip (repeat hash) decls
488 return (foldr extend_hash_env local_env pairs,
489 pairs ++ decls_w_hashes)
491 extend_hash_env :: (Fingerprint,IfaceDecl)
492 -> OccEnv (OccName,Fingerprint)
493 -> OccEnv (OccName,Fingerprint)
494 extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
497 item = (decl_name, hash)
498 env1 = extendOccEnv env0 decl_name item
499 add_imp bndr env = extendOccEnv env bndr item
502 (local_env, decls_w_hashes) <-
503 foldM fingerprint_group (emptyOccEnv, []) groups
505 -- when calculating fingerprints, we always need to use canonical
506 -- ordering for lists of things. In particular, the mi_deps has various
507 -- lists of modules and suchlike, so put these all in canonical order:
508 let sorted_deps = sortDependencies (mi_deps iface0)
510 -- the export hash of a module depends on the orphan hashes of the
511 -- orphan modules below us in the dependeny tree. This is the way
512 -- that changes in orphans get propagated all the way up the
513 -- dependency tree. We only care about orphan modules in the current
514 -- package, because changes to orphans outside this package will be
515 -- tracked by the usage on the ABI hash of package modules that we import.
516 let orph_mods = filter ((== this_pkg) . modulePackageId)
517 $ dep_orphs sorted_deps
518 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
520 orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
521 (map IfaceInstABI orph_insts, orph_rules, fam_insts)
523 -- the export list hash doesn't depend on the fingerprints of
524 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
525 export_hash <- computeFingerprint dflags putNameLiterally
526 (mi_exports iface0, orphan_hash, dep_orphan_hashes)
528 -- put the declarations in a canonical order, sorted by OccName
529 let sorted_decls = eltsFM $ listToFM $
530 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
532 -- the ABI hash depends on:
538 mod_hash <- computeFingerprint dflags putNameLiterally
539 (map fst sorted_decls,
544 -- The interface hash depends on:
545 -- - the ABI hash, plus
549 iface_hash <- computeFingerprint dflags putNameLiterally
556 no_change_at_all = Just iface_hash == mb_old_fingerprint
558 final_iface = iface0 {
559 mi_mod_hash = mod_hash,
560 mi_iface_hash = iface_hash,
561 mi_exp_hash = export_hash,
562 mi_orphan_hash = orphan_hash,
563 mi_orphan = not (null orph_rules && null orph_insts),
564 mi_finsts = not . null $ mi_fam_insts iface0,
565 mi_decls = sorted_decls,
566 mi_hash_fn = lookupOccEnv local_env }
568 return (final_iface, no_change_at_all)
571 this_mod = mi_module iface0
572 dflags = hsc_dflags hsc_env
573 this_pkg = thisPackage dflags
574 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
575 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
576 -- ToDo: shouldn't we be splitting fam_insts into orphans and
578 fam_insts = mi_fam_insts iface0
579 fix_fn = mi_fix_fn iface0
582 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
583 getOrphanHashes hsc_env mods = do
584 eps <- hscEPS hsc_env
586 hpt = hsc_HPT hsc_env
588 dflags = hsc_dflags hsc_env
590 case lookupIfaceByModule dflags hpt pit mod of
591 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
592 Just iface -> mi_orphan_hash iface
594 return (map get_orph_hash mods)
597 sortDependencies :: Dependencies -> Dependencies
599 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
600 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
601 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
602 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
604 -- The ABI of a declaration consists of:
605 -- the full name of the identifier (inc. module and package, because
606 -- these are used to construct the symbol name by which the
607 -- identifier is known externally).
608 -- the fixity of the identifier
609 -- the declaration itself, as exposed to clients. That is, the
610 -- definition of an Id is included in the fingerprint only if
611 -- it is made available as as unfolding in the interface.
613 -- for classes: instances, fixity & rules for methods
614 -- for datatypes: instances, fixity & rules for constrs
615 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
617 abiDecl :: IfaceDeclABI -> IfaceDecl
618 abiDecl (_, decl, _) = decl
620 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
621 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
622 ifName (abiDecl abi2)
624 freeNamesDeclABI :: IfaceDeclABI -> NameSet
625 freeNamesDeclABI (_mod, decl, extras) =
626 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
629 = IfaceIdExtras Fixity [IfaceRule]
630 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
631 | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
632 | IfaceSynExtras Fixity
633 | IfaceOtherDeclExtras
635 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
636 freeNamesDeclExtras (IfaceIdExtras _ rules)
637 = unionManyNameSets (map freeNamesIfRule rules)
638 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
639 = unionManyNameSets (map freeNamesSub subs)
640 freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
641 = unionManyNameSets (map freeNamesSub subs)
642 freeNamesDeclExtras (IfaceSynExtras _)
644 freeNamesDeclExtras IfaceOtherDeclExtras
647 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
648 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
650 instance Binary IfaceDeclExtras where
651 get _bh = panic "no get for IfaceDeclExtras"
652 put_ bh (IfaceIdExtras fix rules) = do
653 putByte bh 1; put_ bh fix; put_ bh rules
654 put_ bh (IfaceDataExtras fix insts cons) = do
655 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
656 put_ bh (IfaceClassExtras fix insts methods) = do
657 putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
658 put_ bh (IfaceSynExtras fix) = do
659 putByte bh 4; put_ bh fix
660 put_ bh IfaceOtherDeclExtras = do
663 declExtras :: (OccName -> Fixity)
664 -> OccEnv [IfaceRule]
665 -> OccEnv [IfaceInst]
669 declExtras fix_fn rule_env inst_env decl
671 IfaceId{} -> IfaceIdExtras (fix_fn n)
672 (lookupOccEnvL rule_env n)
673 IfaceData{ifCons=cons} ->
674 IfaceDataExtras (fix_fn n)
675 (map IfaceInstABI $ lookupOccEnvL inst_env n)
676 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
677 IfaceClass{ifSigs=sigs} ->
678 IfaceClassExtras (fix_fn n)
679 (map IfaceInstABI $ lookupOccEnvL inst_env n)
680 [id_extras op | IfaceClassOp op _ _ <- sigs]
681 IfaceSyn{} -> IfaceSynExtras (fix_fn n)
682 _other -> IfaceOtherDeclExtras
685 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
688 -- When hashing an instance, we hash only its structure, not the
689 -- fingerprints of the things it mentions. See the section on instances
690 -- in the commentary,
691 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
693 newtype IfaceInstABI = IfaceInstABI IfaceInst
695 instance Binary IfaceInstABI where
696 get = panic "no get for IfaceInstABI"
697 put_ bh (IfaceInstABI inst) = do
698 let ud = getUserData bh
699 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
702 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
703 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
705 -- used when we want to fingerprint a structure without depending on the
706 -- fingerprints of external Names that it refers to.
707 putNameLiterally :: BinHandle -> Name -> IO ()
708 putNameLiterally bh name = ASSERT( isExternalName name )
709 do { put_ bh $! nameModule name
710 ; put_ bh $! nameOccName name }
712 computeFingerprint :: Binary a
714 -> (BinHandle -> Name -> IO ())
718 computeFingerprint _dflags put_name a = do
719 bh <- openBinMem (3*1024) -- just less than a block
720 ud <- newWriteState put_name putFS
721 bh <- return $ setUserData bh ud
726 -- for testing: use the md5sum command to generate fingerprints and
727 -- compare the results against our built-in version.
728 fp' <- oldMD5 dflags bh
729 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
732 oldMD5 dflags bh = do
733 tmp <- newTempName dflags "bin"
735 tmp2 <- newTempName dflags "md5"
736 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
739 ExitFailure _ -> ghcError (PhaseFailed cmd r)
741 hash_str <- readFile tmp2
742 return $! readHexFingerprint hash_str
745 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
746 instOrphWarn unqual inst
747 = mkWarnMsg (getSrcSpan inst) unqual $
748 hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
750 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
751 ruleOrphWarn unqual mod rule
752 = mkWarnMsg silly_loc unqual $
753 ptext (sLit "Orphan rule:") <+> ppr rule
755 silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 0)
756 -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
757 -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
759 ----------------------
760 -- mkOrphMap partitions instance decls or rules into
761 -- (a) an OccEnv for ones that are not orphans,
762 -- mapping the local OccName to a list of its decls
763 -- (b) a list of orphan decls
764 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
765 -- Nothing for an orphan decl
766 -> [decl] -- Sorted into canonical order
767 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
768 -- each sublist in canonical order
769 [decl]) -- Orphan decls; in canonical order
770 mkOrphMap get_key decls
771 = foldl go (emptyOccEnv, []) decls
773 go (non_orphs, orphs) d
774 | Just occ <- get_key d
775 = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
776 | otherwise = (non_orphs, d:orphs)
780 %*********************************************************
782 \subsection{Keeping track of what we've slurped, and fingerprints}
784 %*********************************************************
788 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
789 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
790 = do { eps <- hscEPS hsc_env
791 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
792 dir_imp_mods used_names
793 ; usages `seqList` return usages }
794 -- seq the list of Usages returned: occasionally these
795 -- don't get evaluated for a while and we can end up hanging on to
796 -- the entire collection of Ifaces.
798 mk_usage_info :: PackageIfaceTable
804 mk_usage_info pit hsc_env this_mod direct_imports used_names
805 = mapCatMaybes mkUsage usage_mods
807 hpt = hsc_HPT hsc_env
808 dflags = hsc_dflags hsc_env
809 this_pkg = thisPackage dflags
811 used_mods = moduleEnvKeys ent_map
812 dir_imp_mods = (moduleEnvKeys direct_imports)
813 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
814 usage_mods = sortBy stableModuleCmp all_mods
815 -- canonical order is imported, to avoid interface-file
818 -- ent_map groups together all the things imported and used
819 -- from a particular module
820 ent_map :: ModuleEnv [OccName]
821 ent_map = foldNameSet add_mv emptyModuleEnv used_names
824 | isWiredInName name = mv_map -- ignore wired-in names
826 = case nameModule_maybe name of
827 Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
828 Just mod -> -- We use this fiddly lambda function rather than
829 -- (++) as the argument to extendModuleEnv_C to
830 -- avoid quadratic behaviour (trac #2680)
831 extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
832 where occ = nameOccName name
834 -- We want to create a Usage for a home module if
835 -- a) we used something from it; has something in used_names
836 -- b) we imported it, even if we used nothing from it
837 -- (need to recompile if its export list changes: export_fprint)
838 mkUsage :: Module -> Maybe Usage
840 | isNothing maybe_iface -- We can't depend on it if we didn't
841 -- load its interface.
842 || mod == this_mod -- We don't care about usages of
843 -- things in *this* module
846 | modulePackageId mod /= this_pkg
847 = Just UsagePackageModule{ usg_mod = mod,
848 usg_mod_hash = mod_hash }
849 -- for package modules, we record the module hash only
852 && isNothing export_hash
853 && not is_direct_import
855 = Nothing -- Record no usage info
856 -- for directly-imported modules, we always want to record a usage
857 -- on the orphan hash. This is what triggers a recompilation if
858 -- an orphan is added or removed somewhere below us in the future.
861 = Just UsageHomeModule {
862 usg_mod_name = moduleName mod,
863 usg_mod_hash = mod_hash,
864 usg_exports = export_hash,
865 usg_entities = fmToList ent_hashs }
867 maybe_iface = lookupIfaceByModule dflags hpt pit mod
868 -- In one-shot mode, the interfaces for home-package
869 -- modules accumulate in the PIT not HPT. Sigh.
871 is_direct_import = mod `elemModuleEnv` direct_imports
873 Just iface = maybe_iface
874 finsts_mod = mi_finsts iface
875 hash_env = mi_hash_fn iface
876 mod_hash = mi_mod_hash iface
877 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
878 | otherwise = Nothing
880 used_occs = lookupModuleEnv ent_map mod `orElse` []
882 -- Making a FiniteMap here ensures that (a) we remove duplicates
883 -- when we have usages on several subordinates of a single parent,
884 -- and (b) that the usages emerge in a canonical order, which
885 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
886 -- using Ord on the OccNames, which is a lexicographic ordering.
887 ent_hashs :: FiniteMap OccName Fingerprint
888 ent_hashs = listToFM (map lookup_occ used_occs)
892 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
895 depend_on_exports mod =
896 case lookupModuleEnv direct_imports mod of
898 -- Even if we used 'import M ()', we have to register a
899 -- usage on the export list because we are sensitive to
900 -- changes in orphan instances/rules.
902 -- In GHC 6.8.x the above line read "True", and in
903 -- fact it recorded a dependency on *all* the
904 -- modules underneath in the dependency tree. This
905 -- happens to make orphans work right, but is too
906 -- expensive: it'll read too many interface files.
907 -- The 'isNothing maybe_iface' check above saved us
908 -- from generating many of these usages (at least in
909 -- one-shot mode), but that's even more bogus!
913 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
914 mkIfaceAnnotations = map mkIfaceAnnotation
916 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
917 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
918 ifAnnotatedTarget = fmap nameOccName target,
919 ifAnnotatedValue = serialized
924 mkIfaceExports :: [AvailInfo]
925 -> [(Module, [GenAvailInfo OccName])]
926 -- Group by module and sort by occurrence
927 mkIfaceExports exports
928 = [ (mod, eltsFM avails)
929 | (mod, avails) <- sortBy (stableModuleCmp `on` fst) (fmToList groupFM)
930 -- NB. the fmToList is in a random order,
931 -- because Ord Module is not a predictable
932 -- ordering. Hence we perform a final sort
933 -- using the stable Module ordering.
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
1457 , sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
1458 toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
1459 IfVanillaId -- Unexpected
1461 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1462 toIfaceIdInfo id_info
1463 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1464 inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
1466 ------------ Arity --------------
1467 arity_info = arityInfo id_info
1468 arity_hsinfo | arity_info == 0 = Nothing
1469 | otherwise = Just (HsArity arity_info)
1471 ------------ Caf Info --------------
1472 caf_info = cafInfo id_info
1473 caf_hsinfo = case caf_info of
1474 NoCafRefs -> Just HsNoCafRefs
1477 ------------ Strictness --------------
1478 -- No point in explicitly exporting TopSig
1479 strict_hsinfo = case newStrictnessInfo id_info of
1480 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1483 ------------ Worker --------------
1484 work_info = workerInfo id_info
1485 has_worker = workerExists work_info
1486 wrkr_hsinfo = case work_info of
1487 HasWorker work_id wrap_arity ->
1488 Just (HsWorker ((idName work_id)) wrap_arity)
1491 ------------ Unfolding --------------
1492 -- The unfolding is redundant if there is a worker
1493 unfold_info = unfoldingInfo id_info
1494 rhs = unfoldingTemplate unfold_info
1495 no_unfolding = neverUnfold unfold_info
1496 -- The CoreTidy phase retains unfolding info iff
1497 -- we want to expose the unfolding, taking into account
1498 -- unconditional NOINLINE, etc. See TidyPgm.addExternal
1499 unfold_hsinfo | no_unfolding = Nothing
1500 | has_worker = Nothing -- Unfolding is implicit
1501 | otherwise = Just (HsUnfold (toIfaceExpr rhs))
1503 ------------ Inline prag --------------
1504 inline_prag = inlinePragInfo id_info
1505 inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1506 | no_unfolding && not has_worker
1507 && isFunLike (inlinePragmaRuleMatchInfo inline_prag)
1509 -- If the iface file give no unfolding info, we
1510 -- don't need to say when inlining is OK!
1511 | otherwise = Just (HsInline inline_prag)
1513 --------------------------
1514 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1515 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1516 = pprTrace "toHsRule: builtin" (ppr fn) $
1519 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1520 ru_act = act, ru_bndrs = bndrs,
1521 ru_args = args, ru_rhs = rhs })
1522 = IfaceRule { ifRuleName = name, ifActivation = act,
1523 ifRuleBndrs = map toIfaceBndr bndrs,
1525 ifRuleArgs = map do_arg args,
1526 ifRuleRhs = toIfaceExpr rhs,
1529 -- For type args we must remove synonyms from the outermost
1530 -- level. Reason: so that when we read it back in we'll
1531 -- construct the same ru_rough field as we have right now;
1533 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1534 do_arg arg = toIfaceExpr arg
1536 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1537 -- A rule is an orphan only if none of the variables
1538 -- mentioned on its left-hand side are locally defined
1539 lhs_names = fn : nameSetToList (exprsFreeNames args)
1540 -- No need to delete bndrs, because
1541 -- exprsFreeNames finds only External names
1543 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1544 (n : _) -> Just (nameOccName n)
1547 bogusIfaceRule :: Name -> IfaceRule
1548 bogusIfaceRule id_name
1549 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1550 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1551 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1553 ---------------------
1554 toIfaceExpr :: CoreExpr -> IfaceExpr
1555 toIfaceExpr (Var v) = toIfaceVar v
1556 toIfaceExpr (Lit l) = IfaceLit l
1557 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1558 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1559 toIfaceExpr (App f a) = toIfaceApp f [a]
1560 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1561 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1562 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1563 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1565 ---------------------
1566 toIfaceNote :: Note -> IfaceNote
1567 toIfaceNote (SCC cc) = IfaceSCC cc
1568 toIfaceNote InlineMe = IfaceInlineMe
1569 toIfaceNote (CoreNote s) = IfaceCoreNote s
1571 ---------------------
1572 toIfaceBind :: Bind Id -> IfaceBinding
1573 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1574 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1576 ---------------------
1577 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1578 -> (IfaceConAlt, [FastString], IfaceExpr)
1579 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1581 ---------------------
1582 toIfaceCon :: AltCon -> IfaceConAlt
1583 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1584 | otherwise = IfaceDataAlt (getName dc)
1586 tc = dataConTyCon dc
1588 toIfaceCon (LitAlt l) = IfaceLitAlt l
1589 toIfaceCon DEFAULT = IfaceDefault
1591 ---------------------
1592 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1593 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1594 toIfaceApp (Var v) as
1595 = case isDataConWorkId_maybe v of
1596 -- We convert the *worker* for tuples into IfaceTuples
1597 Just dc | isTupleTyCon tc && saturated
1598 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1600 val_args = dropWhile isTypeArg as
1601 saturated = val_args `lengthIs` idArity v
1602 tup_args = map toIfaceExpr val_args
1603 tc = dataConTyCon dc
1605 _ -> mkIfaceApps (toIfaceVar v) as
1607 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1609 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1610 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1612 ---------------------
1613 toIfaceVar :: Id -> IfaceExpr
1615 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1616 -- Foreign calls have special syntax
1617 | isExternalName name = IfaceExt name
1618 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1620 | otherwise = IfaceLcl (getFS name)