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