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 -- This keeps the list in canonical order
928 mkIfaceExports exports
929 = [ (mod, eltsFM avails)
930 | (mod, avails) <- fmToList groupFM
933 -- Group by the module where the exported entities are defined
934 -- (which may not be the same for all Names in an Avail)
935 -- Deliberately use FiniteMap rather than UniqFM so we
936 -- get a canonical ordering
937 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
938 groupFM = foldl add emptyModuleEnv exports
940 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
941 -> Module -> GenAvailInfo OccName
942 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
943 add_one env mod avail
944 = extendModuleEnv_C plusFM env mod
945 (unitFM (occNameFS (availName avail)) avail)
947 -- NB: we should not get T(X) and T(Y) in the export list
948 -- else the plusFM will simply discard one! They
949 -- should have been combined by now.
951 = ASSERT( isExternalName n )
952 add_one env (nameModule n) (Avail (nameOccName n))
954 add env (AvailTC tc ns)
955 = ASSERT( all isExternalName ns )
956 foldl add_for_mod env mods
958 tc_occ = nameOccName tc
959 mods = nub (map nameModule ns)
960 -- Usually just one, but see Note [Original module]
963 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
964 -- NB. sort the children, we need a canonical order
966 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
969 Note [Orignal module]
970 ~~~~~~~~~~~~~~~~~~~~~
972 module X where { data family T }
973 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
974 The exported Avail from Y will look like
977 - only MkT is brought into scope by the data instance;
978 - but the parent (used for grouping and naming in T(..) exports) is X.T
979 - and in this case we export X.T too
981 In the result of MkIfaceExports, the names are grouped by defining module,
982 so we may need to split up a single Avail into multiple ones.
985 %************************************************************************
987 Load the old interface file for this module (unless
988 we have it aleady), and check whether it is up to date
991 %************************************************************************
994 checkOldIface :: HscEnv
996 -> Bool -- Source unchanged
997 -> Maybe ModIface -- Old interface from compilation manager, if any
998 -> IO (RecompileRequired, Maybe ModIface)
1000 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1001 = do { showPass (hsc_dflags hsc_env)
1002 ("Checking old interface for " ++
1003 showSDoc (ppr (ms_mod mod_summary))) ;
1005 ; initIfaceCheck hsc_env $
1006 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1009 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1010 -> IfG (Bool, Maybe ModIface)
1011 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1012 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
1013 { when (not source_unchanged)
1014 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1016 -- If the source has changed and we're in interactive mode, avoid reading
1017 -- an interface; just return the one we might have been supplied with.
1018 ; let dflags = hsc_dflags hsc_env
1019 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1020 return (outOfDate, maybe_iface)
1022 case maybe_iface of {
1023 Just old_iface -> do -- Use the one we already have
1024 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1025 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1026 ; return (recomp, Just old_iface) }
1030 -- Try and read the old interface for the current module
1031 -- from the .hi file left from the last time we compiled it
1032 { let iface_path = msHiFilePath mod_summary
1033 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1034 ; case read_result of {
1035 Failed err -> do -- Old interface file not found, or garbled; give up
1036 { traceIf (text "FYI: cannot read old interface file:"
1038 ; return (outOfDate, Nothing) }
1040 ; Succeeded iface -> do
1042 -- We have got the old iface; check its versions
1043 { traceIf (text "Read the interface file" <+> text iface_path)
1044 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1045 ; return (recomp, Just iface)
1050 @recompileRequired@ is called from the HscMain. It checks whether
1051 a recompilation is required. It needs access to the persistent state,
1052 finder, etc, because it may have to load lots of interface files to
1053 check their versions.
1056 type RecompileRequired = Bool
1057 upToDate, outOfDate :: Bool
1058 upToDate = False -- Recompile not required
1059 outOfDate = True -- Recompile required
1061 checkVersions :: HscEnv
1062 -> Bool -- True <=> source unchanged
1064 -> ModIface -- Old interface
1065 -> IfG RecompileRequired
1066 checkVersions hsc_env source_unchanged mod_summary iface
1067 | not source_unchanged
1070 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1071 ppr (mi_module iface) <> colon)
1073 ; recomp <- checkDependencies hsc_env mod_summary iface
1074 ; if recomp then return outOfDate else do {
1076 -- Source code unchanged and no errors yet... carry on
1078 -- First put the dependent-module info, read from the old
1079 -- interface, into the envt, so that when we look for
1080 -- interfaces we look for the right one (.hi or .hi-boot)
1082 -- It's just temporary because either the usage check will succeed
1083 -- (in which case we are done with this module) or it'll fail (in which
1084 -- case we'll compile the module from scratch anyhow).
1086 -- We do this regardless of compilation mode, although in --make mode
1087 -- all the dependent modules should be in the HPT already, so it's
1089 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1091 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1092 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1095 -- This is a bit of a hack really
1096 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1097 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1100 -- If the direct imports of this module are resolved to targets that
1101 -- are not among the dependencies of the previous interface file,
1102 -- then we definitely need to recompile. This catches cases like
1103 -- - an exposed package has been upgraded
1104 -- - we are compiling with different package flags
1105 -- - a home module that was shadowing a package module has been removed
1106 -- - a new home module has been added that shadows a package module
1109 -- Returns True if recompilation is required.
1110 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1111 checkDependencies hsc_env summary iface
1112 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1114 prev_dep_mods = dep_mods (mi_deps iface)
1115 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1117 this_pkg = thisPackage (hsc_dflags hsc_env)
1119 orM = foldr f (return False)
1120 where f m rest = do b <- m; if b then return True else rest
1122 dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
1123 find_res <- liftIO $ findImportedModule hsc_env mod pkg
1127 -> if moduleName mod `notElem` map fst prev_dep_mods
1128 then do traceHiDiffs $
1129 text "imported module " <> quotes (ppr mod) <>
1130 text " not among previous dependencies"
1135 -> if pkg `notElem` prev_dep_pkgs
1136 then do traceHiDiffs $
1137 text "imported module " <> quotes (ppr mod) <>
1138 text " is from package " <> quotes (ppr pkg) <>
1139 text ", which is not among previous dependencies"
1143 where pkg = modulePackageId mod
1144 _otherwise -> return outOfDate
1146 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1147 -> IfG RecompileRequired
1148 needInterface mod continue
1149 = do -- Load the imported interface if possible
1150 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1151 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1153 mb_iface <- loadInterface doc_str mod ImportBySystem
1154 -- Load the interface, but don't complain on failure;
1155 -- Instead, get an Either back which we can test
1158 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1160 -- Couldn't find or parse a module mentioned in the
1161 -- old interface file. Don't complain: it might
1162 -- just be that the current module doesn't need that
1163 -- import and it's been deleted
1164 Succeeded iface -> continue iface
1167 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1168 -- Given the usage information extracted from the old
1169 -- M.hi file for the module being compiled, figure out
1170 -- whether M needs to be recompiled.
1172 checkModUsage _this_pkg UsagePackageModule{
1174 usg_mod_hash = old_mod_hash }
1175 = needInterface mod $ \iface -> do
1176 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1177 -- We only track the ABI hash of package modules, rather than
1178 -- individual entity usages, so if the ABI hash changes we must
1179 -- recompile. This is safe but may entail more recompilation when
1180 -- a dependent package has changed.
1182 checkModUsage this_pkg UsageHomeModule{
1183 usg_mod_name = mod_name,
1184 usg_mod_hash = old_mod_hash,
1185 usg_exports = maybe_old_export_hash,
1186 usg_entities = old_decl_hash }
1188 let mod = mkModule this_pkg mod_name
1189 needInterface mod $ \iface -> do
1192 new_mod_hash = mi_mod_hash iface
1193 new_decl_hash = mi_hash_fn iface
1194 new_export_hash = mi_exp_hash iface
1197 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1198 if not recompile then return upToDate else do
1200 -- CHECK EXPORT LIST
1201 checkMaybeHash maybe_old_export_hash new_export_hash
1202 (ptext (sLit " Export list changed")) $ do
1204 -- CHECK ITEMS ONE BY ONE
1205 recompile <- checkList [ checkEntityUsage new_decl_hash u
1206 | u <- old_decl_hash]
1208 then return outOfDate -- This one failed, so just bail out now
1209 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1211 ------------------------
1212 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1213 checkModuleFingerprint old_mod_hash new_mod_hash
1214 | new_mod_hash == old_mod_hash
1215 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1218 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1219 old_mod_hash new_mod_hash
1221 ------------------------
1222 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1223 -> IfG RecompileRequired -> IfG RecompileRequired
1224 checkMaybeHash maybe_old_hash new_hash doc continue
1225 | Just hash <- maybe_old_hash, hash /= new_hash
1226 = out_of_date_hash doc hash new_hash
1230 ------------------------
1231 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1232 -> (OccName, Fingerprint)
1234 checkEntityUsage new_hash (name,old_hash)
1235 = case new_hash name of
1237 Nothing -> -- We used it before, but it ain't there now
1238 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1240 Just (_, new_hash) -- It's there, but is it up to date?
1241 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1243 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1246 up_to_date, out_of_date :: SDoc -> IfG Bool
1247 up_to_date msg = traceHiDiffs msg >> return upToDate
1248 out_of_date msg = traceHiDiffs msg >> return outOfDate
1250 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1251 out_of_date_hash msg old_hash new_hash
1252 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1254 ----------------------
1255 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1256 -- This helper is used in two places
1257 checkList [] = return upToDate
1258 checkList (check:checks) = do recompile <- check
1260 then return outOfDate
1261 else checkList checks
1264 %************************************************************************
1266 Converting things to their Iface equivalents
1268 %************************************************************************
1271 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1272 -- Assumption: the thing is already tidied, so that locally-bound names
1273 -- (lambdas, for-alls) already have non-clashing OccNames
1274 -- Reason: Iface stuff uses OccNames, and the conversion here does
1275 -- not do tidying on the way
1276 tyThingToIfaceDecl (AnId id)
1277 = IfaceId { ifName = getOccName id,
1278 ifType = toIfaceType (idType id),
1279 ifIdDetails = toIfaceIdDetails (idDetails id),
1282 info = case toIfaceIdInfo (idInfo id) of
1284 items -> HasInfo items
1286 tyThingToIfaceDecl (AClass clas)
1287 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1288 ifName = getOccName clas,
1289 ifTyVars = toIfaceTvBndrs clas_tyvars,
1290 ifFDs = map toIfaceFD clas_fds,
1291 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1292 ifSigs = map toIfaceClassOp op_stuff,
1293 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1295 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1296 = classExtraBigSig clas
1297 tycon = classTyCon clas
1299 toIfaceClassOp (sel_id, def_meth)
1300 = ASSERT(sel_tyvars == clas_tyvars)
1301 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1303 -- Be careful when splitting the type, because of things
1304 -- like class Foo a where
1305 -- op :: (?x :: String) => a -> a
1306 -- and class Baz a where
1307 -- op :: (Ord a) => a -> a
1308 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1309 op_ty = funResultTy rho_ty
1311 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1313 tyThingToIfaceDecl (ATyCon tycon)
1315 = IfaceSyn { ifName = getOccName tycon,
1316 ifTyVars = toIfaceTvBndrs tyvars,
1319 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1323 = IfaceData { ifName = getOccName tycon,
1324 ifTyVars = toIfaceTvBndrs tyvars,
1325 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1326 ifCons = ifaceConDecls (algTyConRhs tycon),
1327 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1328 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1329 ifGeneric = tyConHasGenerics tycon,
1330 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1332 | isForeignTyCon tycon
1333 = IfaceForeign { ifName = getOccName tycon,
1334 ifExtName = tyConExtName tycon }
1336 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1338 tyvars = tyConTyVars tycon
1340 = case synTyConRhs tycon of
1341 OpenSynTyCon ki _ -> (Nothing, toIfaceType ki)
1342 SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1344 ifaceConDecls (NewTyCon { data_con = con }) =
1345 IfNewTyCon (ifaceConDecl con)
1346 ifaceConDecls (DataTyCon { data_cons = cons }) =
1347 IfDataTyCon (map ifaceConDecl cons)
1348 ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
1349 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1350 -- The last case happens when a TyCon has been trimmed during tidying
1351 -- Furthermore, tyThingToIfaceDecl is also used
1352 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1353 -- AbstractTyCon case is perfectly sensible.
1355 ifaceConDecl data_con
1356 = IfCon { ifConOcc = getOccName (dataConName data_con),
1357 ifConInfix = dataConIsInfix data_con,
1358 ifConWrapper = isJust (dataConWrapId_maybe data_con),
1359 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1360 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1361 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1362 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1363 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1364 ifConFields = map getOccName
1365 (dataConFieldLabels data_con),
1366 ifConStricts = dataConStrictMarks data_con }
1368 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1370 famInstToIface Nothing = Nothing
1371 famInstToIface (Just (famTyCon, instTys)) =
1372 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1374 tyThingToIfaceDecl (ADataCon dc)
1375 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1378 getFS :: NamedThing a => a -> FastString
1379 getFS x = occNameFS (getOccName x)
1381 --------------------------
1382 instanceToIfaceInst :: Instance -> IfaceInst
1383 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1384 is_cls = cls_name, is_tcs = mb_tcs })
1385 = ASSERT( cls_name == className cls )
1386 IfaceInst { ifDFun = dfun_name,
1388 ifInstCls = cls_name,
1389 ifInstTys = map do_rough mb_tcs,
1392 do_rough Nothing = Nothing
1393 do_rough (Just n) = Just (toIfaceTyCon_name n)
1395 dfun_name = idName dfun_id
1396 mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1397 is_local name = nameIsLocalOrFrom mod name
1399 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1400 (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1401 -- Slightly awkward: we need the Class to get the fundeps
1402 (tvs, fds) = classTvsFds cls
1403 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1404 orph | is_local cls_name = Just (nameOccName cls_name)
1405 | all isJust mb_ns = head mb_ns
1406 | otherwise = Nothing
1408 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1409 -- that is not in the "determined" arguments
1410 mb_ns | null fds = [choose_one arg_names]
1411 | otherwise = map do_one fds
1412 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1413 , not (tv `elem` rtvs)]
1415 choose_one :: [NameSet] -> Maybe OccName
1416 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1418 (n : _) -> Just (nameOccName n)
1420 --------------------------
1421 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1422 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1425 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1426 , ifFamInstFam = fam
1427 , ifFamInstTys = map do_rough mb_tcs }
1429 do_rough Nothing = Nothing
1430 do_rough (Just n) = Just (toIfaceTyCon_name n)
1432 --------------------------
1433 toIfaceLetBndr :: Id -> IfaceLetBndr
1434 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1435 (toIfaceType (idType id))
1438 -- Stripped-down version of tcIfaceIdInfo
1439 -- Change this if you want to export more IdInfo for
1440 -- non-top-level Ids. Don't forget to change
1441 -- CoreTidy.tidyLetBndr too!
1443 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1445 inline_prag = inlinePragInfo id_info
1446 prag_info | isDefaultInlinePragma inline_prag = NoInfo
1447 | otherwise = HasInfo [HsInline inline_prag]
1449 --------------------------
1450 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
1451 toIfaceIdDetails VanillaId = IfVanillaId
1452 toIfaceIdDetails DFunId = IfVanillaId
1453 toIfaceIdDetails (RecSelId { sel_naughty = n
1454 , sel_tycon = tc }) = IfRecSelId (toIfaceTyCon tc) n
1455 toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
1456 IfVanillaId -- Unexpected
1458 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1459 toIfaceIdInfo id_info
1460 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1461 inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
1463 ------------ Arity --------------
1464 arity_info = arityInfo id_info
1465 arity_hsinfo | arity_info == 0 = Nothing
1466 | otherwise = Just (HsArity arity_info)
1468 ------------ Caf Info --------------
1469 caf_info = cafInfo id_info
1470 caf_hsinfo = case caf_info of
1471 NoCafRefs -> Just HsNoCafRefs
1474 ------------ Strictness --------------
1475 -- No point in explicitly exporting TopSig
1476 strict_hsinfo = case newStrictnessInfo id_info of
1477 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1480 ------------ Worker --------------
1481 work_info = workerInfo id_info
1482 has_worker = workerExists work_info
1483 wrkr_hsinfo = case work_info of
1484 HasWorker work_id wrap_arity ->
1485 Just (HsWorker ((idName work_id)) wrap_arity)
1488 ------------ Unfolding --------------
1489 -- The unfolding is redundant if there is a worker
1490 unfold_info = unfoldingInfo id_info
1491 rhs = unfoldingTemplate unfold_info
1492 no_unfolding = neverUnfold unfold_info
1493 -- The CoreTidy phase retains unfolding info iff
1494 -- we want to expose the unfolding, taking into account
1495 -- unconditional NOINLINE, etc. See TidyPgm.addExternal
1496 unfold_hsinfo | no_unfolding = Nothing
1497 | has_worker = Nothing -- Unfolding is implicit
1498 | otherwise = Just (HsUnfold (toIfaceExpr rhs))
1500 ------------ Inline prag --------------
1501 inline_prag = inlinePragInfo id_info
1502 inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1503 | no_unfolding && not has_worker
1504 && isFunLike (inlinePragmaRuleMatchInfo inline_prag)
1506 -- If the iface file give no unfolding info, we
1507 -- don't need to say when inlining is OK!
1508 | otherwise = Just (HsInline inline_prag)
1510 --------------------------
1511 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1512 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1513 = pprTrace "toHsRule: builtin" (ppr fn) $
1516 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1517 ru_act = act, ru_bndrs = bndrs,
1518 ru_args = args, ru_rhs = rhs })
1519 = IfaceRule { ifRuleName = name, ifActivation = act,
1520 ifRuleBndrs = map toIfaceBndr bndrs,
1522 ifRuleArgs = map do_arg args,
1523 ifRuleRhs = toIfaceExpr rhs,
1526 -- For type args we must remove synonyms from the outermost
1527 -- level. Reason: so that when we read it back in we'll
1528 -- construct the same ru_rough field as we have right now;
1530 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1531 do_arg arg = toIfaceExpr arg
1533 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1534 -- A rule is an orphan only if none of the variables
1535 -- mentioned on its left-hand side are locally defined
1536 lhs_names = fn : nameSetToList (exprsFreeNames args)
1537 -- No need to delete bndrs, because
1538 -- exprsFreeNames finds only External names
1540 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1541 (n : _) -> Just (nameOccName n)
1544 bogusIfaceRule :: Name -> IfaceRule
1545 bogusIfaceRule id_name
1546 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1547 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1548 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1550 ---------------------
1551 toIfaceExpr :: CoreExpr -> IfaceExpr
1552 toIfaceExpr (Var v) = toIfaceVar v
1553 toIfaceExpr (Lit l) = IfaceLit l
1554 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1555 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1556 toIfaceExpr (App f a) = toIfaceApp f [a]
1557 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1558 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1559 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1560 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1562 ---------------------
1563 toIfaceNote :: Note -> IfaceNote
1564 toIfaceNote (SCC cc) = IfaceSCC cc
1565 toIfaceNote InlineMe = IfaceInlineMe
1566 toIfaceNote (CoreNote s) = IfaceCoreNote s
1568 ---------------------
1569 toIfaceBind :: Bind Id -> IfaceBinding
1570 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1571 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1573 ---------------------
1574 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1575 -> (IfaceConAlt, [FastString], IfaceExpr)
1576 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1578 ---------------------
1579 toIfaceCon :: AltCon -> IfaceConAlt
1580 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1581 | otherwise = IfaceDataAlt (getName dc)
1583 tc = dataConTyCon dc
1585 toIfaceCon (LitAlt l) = IfaceLitAlt l
1586 toIfaceCon DEFAULT = IfaceDefault
1588 ---------------------
1589 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1590 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1591 toIfaceApp (Var v) as
1592 = case isDataConWorkId_maybe v of
1593 -- We convert the *worker* for tuples into IfaceTuples
1594 Just dc | isTupleTyCon tc && saturated
1595 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1597 val_args = dropWhile isTypeArg as
1598 saturated = val_args `lengthIs` idArity v
1599 tup_args = map toIfaceExpr val_args
1600 tc = dataConTyCon dc
1602 _ -> mkIfaceApps (toIfaceVar v) as
1604 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1606 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1607 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1609 ---------------------
1610 toIfaceVar :: Id -> IfaceExpr
1612 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1613 -- Foreign calls have special syntax
1614 | isExternalName name = IfaceExt name
1615 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1617 | otherwise = IfaceLcl (getFS name)