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 )
101 import System.FilePath
102 import System.Exit ( exitWith, ExitCode(..) )
107 %************************************************************************
109 \subsection{Completing an interface}
111 %************************************************************************
115 -> Maybe Fingerprint -- The old fingerprint, if we have it
116 -> ModDetails -- The trimmed, tidied interface
117 -> ModGuts -- Usages, deprecations, etc
118 -> IO (ModIface, -- The new one
119 Bool) -- True <=> there was an old Iface, and the
120 -- new one is identical, so no need
123 mkIface hsc_env maybe_old_fingerprint mod_details
124 ModGuts{ mg_module = this_mod,
126 mg_used_names = used_names,
128 mg_dir_imps = dir_imp_mods,
129 mg_rdr_env = rdr_env,
130 mg_fix_env = fix_env,
132 mg_hpc_info = hpc_info }
133 = mkIface_ hsc_env maybe_old_fingerprint
134 this_mod is_boot used_names deps rdr_env
135 fix_env warns hpc_info dir_imp_mods mod_details
137 -- | make an interface from the results of typechecking only. Useful
138 -- for non-optimising compilation, or where we aren't generating any
139 -- object code at all ('HscNothing').
141 -> Maybe Fingerprint -- The old fingerprint, if we have it
142 -> ModDetails -- gotten from mkBootModDetails, probably
143 -> TcGblEnv -- Usages, deprecations, etc
146 mkIfaceTc hsc_env maybe_old_fingerprint mod_details
147 tc_result@TcGblEnv{ tcg_mod = this_mod,
149 tcg_imports = imports,
150 tcg_rdr_env = rdr_env,
151 tcg_fix_env = fix_env,
153 tcg_hpc = other_hpc_info
156 used_names <- mkUsedNames tc_result
157 deps <- mkDependencies tc_result
158 let hpc_info = emptyHpcInfo other_hpc_info
159 mkIface_ hsc_env maybe_old_fingerprint
160 this_mod (isHsBoot hsc_src) used_names deps rdr_env
161 fix_env warns hpc_info (imp_mods imports) mod_details
164 mkUsedNames :: TcGblEnv -> IO NameSet
166 TcGblEnv{ tcg_inst_uses = dfun_uses_var,
170 dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
171 return (allUses dus `unionNameSets` dfun_uses)
173 mkDependencies :: TcGblEnv -> IO Dependencies
175 TcGblEnv{ tcg_mod = mod,
176 tcg_imports = imports,
180 th_used <- readIORef th_var -- Whether TH is used
182 dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
183 -- M.hi-boot can be in the imp_dep_mods, but we must remove
184 -- it before recording the modules on which this one depends!
185 -- (We want to retain M.hi-boot in imp_dep_mods so that
186 -- loadHiBootInterface can see if M's direct imports depend
187 -- on M.hi-boot, and hence that we should do the hi-boot consistency
190 -- Modules don't compare lexicographically usually,
191 -- but we want them to do so here.
192 le_mod :: Module -> Module -> Bool
193 le_mod m1 m2 = moduleNameFS (moduleName m1)
194 <= moduleNameFS (moduleName m2)
196 le_dep_mod :: (ModuleName, IsBootInterface)
197 -> (ModuleName, IsBootInterface) -> Bool
198 le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
201 pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
202 | otherwise = imp_dep_pkgs imports
204 return Deps { dep_mods = sortLe le_dep_mod dep_mods,
205 dep_pkgs = sortLe (<=) pkgs,
206 dep_orphs = sortLe le_mod (imp_orphs imports),
207 dep_finsts = sortLe le_mod (imp_finsts imports) }
208 -- sort to get into canonical order
211 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
212 -> NameSet -> Dependencies -> GlobalRdrEnv
213 -> NameEnv FixItem -> Warnings -> HpcInfo
216 -> IO (ModIface, Bool)
217 mkIface_ hsc_env maybe_old_fingerprint
218 this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
220 ModDetails{ md_insts = insts,
221 md_fam_insts = fam_insts,
223 md_vect_info = vect_info,
225 md_exports = exports }
226 -- NB: notice that mkIface does not look at the bindings
227 -- only at the TypeEnv. The previous Tidy phase has
228 -- put exactly the info into the TypeEnv that we want
229 -- to expose in the interface
231 = do { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
233 ; let { entities = typeEnvElts type_env ;
234 decls = [ tyThingToIfaceDecl entity
235 | entity <- entities,
236 let name = getName entity,
237 not (isImplicitTyThing entity),
238 -- No implicit Ids and class tycons in the interface file
239 not (isWiredInName name),
240 -- Nor wired-in things; the compiler knows about them anyhow
241 nameIsLocalOrFrom this_mod name ]
242 -- Sigh: see Note [Root-main Id] in TcRnDriver
244 ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
246 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
247 ; iface_insts = map instanceToIfaceInst insts
248 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
249 ; iface_vect_info = flattenVectInfo vect_info
251 ; intermediate_iface = ModIface {
252 mi_module = this_mod,
256 mi_exports = mkIfaceExports exports,
258 -- Sort these lexicographically, so that
259 -- the result is stable across compilations
260 mi_insts = sortLe le_inst iface_insts,
261 mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
262 mi_rules = sortLe le_rule iface_rules,
264 mi_vect_info = iface_vect_info,
266 mi_fixities = fixities,
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 ; when (not (isEmptyBag orph_warnings))
306 (do { printErrorsAndWarnings dflags errs_and_warns
307 ; when (errorsFound dflags errs_and_warns)
308 (exitWith (ExitFailure 1)) })
310 -- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
313 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
314 (pprModIface new_iface)
316 -- bug #1617: on reload we weren't updating the PrintUnqualified
317 -- correctly. This stems from the fact that the interface had
318 -- not changed, so addVersionInfo returns the old ModIface
319 -- with the old GlobalRdrEnv (mi_globals).
320 ; let final_iface = new_iface{ mi_globals = Just rdr_env }
322 ; return (final_iface, no_change_at_all) }
324 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
325 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
326 i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
328 le_occ :: Name -> Name -> Bool
329 -- Compare lexicographically by OccName, *not* by unique, because
330 -- the latter is not stable across compilations
331 le_occ n1 n2 = nameOccName n1 <= nameOccName n2
333 dflags = hsc_dflags hsc_env
334 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
335 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
337 flattenVectInfo (VectInfo { vectInfoVar = vVar
338 , vectInfoTyCon = vTyCon
341 ifaceVectInfoVar = [ Var.varName v
342 | (v, _) <- varEnvElts vVar],
343 ifaceVectInfoTyCon = [ tyConName t
344 | (t, t_v) <- nameEnvElts vTyCon
346 ifaceVectInfoTyConReuse = [ tyConName t
347 | (t, t_v) <- nameEnvElts vTyCon
351 -----------------------------
352 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
353 writeIfaceFile dflags location new_iface
354 = do createDirectoryHierarchy (takeDirectory hi_file_path)
355 writeBinIface dflags hi_file_path new_iface
356 where hi_file_path = ml_hi_file location
359 -- -----------------------------------------------------------------------------
360 -- Look up parents and versions of Names
362 -- This is like a global version of the mi_hash_fn field in each ModIface.
363 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
364 -- the parent and version info.
367 :: HscEnv -- needed to look up versions
368 -> ExternalPackageState -- ditto
369 -> (Name -> Fingerprint)
370 mkHashFun hsc_env eps
373 mod = nameModule name
374 occ = nameOccName name
375 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
376 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
378 snd (mi_hash_fn iface occ `orElse`
379 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
381 hpt = hsc_HPT hsc_env
384 -- ---------------------------------------------------------------------------
385 -- Compute fingerprints for the interface
389 -> Maybe Fingerprint -- the old fingerprint, if any
390 -> ModIface -- The new interface (lacking decls)
391 -> [IfaceDecl] -- The new decls
392 -> IO (ModIface, -- Updated interface
393 Bool) -- True <=> no changes at all;
394 -- no need to write Iface
396 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
398 eps <- hscEPS hsc_env
400 -- the ABI of a declaration represents everything that is made
401 -- visible about the declaration that a client can depend on.
402 -- see IfaceDeclABI below.
403 declABI :: IfaceDecl -> IfaceDeclABI
404 declABI decl = (this_mod, decl, extras)
405 where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
407 edges :: [(IfaceDeclABI, Unique, [Unique])]
408 edges = [ (abi, getUnique (ifName decl), out)
410 , let abi = declABI decl
411 , let out = localOccs $ freeNamesDeclABI abi
414 localOccs = map (getUnique . getParent . getOccName)
415 . filter ((== this_mod) . nameModule)
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 = let hash | nameModule name /= this_mod = global_hash_fn name
447 snd (lookupOccEnv local_env (getOccName name)
448 `orElse` pprPanic "urk! lookup local fingerprint"
449 (ppr name)) -- (undefined,fingerprint0))
450 -- This panic indicates that we got the dependency
451 -- analysis wrong, because we needed a fingerprint for
452 -- an entity that wasn't in the environment. To debug
453 -- it, turn the panic into a trace, uncomment the
454 -- pprTraces below, run the compile again, and inspect
455 -- the output and the generated .hi file with
460 -- take a strongly-connected group of declarations and compute
463 fingerprint_group :: (OccEnv (OccName,Fingerprint),
464 [(Fingerprint,IfaceDecl)])
466 -> IO (OccEnv (OccName,Fingerprint),
467 [(Fingerprint,IfaceDecl)])
469 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
470 = do let hash_fn = mk_put_name local_env
472 -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
473 hash <- computeFingerprint dflags hash_fn abi
474 return (extend_hash_env (hash,decl) local_env,
475 (hash,decl) : decls_w_hashes)
477 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
478 = do let decls = map abiDecl abis
479 local_env' = foldr extend_hash_env local_env
480 (zip (repeat fingerprint0) decls)
481 hash_fn = mk_put_name local_env'
482 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
483 let stable_abis = sortBy cmp_abiNames abis
484 -- put the cycle in a canonical order
485 hash <- computeFingerprint dflags hash_fn stable_abis
486 let pairs = zip (repeat hash) decls
487 return (foldr extend_hash_env local_env pairs,
488 pairs ++ decls_w_hashes)
490 extend_hash_env :: (Fingerprint,IfaceDecl)
491 -> OccEnv (OccName,Fingerprint)
492 -> OccEnv (OccName,Fingerprint)
493 extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
496 item = (decl_name, hash)
497 env1 = extendOccEnv env0 decl_name item
498 add_imp bndr env = extendOccEnv env bndr item
501 (local_env, decls_w_hashes) <-
502 foldM fingerprint_group (emptyOccEnv, []) groups
504 -- when calculating fingerprints, we always need to use canonical
505 -- ordering for lists of things. In particular, the mi_deps has various
506 -- lists of modules and suchlike, so put these all in canonical order:
507 let sorted_deps = sortDependencies (mi_deps iface0)
509 -- the export hash of a module depends on the orphan hashes of the
510 -- orphan modules below us in the dependeny tree. This is the way
511 -- that changes in orphans get propagated all the way up the
512 -- dependency tree. We only care about orphan modules in the current
513 -- package, because changes to orphans outside this package will be
514 -- tracked by the usage on the ABI hash of package modules that we import.
515 let orph_mods = filter ((== this_pkg) . modulePackageId)
516 $ dep_orphs sorted_deps
517 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
519 orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
520 (map IfaceInstABI orph_insts, orph_rules, fam_insts)
522 -- the export list hash doesn't depend on the fingerprints of
523 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
524 export_hash <- computeFingerprint dflags putNameLiterally
525 (mi_exports iface0, orphan_hash, dep_orphan_hashes)
527 -- put the declarations in a canonical order, sorted by OccName
528 let sorted_decls = eltsFM $ listToFM $
529 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
531 -- the ABI hash depends on:
537 mod_hash <- computeFingerprint dflags putNameLiterally
538 (map fst sorted_decls,
543 -- The interface hash depends on:
544 -- - the ABI hash, plus
548 iface_hash <- computeFingerprint dflags putNameLiterally
555 no_change_at_all = Just iface_hash == mb_old_fingerprint
557 final_iface = iface0 {
558 mi_mod_hash = mod_hash,
559 mi_iface_hash = iface_hash,
560 mi_exp_hash = export_hash,
561 mi_orphan_hash = orphan_hash,
562 mi_orphan = not (null orph_rules && null orph_insts),
563 mi_finsts = not . null $ mi_fam_insts iface0,
564 mi_decls = sorted_decls,
565 mi_hash_fn = lookupOccEnv local_env }
567 return (final_iface, no_change_at_all)
570 this_mod = mi_module iface0
571 dflags = hsc_dflags hsc_env
572 this_pkg = thisPackage dflags
573 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
574 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
575 -- ToDo: shouldn't we be splitting fam_insts into orphans and
577 fam_insts = mi_fam_insts iface0
578 fix_fn = mi_fix_fn iface0
581 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
582 getOrphanHashes hsc_env mods = do
583 eps <- hscEPS hsc_env
585 hpt = hsc_HPT hsc_env
587 dflags = hsc_dflags hsc_env
589 case lookupIfaceByModule dflags hpt pit mod of
590 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
591 Just iface -> mi_orphan_hash iface
593 return (map get_orph_hash mods)
596 sortDependencies :: Dependencies -> Dependencies
598 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
599 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
600 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
601 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
603 -- The ABI of a declaration consists of:
604 -- the full name of the identifier (inc. module and package, because
605 -- these are used to construct the symbol name by which the
606 -- identifier is known externally).
607 -- the fixity of the identifier
608 -- the declaration itself, as exposed to clients. That is, the
609 -- definition of an Id is included in the fingerprint only if
610 -- it is made available as as unfolding in the interface.
612 -- for classes: instances, fixity & rules for methods
613 -- for datatypes: instances, fixity & rules for constrs
614 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
616 abiDecl :: IfaceDeclABI -> IfaceDecl
617 abiDecl (_, decl, _) = decl
619 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
620 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
621 ifName (abiDecl abi2)
623 freeNamesDeclABI :: IfaceDeclABI -> NameSet
624 freeNamesDeclABI (_mod, decl, extras) =
625 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
628 = IfaceIdExtras Fixity [IfaceRule]
629 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
630 | IfaceClassExtras [IfaceInstABI] [(Fixity,[IfaceRule])]
631 | IfaceOtherDeclExtras
633 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
634 freeNamesDeclExtras (IfaceIdExtras _ rules)
635 = unionManyNameSets (map freeNamesIfRule rules)
636 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
637 = unionManyNameSets (map freeNamesSub subs)
638 freeNamesDeclExtras (IfaceClassExtras _insts subs)
639 = unionManyNameSets (map freeNamesSub subs)
640 freeNamesDeclExtras IfaceOtherDeclExtras
643 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
644 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
646 instance Binary IfaceDeclExtras where
647 get _bh = panic "no get for IfaceDeclExtras"
648 put_ bh (IfaceIdExtras fix rules) = do
649 putByte bh 1; put_ bh fix; put_ bh rules
650 put_ bh (IfaceDataExtras fix insts cons) = do
651 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
652 put_ bh (IfaceClassExtras insts methods) = do
653 putByte bh 3; put_ bh insts; put_ bh methods
654 put_ bh IfaceOtherDeclExtras = do
657 declExtras :: (OccName -> Fixity)
658 -> OccEnv [IfaceRule]
659 -> OccEnv [IfaceInst]
663 declExtras fix_fn rule_env inst_env decl
665 IfaceId{} -> IfaceIdExtras (fix_fn n)
666 (lookupOccEnvL rule_env n)
667 IfaceData{ifCons=cons} ->
668 IfaceDataExtras (fix_fn n)
669 (map IfaceInstABI $ lookupOccEnvL inst_env n)
670 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
671 IfaceClass{ifSigs=sigs} ->
673 (map IfaceInstABI $ lookupOccEnvL inst_env n)
674 [id_extras op | IfaceClassOp op _ _ <- sigs]
675 _other -> IfaceOtherDeclExtras
678 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
681 -- When hashing an instance, we hash only its structure, not the
682 -- fingerprints of the things it mentions. See the section on instances
683 -- in the commentary,
684 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
686 newtype IfaceInstABI = IfaceInstABI IfaceInst
688 instance Binary IfaceInstABI where
689 get = panic "no get for IfaceInstABI"
690 put_ bh (IfaceInstABI inst) = do
691 let ud = getUserData bh
692 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
695 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
696 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
698 -- used when we want to fingerprint a structure without depending on the
699 -- fingerprints of external Names that it refers to.
700 putNameLiterally :: BinHandle -> Name -> IO ()
701 putNameLiterally bh name = do
702 put_ bh $! nameModule name
703 put_ bh $! nameOccName name
705 computeFingerprint :: Binary a
707 -> (BinHandle -> Name -> IO ())
711 computeFingerprint _dflags put_name a = do
712 bh <- openBinMem (3*1024) -- just less than a block
713 ud <- newWriteState put_name putFS
714 bh <- return $ setUserData bh ud
719 -- for testing: use the md5sum command to generate fingerprints and
720 -- compare the results against our built-in version.
721 fp' <- oldMD5 dflags bh
722 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
725 oldMD5 dflags bh = do
726 tmp <- newTempName dflags "bin"
728 tmp2 <- newTempName dflags "md5"
729 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
732 ExitFailure _ -> ghcError (PhaseFailed cmd r)
734 hash_str <- readFile tmp2
735 return $! readHexFingerprint hash_str
738 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
739 instOrphWarn unqual inst
740 = mkWarnMsg (getSrcSpan inst) unqual $
741 hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
743 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
744 ruleOrphWarn unqual mod rule
745 = mkWarnMsg silly_loc unqual $
746 ptext (sLit "Orphan rule:") <+> ppr rule
748 silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 0)
749 -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
750 -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
752 ----------------------
753 -- mkOrphMap partitions instance decls or rules into
754 -- (a) an OccEnv for ones that are not orphans,
755 -- mapping the local OccName to a list of its decls
756 -- (b) a list of orphan decls
757 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
758 -- Nothing for an orphan decl
759 -> [decl] -- Sorted into canonical order
760 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
761 -- each sublist in canonical order
762 [decl]) -- Orphan decls; in canonical order
763 mkOrphMap get_key decls
764 = foldl go (emptyOccEnv, []) decls
766 go (non_orphs, orphs) d
767 | Just occ <- get_key d
768 = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
769 | otherwise = (non_orphs, d:orphs)
773 %*********************************************************
775 \subsection{Keeping track of what we've slurped, and fingerprints}
777 %*********************************************************
781 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
782 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
783 = do { eps <- hscEPS hsc_env
784 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
785 dir_imp_mods used_names
786 ; usages `seqList` return usages }
787 -- seq the list of Usages returned: occasionally these
788 -- don't get evaluated for a while and we can end up hanging on to
789 -- the entire collection of Ifaces.
791 mk_usage_info :: PackageIfaceTable
797 mk_usage_info pit hsc_env this_mod direct_imports used_names
798 = mapCatMaybes mkUsage usage_mods
800 hpt = hsc_HPT hsc_env
801 dflags = hsc_dflags hsc_env
802 this_pkg = thisPackage dflags
804 used_mods = moduleEnvKeys ent_map
805 dir_imp_mods = (moduleEnvKeys direct_imports)
806 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
807 usage_mods = sortBy stableModuleCmp all_mods
808 -- canonical order is imported, to avoid interface-file
811 -- ent_map groups together all the things imported and used
812 -- from a particular module
813 ent_map :: ModuleEnv [OccName]
814 ent_map = foldNameSet add_mv emptyModuleEnv used_names
817 | isWiredInName name = mv_map -- ignore wired-in names
819 = case nameModule_maybe name of
820 Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
821 Just mod -> extendModuleEnv_C (++) mv_map mod [occ]
822 where occ = nameOccName name
824 -- We want to create a Usage for a home module if
825 -- a) we used something from it; has something in used_names
826 -- b) we imported it, even if we used nothing from it
827 -- (need to recompile if its export list changes: export_fprint)
828 mkUsage :: Module -> Maybe Usage
830 | isNothing maybe_iface -- We can't depend on it if we didn't
831 -- load its interface.
832 || mod == this_mod -- We don't care about usages of
833 -- things in *this* module
836 | modulePackageId mod /= this_pkg
837 = Just UsagePackageModule{ usg_mod = mod,
838 usg_mod_hash = mod_hash }
839 -- for package modules, we record the module hash only
842 && isNothing export_hash
843 && not is_direct_import
845 = Nothing -- Record no usage info
846 -- for directly-imported modules, we always want to record a usage
847 -- on the orphan hash. This is what triggers a recompilation if
848 -- an orphan is added or removed somewhere below us in the future.
851 = Just UsageHomeModule {
852 usg_mod_name = moduleName mod,
853 usg_mod_hash = mod_hash,
854 usg_exports = export_hash,
855 usg_entities = fmToList ent_hashs }
857 maybe_iface = lookupIfaceByModule dflags hpt pit mod
858 -- In one-shot mode, the interfaces for home-package
859 -- modules accumulate in the PIT not HPT. Sigh.
861 is_direct_import = mod `elemModuleEnv` direct_imports
863 Just iface = maybe_iface
864 finsts_mod = mi_finsts iface
865 hash_env = mi_hash_fn iface
866 mod_hash = mi_mod_hash iface
867 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
868 | otherwise = Nothing
870 used_occs = lookupModuleEnv ent_map mod `orElse` []
872 -- Making a FiniteMap here ensures that (a) we remove duplicates
873 -- when we have usages on several subordinates of a single parent,
874 -- and (b) that the usages emerge in a canonical order, which
875 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
876 -- using Ord on the OccNames, which is a lexicographic ordering.
877 ent_hashs :: FiniteMap OccName Fingerprint
878 ent_hashs = listToFM (map lookup_occ used_occs)
882 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
885 depend_on_exports mod =
886 case lookupModuleEnv direct_imports mod of
888 -- Even if we used 'import M ()', we have to register a
889 -- usage on the export list because we are sensitive to
890 -- changes in orphan instances/rules.
892 -- In GHC 6.8.x the above line read "True", and in
893 -- fact it recorded a dependency on *all* the
894 -- modules underneath in the dependency tree. This
895 -- happens to make orphans work right, but is too
896 -- expensive: it'll read too many interface files.
897 -- The 'isNothing maybe_iface' check above saved us
898 -- from generating many of these usages (at least in
899 -- one-shot mode), but that's even more bogus!
903 mkIfaceExports :: [AvailInfo]
904 -> [(Module, [GenAvailInfo OccName])]
905 -- Group by module and sort by occurrence
906 -- This keeps the list in canonical order
907 mkIfaceExports exports
908 = [ (mod, eltsFM avails)
909 | (mod, avails) <- fmToList groupFM
912 -- Group by the module where the exported entities are defined
913 -- (which may not be the same for all Names in an Avail)
914 -- Deliberately use FiniteMap rather than UniqFM so we
915 -- get a canonical ordering
916 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
917 groupFM = foldl add emptyModuleEnv exports
919 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
920 -> Module -> GenAvailInfo OccName
921 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
922 add_one env mod avail
923 = extendModuleEnv_C plusFM env mod
924 (unitFM (occNameFS (availName avail)) avail)
926 -- NB: we should not get T(X) and T(Y) in the export list
927 -- else the plusFM will simply discard one! They
928 -- should have been combined by now.
930 = add_one env (nameModule n) (Avail (nameOccName n))
932 add env (AvailTC tc ns)
933 = foldl add_for_mod env mods
935 tc_occ = nameOccName tc
936 mods = nub (map nameModule ns)
937 -- Usually just one, but see Note [Original module]
940 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
941 -- NB. sort the children, we need a canonical order
943 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
946 Note [Orignal module]
947 ~~~~~~~~~~~~~~~~~~~~~
949 module X where { data family T }
950 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
951 The exported Avail from Y will look like
954 - only MkT is brought into scope by the data instance;
955 - but the parent (used for grouping and naming in T(..) exports) is X.T
956 - and in this case we export X.T too
958 In the result of MkIfaceExports, the names are grouped by defining module,
959 so we may need to split up a single Avail into multiple ones.
962 %************************************************************************
964 Load the old interface file for this module (unless
965 we have it aleady), and check whether it is up to date
968 %************************************************************************
971 checkOldIface :: HscEnv
973 -> Bool -- Source unchanged
974 -> Maybe ModIface -- Old interface from compilation manager, if any
975 -> IO (RecompileRequired, Maybe ModIface)
977 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
978 = do { showPass (hsc_dflags hsc_env)
979 ("Checking old interface for " ++
980 showSDoc (ppr (ms_mod mod_summary))) ;
982 ; initIfaceCheck hsc_env $
983 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
986 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
987 -> IfG (Bool, Maybe ModIface)
988 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
989 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
990 { when (not source_unchanged)
991 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
993 -- If the source has changed and we're in interactive mode, avoid reading
994 -- an interface; just return the one we might have been supplied with.
995 ; let dflags = hsc_dflags hsc_env
996 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
997 return (outOfDate, maybe_iface)
999 case maybe_iface of {
1000 Just old_iface -> do -- Use the one we already have
1001 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1002 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1003 ; return (recomp, Just old_iface) }
1007 -- Try and read the old interface for the current module
1008 -- from the .hi file left from the last time we compiled it
1009 { let iface_path = msHiFilePath mod_summary
1010 ; read_result <- readIface (ms_mod mod_summary) iface_path False
1011 ; case read_result of {
1012 Failed err -> do -- Old interface file not found, or garbled; give up
1013 { traceIf (text "FYI: cannot read old interface file:"
1015 ; return (outOfDate, Nothing) }
1017 ; Succeeded iface -> do
1019 -- We have got the old iface; check its versions
1020 { traceIf (text "Read the interface file" <+> text iface_path)
1021 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1022 ; return (recomp, Just iface)
1027 @recompileRequired@ is called from the HscMain. It checks whether
1028 a recompilation is required. It needs access to the persistent state,
1029 finder, etc, because it may have to load lots of interface files to
1030 check their versions.
1033 type RecompileRequired = Bool
1034 upToDate, outOfDate :: Bool
1035 upToDate = False -- Recompile not required
1036 outOfDate = True -- Recompile required
1038 checkVersions :: HscEnv
1039 -> Bool -- True <=> source unchanged
1041 -> ModIface -- Old interface
1042 -> IfG RecompileRequired
1043 checkVersions hsc_env source_unchanged mod_summary iface
1044 | not source_unchanged
1047 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1048 ppr (mi_module iface) <> colon)
1050 ; recomp <- checkDependencies hsc_env mod_summary iface
1051 ; if recomp then return outOfDate else do {
1053 -- Source code unchanged and no errors yet... carry on
1055 -- First put the dependent-module info, read from the old
1056 -- interface, into the envt, so that when we look for
1057 -- interfaces we look for the right one (.hi or .hi-boot)
1059 -- It's just temporary because either the usage check will succeed
1060 -- (in which case we are done with this module) or it'll fail (in which
1061 -- case we'll compile the module from scratch anyhow).
1063 -- We do this regardless of compilation mode, although in --make mode
1064 -- all the dependent modules should be in the HPT already, so it's
1066 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1068 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1069 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1072 -- This is a bit of a hack really
1073 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1074 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1077 -- If the direct imports of this module are resolved to targets that
1078 -- are not among the dependencies of the previous interface file,
1079 -- then we definitely need to recompile. This catches cases like
1080 -- - an exposed package has been upgraded
1081 -- - we are compiling with different package flags
1082 -- - a home module that was shadowing a package module has been removed
1083 -- - a new home module has been added that shadows a package module
1086 -- Returns True if recompilation is required.
1087 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1088 checkDependencies hsc_env summary iface
1089 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1091 prev_dep_mods = dep_mods (mi_deps iface)
1092 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1094 this_pkg = thisPackage (hsc_dflags hsc_env)
1096 orM = foldr f (return False)
1097 where f m rest = do b <- m; if b then return True else rest
1099 dep_missing (L _ mod) = do
1100 find_res <- liftIO $ findImportedModule hsc_env mod Nothing
1104 -> if moduleName mod `notElem` map fst prev_dep_mods
1105 then do traceHiDiffs $
1106 text "imported module " <> quotes (ppr mod) <>
1107 text " not among previous dependencies"
1112 -> if pkg `notElem` prev_dep_pkgs
1113 then do traceHiDiffs $
1114 text "imported module " <> quotes (ppr mod) <>
1115 text " is from package " <> quotes (ppr pkg) <>
1116 text ", which is not among previous dependencies"
1120 where pkg = modulePackageId mod
1121 _otherwise -> return outOfDate
1123 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1124 -> IfG RecompileRequired
1125 needInterface mod continue
1126 = do -- Load the imported interface if possible
1127 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1128 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1130 mb_iface <- loadInterface doc_str mod ImportBySystem
1131 -- Load the interface, but don't complain on failure;
1132 -- Instead, get an Either back which we can test
1135 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1137 -- Couldn't find or parse a module mentioned in the
1138 -- old interface file. Don't complain: it might
1139 -- just be that the current module doesn't need that
1140 -- import and it's been deleted
1141 Succeeded iface -> continue iface
1144 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1145 -- Given the usage information extracted from the old
1146 -- M.hi file for the module being compiled, figure out
1147 -- whether M needs to be recompiled.
1149 checkModUsage _this_pkg UsagePackageModule{
1151 usg_mod_hash = old_mod_hash }
1152 = needInterface mod $ \iface -> do
1153 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1154 -- We only track the ABI hash of package modules, rather than
1155 -- individual entity usages, so if the ABI hash changes we must
1156 -- recompile. This is safe but may entail more recompilation when
1157 -- a dependent package has changed.
1159 checkModUsage this_pkg UsageHomeModule{
1160 usg_mod_name = mod_name,
1161 usg_mod_hash = old_mod_hash,
1162 usg_exports = maybe_old_export_hash,
1163 usg_entities = old_decl_hash }
1165 let mod = mkModule this_pkg mod_name
1166 needInterface mod $ \iface -> do
1169 new_mod_hash = mi_mod_hash iface
1170 new_decl_hash = mi_hash_fn iface
1171 new_export_hash = mi_exp_hash iface
1174 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1175 if not recompile then return upToDate else do
1177 -- CHECK EXPORT LIST
1178 checkMaybeHash maybe_old_export_hash new_export_hash
1179 (ptext (sLit " Export list changed")) $ do
1181 -- CHECK ITEMS ONE BY ONE
1182 recompile <- checkList [ checkEntityUsage new_decl_hash u
1183 | u <- old_decl_hash]
1185 then return outOfDate -- This one failed, so just bail out now
1186 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1188 ------------------------
1189 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1190 checkModuleFingerprint old_mod_hash new_mod_hash
1191 | new_mod_hash == old_mod_hash
1192 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1195 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1196 old_mod_hash new_mod_hash
1198 ------------------------
1199 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1200 -> IfG RecompileRequired -> IfG RecompileRequired
1201 checkMaybeHash maybe_old_hash new_hash doc continue
1202 | Just hash <- maybe_old_hash, hash /= new_hash
1203 = out_of_date_hash doc hash new_hash
1207 ------------------------
1208 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1209 -> (OccName, Fingerprint)
1211 checkEntityUsage new_hash (name,old_hash)
1212 = case new_hash name of
1214 Nothing -> -- We used it before, but it ain't there now
1215 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1217 Just (_, new_hash) -- It's there, but is it up to date?
1218 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1220 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1223 up_to_date, out_of_date :: SDoc -> IfG Bool
1224 up_to_date msg = traceHiDiffs msg >> return upToDate
1225 out_of_date msg = traceHiDiffs msg >> return outOfDate
1227 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1228 out_of_date_hash msg old_hash new_hash
1229 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1231 ----------------------
1232 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1233 -- This helper is used in two places
1234 checkList [] = return upToDate
1235 checkList (check:checks) = do recompile <- check
1237 then return outOfDate
1238 else checkList checks
1241 %************************************************************************
1243 Converting things to their Iface equivalents
1245 %************************************************************************
1248 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1249 -- Assumption: the thing is already tidied, so that locally-bound names
1250 -- (lambdas, for-alls) already have non-clashing OccNames
1251 -- Reason: Iface stuff uses OccNames, and the conversion here does
1252 -- not do tidying on the way
1253 tyThingToIfaceDecl (AnId id)
1254 = IfaceId { ifName = getOccName id,
1255 ifType = toIfaceType (idType id),
1258 info = case toIfaceIdInfo (idInfo id) of
1260 items -> HasInfo items
1262 tyThingToIfaceDecl (AClass clas)
1263 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1264 ifName = getOccName clas,
1265 ifTyVars = toIfaceTvBndrs clas_tyvars,
1266 ifFDs = map toIfaceFD clas_fds,
1267 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1268 ifSigs = map toIfaceClassOp op_stuff,
1269 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1271 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1272 = classExtraBigSig clas
1273 tycon = classTyCon clas
1275 toIfaceClassOp (sel_id, def_meth)
1276 = ASSERT(sel_tyvars == clas_tyvars)
1277 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1279 -- Be careful when splitting the type, because of things
1280 -- like class Foo a where
1281 -- op :: (?x :: String) => a -> a
1282 -- and class Baz a where
1283 -- op :: (Ord a) => a -> a
1284 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1285 op_ty = funResultTy rho_ty
1287 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1289 tyThingToIfaceDecl (ATyCon tycon)
1291 = IfaceSyn { ifName = getOccName tycon,
1292 ifTyVars = toIfaceTvBndrs tyvars,
1295 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1299 = IfaceData { ifName = getOccName tycon,
1300 ifTyVars = toIfaceTvBndrs tyvars,
1301 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1302 ifCons = ifaceConDecls (algTyConRhs tycon),
1303 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1304 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1305 ifGeneric = tyConHasGenerics tycon,
1306 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1308 | isForeignTyCon tycon
1309 = IfaceForeign { ifName = getOccName tycon,
1310 ifExtName = tyConExtName tycon }
1312 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1314 tyvars = tyConTyVars tycon
1316 = case synTyConRhs tycon of
1317 OpenSynTyCon ki _ -> (Nothing, toIfaceType ki)
1318 SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1320 ifaceConDecls (NewTyCon { data_con = con }) =
1321 IfNewTyCon (ifaceConDecl con)
1322 ifaceConDecls (DataTyCon { data_cons = cons }) =
1323 IfDataTyCon (map ifaceConDecl cons)
1324 ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
1325 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1326 -- The last case happens when a TyCon has been trimmed during tidying
1327 -- Furthermore, tyThingToIfaceDecl is also used
1328 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1329 -- AbstractTyCon case is perfectly sensible.
1331 ifaceConDecl data_con
1332 = IfCon { ifConOcc = getOccName (dataConName data_con),
1333 ifConInfix = dataConIsInfix data_con,
1334 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1335 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1336 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1337 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1338 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1339 ifConFields = map getOccName
1340 (dataConFieldLabels data_con),
1341 ifConStricts = dataConStrictMarks data_con }
1343 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1345 famInstToIface Nothing = Nothing
1346 famInstToIface (Just (famTyCon, instTys)) =
1347 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1349 tyThingToIfaceDecl (ADataCon dc)
1350 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1353 getFS :: NamedThing a => a -> FastString
1354 getFS x = occNameFS (getOccName x)
1356 --------------------------
1357 instanceToIfaceInst :: Instance -> IfaceInst
1358 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1359 is_cls = cls_name, is_tcs = mb_tcs })
1360 = ASSERT( cls_name == className cls )
1361 IfaceInst { ifDFun = dfun_name,
1363 ifInstCls = cls_name,
1364 ifInstTys = map do_rough mb_tcs,
1367 do_rough Nothing = Nothing
1368 do_rough (Just n) = Just (toIfaceTyCon_name n)
1370 dfun_name = idName dfun_id
1371 mod = nameModule dfun_name
1372 is_local name = nameIsLocalOrFrom mod name
1374 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1375 (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1376 -- Slightly awkward: we need the Class to get the fundeps
1377 (tvs, fds) = classTvsFds cls
1378 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1379 orph | is_local cls_name = Just (nameOccName cls_name)
1380 | all isJust mb_ns = head mb_ns
1381 | otherwise = Nothing
1383 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1384 -- that is not in the "determined" arguments
1385 mb_ns | null fds = [choose_one arg_names]
1386 | otherwise = map do_one fds
1387 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1388 , not (tv `elem` rtvs)]
1390 choose_one :: [NameSet] -> Maybe OccName
1391 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1393 (n : _) -> Just (nameOccName n)
1395 --------------------------
1396 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1397 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1400 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1401 , ifFamInstFam = fam
1402 , ifFamInstTys = map do_rough mb_tcs }
1404 do_rough Nothing = Nothing
1405 do_rough (Just n) = Just (toIfaceTyCon_name n)
1407 --------------------------
1408 toIfaceLetBndr :: Id -> IfaceLetBndr
1409 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1410 (toIfaceType (idType id))
1413 -- Stripped-down version of tcIfaceIdInfo
1414 -- Change this if you want to export more IdInfo for
1415 -- non-top-level Ids. Don't forget to change
1416 -- CoreTidy.tidyLetBndr too!
1418 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1420 inline_prag = inlinePragInfo id_info
1421 prag_info | isAlwaysActive inline_prag = NoInfo
1422 | otherwise = HasInfo [HsInline inline_prag]
1424 --------------------------
1425 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1426 toIfaceIdInfo id_info
1427 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1428 inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
1430 ------------ Arity --------------
1431 arity_info = arityInfo id_info
1432 arity_hsinfo | arity_info == 0 = Nothing
1433 | otherwise = Just (HsArity arity_info)
1435 ------------ Caf Info --------------
1436 caf_info = cafInfo id_info
1437 caf_hsinfo = case caf_info of
1438 NoCafRefs -> Just HsNoCafRefs
1441 ------------ Strictness --------------
1442 -- No point in explicitly exporting TopSig
1443 strict_hsinfo = case newStrictnessInfo id_info of
1444 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1447 ------------ Worker --------------
1448 work_info = workerInfo id_info
1449 has_worker = workerExists work_info
1450 wrkr_hsinfo = case work_info of
1451 HasWorker work_id wrap_arity ->
1452 Just (HsWorker ((idName work_id)) wrap_arity)
1455 ------------ Unfolding --------------
1456 -- The unfolding is redundant if there is a worker
1457 unfold_info = unfoldingInfo id_info
1458 rhs = unfoldingTemplate unfold_info
1459 no_unfolding = neverUnfold unfold_info
1460 -- The CoreTidy phase retains unfolding info iff
1461 -- we want to expose the unfolding, taking into account
1462 -- unconditional NOINLINE, etc. See TidyPgm.addExternal
1463 unfold_hsinfo | no_unfolding = Nothing
1464 | has_worker = Nothing -- Unfolding is implicit
1465 | otherwise = Just (HsUnfold (toIfaceExpr rhs))
1467 ------------ Inline prag --------------
1468 inline_prag = inlinePragInfo id_info
1469 inline_hsinfo | isAlwaysActive inline_prag = Nothing
1470 | no_unfolding && not has_worker = Nothing
1471 -- If the iface file give no unfolding info, we
1472 -- don't need to say when inlining is OK!
1473 | otherwise = Just (HsInline inline_prag)
1475 --------------------------
1476 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1477 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1478 = pprTrace "toHsRule: builtin" (ppr fn) $
1481 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1482 ru_act = act, ru_bndrs = bndrs,
1483 ru_args = args, ru_rhs = rhs })
1484 = IfaceRule { ifRuleName = name, ifActivation = act,
1485 ifRuleBndrs = map toIfaceBndr bndrs,
1487 ifRuleArgs = map do_arg args,
1488 ifRuleRhs = toIfaceExpr rhs,
1491 -- For type args we must remove synonyms from the outermost
1492 -- level. Reason: so that when we read it back in we'll
1493 -- construct the same ru_rough field as we have right now;
1495 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1496 do_arg arg = toIfaceExpr arg
1498 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1499 -- A rule is an orphan only if none of the variables
1500 -- mentioned on its left-hand side are locally defined
1501 lhs_names = fn : nameSetToList (exprsFreeNames args)
1502 -- No need to delete bndrs, because
1503 -- exprsFreeNames finds only External names
1505 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1506 (n : _) -> Just (nameOccName n)
1509 bogusIfaceRule :: Name -> IfaceRule
1510 bogusIfaceRule id_name
1511 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1512 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1513 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1515 ---------------------
1516 toIfaceExpr :: CoreExpr -> IfaceExpr
1517 toIfaceExpr (Var v) = toIfaceVar v
1518 toIfaceExpr (Lit l) = IfaceLit l
1519 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1520 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1521 toIfaceExpr (App f a) = toIfaceApp f [a]
1522 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1523 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1524 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1525 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1527 ---------------------
1528 toIfaceNote :: Note -> IfaceNote
1529 toIfaceNote (SCC cc) = IfaceSCC cc
1530 toIfaceNote InlineMe = IfaceInlineMe
1531 toIfaceNote (CoreNote s) = IfaceCoreNote s
1533 ---------------------
1534 toIfaceBind :: Bind Id -> IfaceBinding
1535 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1536 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1538 ---------------------
1539 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1540 -> (IfaceConAlt, [FastString], IfaceExpr)
1541 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1543 ---------------------
1544 toIfaceCon :: AltCon -> IfaceConAlt
1545 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1546 | otherwise = IfaceDataAlt (getName dc)
1548 tc = dataConTyCon dc
1550 toIfaceCon (LitAlt l) = IfaceLitAlt l
1551 toIfaceCon DEFAULT = IfaceDefault
1553 ---------------------
1554 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1555 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1556 toIfaceApp (Var v) as
1557 = case isDataConWorkId_maybe v of
1558 -- We convert the *worker* for tuples into IfaceTuples
1559 Just dc | isTupleTyCon tc && saturated
1560 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1562 val_args = dropWhile isTypeArg as
1563 saturated = val_args `lengthIs` idArity v
1564 tup_args = map toIfaceExpr val_args
1565 tc = dataConTyCon dc
1567 _ -> mkIfaceApps (toIfaceVar v) as
1569 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1571 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1572 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1574 ---------------------
1575 toIfaceVar :: Id -> IfaceExpr
1577 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1578 -- Foreign calls have special syntax
1579 | isExternalName name = IfaceExt name
1580 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1582 | otherwise = IfaceLcl (getFS name)