2 % (c) The University of Glasgow 2006-2008
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
10 mkIface, -- Build a ModIface from a ModGuts,
11 -- including computing version information
15 writeIfaceFile, -- Write the interface file
17 checkOldIface, -- See if recompilation is required, by
18 -- comparing version information
20 tyThingToIfaceDecl -- Converting things to their Iface equivalents
24 -----------------------------------------------
25 Recompilation checking
26 -----------------------------------------------
28 A complete description of how recompilation checking works can be
29 found in the wiki commentary:
31 http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
33 Please read the above page for a top-down description of how this all
34 works. Notes below cover specific issues related to the implementation.
38 * In the mi_usages information in an interface, we record the
39 fingerprint of each free variable of the module
41 * In mkIface, we compute the fingerprint of each exported thing A.f.
42 For each external thing that A.f refers to, we include the fingerprint
43 of the external reference when computing the fingerprint of A.f. So
44 if anything that A.f depends on changes, then A.f's fingerprint will
47 * In checkOldIface we compare the mi_usages for the module with
48 the actual fingerprint for all each thing recorded in mi_usages
51 #include "HsVersions.h"
85 import BasicTypes hiding ( SuccessFlag(..) )
88 import Util hiding ( eqListBy )
100 import System.FilePath
105 %************************************************************************
107 \subsection{Completing an interface}
109 %************************************************************************
113 -> Maybe Fingerprint -- The old fingerprint, if we have it
114 -> ModDetails -- The trimmed, tidied interface
115 -> ModGuts -- Usages, deprecations, etc
116 -> IO (ModIface, -- The new one
117 Bool) -- True <=> there was an old Iface, and the
118 -- new one is identical, so no need
121 mkIface hsc_env maybe_old_fingerprint mod_details
122 ModGuts{ mg_module = this_mod,
124 mg_used_names = used_names,
126 mg_dir_imps = dir_imp_mods,
127 mg_rdr_env = rdr_env,
128 mg_fix_env = fix_env,
130 mg_hpc_info = hpc_info }
131 = mkIface_ hsc_env maybe_old_fingerprint
132 this_mod is_boot used_names deps rdr_env
133 fix_env warns hpc_info dir_imp_mods mod_details
135 -- | make an interface from the results of typechecking only. Useful
136 -- for non-optimising compilation, or where we aren't generating any
137 -- object code at all ('HscNothing').
139 -> Maybe Fingerprint -- The old fingerprint, if we have it
140 -> ModDetails -- gotten from mkBootModDetails, probably
141 -> TcGblEnv -- Usages, deprecations, etc
144 mkIfaceTc hsc_env maybe_old_fingerprint mod_details
145 tc_result@TcGblEnv{ tcg_mod = this_mod,
147 tcg_imports = imports,
148 tcg_rdr_env = rdr_env,
149 tcg_fix_env = fix_env,
151 tcg_hpc = other_hpc_info
154 used_names <- mkUsedNames tc_result
155 deps <- mkDependencies tc_result
156 let hpc_info = emptyHpcInfo other_hpc_info
157 mkIface_ hsc_env maybe_old_fingerprint
158 this_mod (isHsBoot hsc_src) used_names deps rdr_env
159 fix_env warns hpc_info (imp_mods imports) mod_details
162 mkUsedNames :: TcGblEnv -> IO NameSet
164 TcGblEnv{ tcg_inst_uses = dfun_uses_var,
168 dfun_uses <- readIORef dfun_uses_var -- What dfuns are used
169 return (allUses dus `unionNameSets` dfun_uses)
171 mkDependencies :: TcGblEnv -> IO Dependencies
173 TcGblEnv{ tcg_mod = mod,
174 tcg_imports = imports,
178 th_used <- readIORef th_var -- Whether TH is used
180 dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
181 -- M.hi-boot can be in the imp_dep_mods, but we must remove
182 -- it before recording the modules on which this one depends!
183 -- (We want to retain M.hi-boot in imp_dep_mods so that
184 -- loadHiBootInterface can see if M's direct imports depend
185 -- on M.hi-boot, and hence that we should do the hi-boot consistency
188 -- Modules don't compare lexicographically usually,
189 -- but we want them to do so here.
190 le_mod :: Module -> Module -> Bool
191 le_mod m1 m2 = moduleNameFS (moduleName m1)
192 <= moduleNameFS (moduleName m2)
194 le_dep_mod :: (ModuleName, IsBootInterface)
195 -> (ModuleName, IsBootInterface) -> Bool
196 le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
199 pkgs | th_used = insertList thPackageId (imp_dep_pkgs imports)
200 | otherwise = imp_dep_pkgs imports
202 return Deps { dep_mods = sortLe le_dep_mod dep_mods,
203 dep_pkgs = sortLe (<=) pkgs,
204 dep_orphs = sortLe le_mod (imp_orphs imports),
205 dep_finsts = sortLe le_mod (imp_finsts imports) }
206 -- sort to get into canonical order
209 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
210 -> NameSet -> Dependencies -> GlobalRdrEnv
211 -> NameEnv FixItem -> Warnings -> HpcInfo
214 -> IO (ModIface, Bool)
215 mkIface_ hsc_env maybe_old_fingerprint
216 this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
218 ModDetails{ md_insts = insts,
219 md_fam_insts = fam_insts,
221 md_vect_info = vect_info,
223 md_exports = exports }
224 -- NB: notice that mkIface does not look at the bindings
225 -- only at the TypeEnv. The previous Tidy phase has
226 -- put exactly the info into the TypeEnv that we want
227 -- to expose in the interface
229 = do { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
231 ; let { entities = typeEnvElts type_env ;
232 decls = [ tyThingToIfaceDecl entity
233 | entity <- entities,
234 let name = getName entity,
235 not (isImplicitTyThing entity),
236 -- No implicit Ids and class tycons in the interface file
237 not (isWiredInName name),
238 -- Nor wired-in things; the compiler knows about them anyhow
239 nameIsLocalOrFrom this_mod name ]
240 -- Sigh: see Note [Root-main Id] in TcRnDriver
242 ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
244 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
245 ; iface_insts = map instanceToIfaceInst insts
246 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
247 ; iface_vect_info = flattenVectInfo vect_info
249 ; intermediate_iface = ModIface {
250 mi_module = this_mod,
254 mi_exports = mkIfaceExports exports,
256 -- Sort these lexicographically, so that
257 -- the result is stable across compilations
258 mi_insts = sortLe le_inst iface_insts,
259 mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
260 mi_rules = sortLe le_rule iface_rules,
262 mi_vect_info = iface_vect_info,
264 mi_fixities = fixities,
266 mi_globals = Just rdr_env,
268 -- Left out deliberately: filled in by addVersionInfo
269 mi_iface_hash = fingerprint0,
270 mi_mod_hash = fingerprint0,
271 mi_exp_hash = fingerprint0,
272 mi_orphan_hash = fingerprint0,
273 mi_orphan = False, -- Always set by addVersionInfo, but
274 -- it's a strict field, so we can't omit it.
275 mi_finsts = False, -- Ditto
276 mi_decls = deliberatelyOmitted "decls",
277 mi_hash_fn = deliberatelyOmitted "hash_fn",
278 mi_hpc = isHpcUsed hpc_info,
280 -- And build the cached values
281 mi_warn_fn = mkIfaceWarnCache warns,
282 mi_fix_fn = mkIfaceFixCache fixities }
285 ; (new_iface, no_change_at_all, pp_orphs)
286 <- {-# SCC "versioninfo" #-}
287 addFingerprints hsc_env maybe_old_fingerprint
288 intermediate_iface decls
291 ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags)
292 (printDump (expectJust "mkIface" pp_orphs))
294 -- XXX ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
296 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
297 (pprModIface new_iface)
299 -- bug #1617: on reload we weren't updating the PrintUnqualified
300 -- correctly. This stems from the fact that the interface had
301 -- not changed, so addVersionInfo returns the old ModIface
302 -- with the old GlobalRdrEnv (mi_globals).
303 ; let final_iface = new_iface{ mi_globals = Just rdr_env }
305 ; return (final_iface, no_change_at_all) }
307 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
308 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
309 i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
311 le_occ :: Name -> Name -> Bool
312 -- Compare lexicographically by OccName, *not* by unique, because
313 -- the latter is not stable across compilations
314 le_occ n1 n2 = nameOccName n1 <= nameOccName n2
316 dflags = hsc_dflags hsc_env
317 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
318 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
320 flattenVectInfo (VectInfo { vectInfoVar = vVar
321 , vectInfoTyCon = vTyCon
324 ifaceVectInfoVar = [ Var.varName v
325 | (v, _) <- varEnvElts vVar],
326 ifaceVectInfoTyCon = [ tyConName t
327 | (t, t_v) <- nameEnvElts vTyCon
329 ifaceVectInfoTyConReuse = [ tyConName t
330 | (t, t_v) <- nameEnvElts vTyCon
334 -----------------------------
335 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
336 writeIfaceFile dflags location new_iface
337 = do createDirectoryHierarchy (takeDirectory hi_file_path)
338 writeBinIface dflags hi_file_path new_iface
339 where hi_file_path = ml_hi_file location
342 -- -----------------------------------------------------------------------------
343 -- Look up parents and versions of Names
345 -- This is like a global version of the mi_hash_fn field in each ModIface.
346 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
347 -- the parent and version info.
350 :: HscEnv -- needed to look up versions
351 -> ExternalPackageState -- ditto
352 -> (Name -> Fingerprint)
353 mkHashFun hsc_env eps
356 mod = nameModule name
357 occ = nameOccName name
358 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
359 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
361 snd (mi_hash_fn iface occ `orElse`
362 pprPanic "lookupVers1" (ppr mod <+> ppr occ))
364 hpt = hsc_HPT hsc_env
367 -- ---------------------------------------------------------------------------
368 -- Compute fingerprints for the interface
372 -> Maybe Fingerprint -- the old fingerprint, if any
373 -> ModIface -- The new interface (lacking decls)
374 -> [IfaceDecl] -- The new decls
375 -> IO (ModIface, -- Updated interface
376 Bool, -- True <=> no changes at all;
377 -- no need to write Iface
378 Maybe SDoc) -- Warnings about orphans
380 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
382 eps <- hscEPS hsc_env
384 -- the ABI of a declaration represents everything that is made
385 -- visible about the declaration that a client can depend on.
386 -- see IfaceDeclABI below.
387 declABI :: IfaceDecl -> IfaceDeclABI
388 declABI decl = (this_mod, decl, extras)
389 where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
391 edges :: [(IfaceDeclABI, Unique, [Unique])]
392 edges = [ (abi, getUnique (ifName decl), out)
394 , let abi = declABI decl
395 , let out = localOccs $ freeNamesDeclABI abi
398 localOccs = map (getUnique . getParent . getOccName)
399 . filter ((== this_mod) . nameModule)
401 where getParent occ = lookupOccEnv parent_map occ `orElse` occ
403 -- maps OccNames to their parents in the current module.
404 -- e.g. a reference to a constructor must be turned into a reference
405 -- to the TyCon for the purposes of calculating dependencies.
406 parent_map :: OccEnv OccName
407 parent_map = foldr extend emptyOccEnv new_decls
409 extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
412 -- strongly-connected groups of declarations, in dependency order
413 groups = stronglyConnComp edges
415 global_hash_fn = mkHashFun hsc_env eps
417 -- how to output Names when generating the data to fingerprint.
418 -- Here we want to output the fingerprint for each top-level
419 -- Name, whether it comes from the current module or another
420 -- module. In this way, the fingerprint for a declaration will
421 -- change if the fingerprint for anything it refers to (transitively)
423 mk_put_name :: (OccEnv (OccName,Fingerprint))
424 -> BinHandle -> Name -> IO ()
425 mk_put_name local_env bh name
426 | isWiredInName name = putNameLiterally bh name
427 -- wired-in names don't have fingerprints
429 = let hash | nameModule name /= this_mod = global_hash_fn name
431 snd (lookupOccEnv local_env (getOccName name)
432 `orElse` pprPanic "urk! lookup local fingerprint"
433 (ppr name)) -- (undefined,fingerprint0))
434 -- This panic indicates that we got the dependency
435 -- analysis wrong, because we needed a fingerprint for
436 -- an entity that wasn't in the environment. To debug
437 -- it, turn the panic into a trace, uncomment the
438 -- pprTraces below, run the compile again, and inspect
439 -- the output and the generated .hi file with
444 -- take a strongly-connected group of declarations and compute
447 fingerprint_group :: (OccEnv (OccName,Fingerprint),
448 [(Fingerprint,IfaceDecl)])
450 -> IO (OccEnv (OccName,Fingerprint),
451 [(Fingerprint,IfaceDecl)])
453 fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
454 = do let hash_fn = mk_put_name local_env
456 -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
457 hash <- computeFingerprint dflags hash_fn abi
458 return (extend_hash_env (hash,decl) local_env,
459 (hash,decl) : decls_w_hashes)
461 fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
462 = do let decls = map abiDecl abis
463 local_env' = foldr extend_hash_env local_env
464 (zip (repeat fingerprint0) decls)
465 hash_fn = mk_put_name local_env'
466 -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
467 let stable_abis = sortBy cmp_abiNames abis
468 -- put the cycle in a canonical order
469 hash <- computeFingerprint dflags hash_fn stable_abis
470 let pairs = zip (repeat hash) decls
471 return (foldr extend_hash_env local_env pairs,
472 pairs ++ decls_w_hashes)
474 extend_hash_env :: (Fingerprint,IfaceDecl)
475 -> OccEnv (OccName,Fingerprint)
476 -> OccEnv (OccName,Fingerprint)
477 extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
480 item = (decl_name, hash)
481 env1 = extendOccEnv env0 decl_name item
482 add_imp bndr env = extendOccEnv env bndr item
485 (local_env, decls_w_hashes) <-
486 foldM fingerprint_group (emptyOccEnv, []) groups
488 -- when calculating fingerprints, we always need to use canonical
489 -- ordering for lists of things. In particular, the mi_deps has various
490 -- lists of modules and suchlike, so put these all in canonical order:
491 let sorted_deps = sortDependencies (mi_deps iface0)
493 -- the export hash of a module depends on the orphan hashes of the
494 -- orphan modules below us in the dependeny tree. This is the way
495 -- that changes in orphans get propagated all the way up the
496 -- dependency tree. We only care about orphan modules in the current
497 -- package, because changes to orphans outside this package will be
498 -- tracked by the usage on the ABI hash of package modules that we import.
499 let orph_mods = filter ((== this_pkg) . modulePackageId)
500 $ dep_orphs sorted_deps
501 dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
503 orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
504 (map IfaceInstABI orph_insts, orph_rules, fam_insts)
506 -- the export list hash doesn't depend on the fingerprints of
507 -- the Names it mentions, only the Names themselves, hence putNameLiterally.
508 export_hash <- computeFingerprint dflags putNameLiterally
509 (mi_exports iface0, orphan_hash, dep_orphan_hashes)
511 -- put the declarations in a canonical order, sorted by OccName
512 let sorted_decls = eltsFM $ listToFM $
513 [(ifName d, e) | e@(_, d) <- decls_w_hashes]
515 -- the ABI hash depends on:
521 mod_hash <- computeFingerprint dflags putNameLiterally
522 (map fst sorted_decls,
527 -- The interface hash depends on:
528 -- - the ABI hash, plus
532 iface_hash <- computeFingerprint dflags putNameLiterally
539 no_change_at_all = Just iface_hash == mb_old_fingerprint
541 final_iface = iface0 {
542 mi_mod_hash = mod_hash,
543 mi_iface_hash = iface_hash,
544 mi_exp_hash = export_hash,
545 mi_orphan_hash = orphan_hash,
546 mi_orphan = not (null orph_rules && null orph_insts),
547 mi_finsts = not . null $ mi_fam_insts iface0,
548 mi_decls = sorted_decls,
549 mi_hash_fn = lookupOccEnv local_env }
551 return (final_iface, no_change_at_all, pp_orphs)
554 this_mod = mi_module iface0
555 dflags = hsc_dflags hsc_env
556 this_pkg = thisPackage dflags
557 (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
558 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
559 -- ToDo: shouldn't we be splitting fam_insts into orphans and
561 fam_insts = mi_fam_insts iface0
562 fix_fn = mi_fix_fn iface0
563 pp_orphs = pprOrphans orph_insts orph_rules
566 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
567 getOrphanHashes hsc_env mods = do
568 eps <- hscEPS hsc_env
570 hpt = hsc_HPT hsc_env
572 dflags = hsc_dflags hsc_env
574 case lookupIfaceByModule dflags hpt pit mod of
575 Nothing -> pprPanic "moduleOrphanHash" (ppr mod)
576 Just iface -> mi_orphan_hash iface
578 return (map get_orph_hash mods)
581 sortDependencies :: Dependencies -> Dependencies
583 = Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
584 dep_pkgs = sortBy (compare `on` packageIdFS) (dep_pkgs d),
585 dep_orphs = sortBy stableModuleCmp (dep_orphs d),
586 dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
588 -- The ABI of a declaration consists of:
589 -- the full name of the identifier (inc. module and package, because
590 -- these are used to construct the symbol name by which the
591 -- identifier is known externally).
592 -- the fixity of the identifier
593 -- the declaration itself, as exposed to clients. That is, the
594 -- definition of an Id is included in the fingerprint only if
595 -- it is made available as as unfolding in the interface.
597 -- for classes: instances, fixity & rules for methods
598 -- for datatypes: instances, fixity & rules for constrs
599 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
601 abiDecl :: IfaceDeclABI -> IfaceDecl
602 abiDecl (_, decl, _) = decl
604 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
605 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
606 ifName (abiDecl abi2)
608 freeNamesDeclABI :: IfaceDeclABI -> NameSet
609 freeNamesDeclABI (_mod, decl, extras) =
610 freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
613 = IfaceIdExtras Fixity [IfaceRule]
614 | IfaceDataExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
615 | IfaceClassExtras [IfaceInstABI] [(Fixity,[IfaceRule])]
616 | IfaceOtherDeclExtras
618 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
619 freeNamesDeclExtras (IfaceIdExtras _ rules)
620 = unionManyNameSets (map freeNamesIfRule rules)
621 freeNamesDeclExtras (IfaceDataExtras _ _insts subs)
622 = unionManyNameSets (map freeNamesSub subs)
623 freeNamesDeclExtras (IfaceClassExtras _insts subs)
624 = unionManyNameSets (map freeNamesSub subs)
625 freeNamesDeclExtras IfaceOtherDeclExtras
628 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
629 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
631 instance Binary IfaceDeclExtras where
632 get _bh = panic "no get for IfaceDeclExtras"
633 put_ bh (IfaceIdExtras fix rules) = do
634 putByte bh 1; put_ bh fix; put_ bh rules
635 put_ bh (IfaceDataExtras fix insts cons) = do
636 putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
637 put_ bh (IfaceClassExtras insts methods) = do
638 putByte bh 3; put_ bh insts; put_ bh methods
639 put_ bh IfaceOtherDeclExtras = do
642 declExtras :: (OccName -> Fixity)
643 -> OccEnv [IfaceRule]
644 -> OccEnv [IfaceInst]
648 declExtras fix_fn rule_env inst_env decl
650 IfaceId{} -> IfaceIdExtras (fix_fn n)
651 (lookupOccEnvL rule_env n)
652 IfaceData{ifCons=cons} ->
653 IfaceDataExtras (fix_fn n)
654 (map IfaceInstABI $ lookupOccEnvL inst_env n)
655 (map (id_extras . ifConOcc) (visibleIfConDecls cons))
656 IfaceClass{ifSigs=sigs} ->
658 (map IfaceInstABI $ lookupOccEnvL inst_env n)
659 [id_extras op | IfaceClassOp op _ _ <- sigs]
660 _other -> IfaceOtherDeclExtras
663 id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
666 -- When hashing an instance, we hash only its structure, not the
667 -- fingerprints of the things it mentions. See the section on instances
668 -- in the commentary,
669 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
671 newtype IfaceInstABI = IfaceInstABI IfaceInst
673 instance Binary IfaceInstABI where
674 get = panic "no get for IfaceInstABI"
675 put_ bh (IfaceInstABI inst) = do
676 let ud = getUserData bh
677 bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
680 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
681 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
683 -- used when we want to fingerprint a structure without depending on the
684 -- fingerprints of external Names that it refers to.
685 putNameLiterally :: BinHandle -> Name -> IO ()
686 putNameLiterally bh name = do
687 put_ bh $! nameModule name
688 put_ bh $! nameOccName name
690 computeFingerprint :: Binary a
692 -> (BinHandle -> Name -> IO ())
696 computeFingerprint _dflags put_name a = do
697 bh <- openBinMem (3*1024) -- just less than a block
698 ud <- newWriteState put_name putFS
699 bh <- return $ setUserData bh ud
704 -- for testing: use the md5sum command to generate fingerprints and
705 -- compare the results against our built-in version.
706 fp' <- oldMD5 dflags bh
707 if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
710 oldMD5 dflags bh = do
711 tmp <- newTempName dflags "bin"
713 tmp2 <- newTempName dflags "md5"
714 let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
717 ExitFailure _ -> ghcError (PhaseFailed cmd r)
719 hash_str <- readFile tmp2
720 return $! readHexFingerprint hash_str
723 pprOrphans :: [IfaceInst] -> [IfaceRule] -> Maybe SDoc
724 pprOrphans insts rules
725 | null insts && null rules = Nothing
728 if null insts then empty else
729 hang (ptext (sLit "Warning: orphan instances:"))
730 2 (vcat (map ppr insts)),
731 if null rules then empty else
732 hang (ptext (sLit "Warning: orphan rules:"))
733 2 (vcat (map ppr rules))
736 ----------------------
737 -- mkOrphMap partitions instance decls or rules into
738 -- (a) an OccEnv for ones that are not orphans,
739 -- mapping the local OccName to a list of its decls
740 -- (b) a list of orphan decls
741 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
742 -- Nothing for an orphan decl
743 -> [decl] -- Sorted into canonical order
744 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
745 -- each sublist in canonical order
746 [decl]) -- Orphan decls; in canonical order
747 mkOrphMap get_key decls
748 = foldl go (emptyOccEnv, []) decls
750 go (non_orphs, orphs) d
751 | Just occ <- get_key d
752 = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
753 | otherwise = (non_orphs, d:orphs)
757 %*********************************************************
759 \subsection{Keeping track of what we've slurped, and fingerprints}
761 %*********************************************************
765 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
766 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
767 = do { eps <- hscEPS hsc_env
768 ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
769 dir_imp_mods used_names
770 ; usages `seqList` return usages }
771 -- seq the list of Usages returned: occasionally these
772 -- don't get evaluated for a while and we can end up hanging on to
773 -- the entire collection of Ifaces.
775 mk_usage_info :: PackageIfaceTable
781 mk_usage_info pit hsc_env this_mod direct_imports used_names
782 = mapCatMaybes mkUsage usage_mods
784 hpt = hsc_HPT hsc_env
785 dflags = hsc_dflags hsc_env
786 this_pkg = thisPackage dflags
788 used_mods = moduleEnvKeys ent_map
789 dir_imp_mods = (moduleEnvKeys direct_imports)
790 all_mods = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
791 usage_mods = sortBy stableModuleCmp all_mods
792 -- canonical order is imported, to avoid interface-file
795 -- ent_map groups together all the things imported and used
796 -- from a particular module
797 ent_map :: ModuleEnv [OccName]
798 ent_map = foldNameSet add_mv emptyModuleEnv used_names
801 | isWiredInName name = mv_map -- ignore wired-in names
803 = case nameModule_maybe name of
804 Nothing -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
805 Just mod -> extendModuleEnv_C (++) mv_map mod [occ]
806 where occ = nameOccName name
808 -- We want to create a Usage for a home module if
809 -- a) we used something from it; has something in used_names
810 -- b) we imported it, even if we used nothing from it
811 -- (need to recompile if its export list changes: export_fprint)
812 mkUsage :: Module -> Maybe Usage
814 | isNothing maybe_iface -- We can't depend on it if we didn't
815 -- load its interface.
816 || mod == this_mod -- We don't care about usages of
817 -- things in *this* module
820 | modulePackageId mod /= this_pkg
821 = Just UsagePackageModule{ usg_mod = mod,
822 usg_mod_hash = mod_hash }
823 -- for package modules, we record the module hash only
826 && isNothing export_hash
827 && not is_direct_import
829 = Nothing -- Record no usage info
830 -- for directly-imported modules, we always want to record a usage
831 -- on the orphan hash. This is what triggers a recompilation if
832 -- an orphan is added or removed somewhere below us in the future.
835 = Just UsageHomeModule {
836 usg_mod_name = moduleName mod,
837 usg_mod_hash = mod_hash,
838 usg_exports = export_hash,
839 usg_entities = fmToList ent_hashs }
841 maybe_iface = lookupIfaceByModule dflags hpt pit mod
842 -- In one-shot mode, the interfaces for home-package
843 -- modules accumulate in the PIT not HPT. Sigh.
845 is_direct_import = mod `elemModuleEnv` direct_imports
847 Just iface = maybe_iface
848 finsts_mod = mi_finsts iface
849 hash_env = mi_hash_fn iface
850 mod_hash = mi_mod_hash iface
851 export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
852 | otherwise = Nothing
854 used_occs = lookupModuleEnv ent_map mod `orElse` []
856 -- Making a FiniteMap here ensures that (a) we remove duplicates
857 -- when we have usages on several subordinates of a single parent,
858 -- and (b) that the usages emerge in a canonical order, which
859 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
860 -- using Ord on the OccNames, which is a lexicographic ordering.
861 ent_hashs :: FiniteMap OccName Fingerprint
862 ent_hashs = listToFM (map lookup_occ used_occs)
866 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
869 depend_on_exports mod =
870 case lookupModuleEnv direct_imports mod of
872 -- Even if we used 'import M ()', we have to register a
873 -- usage on the export list because we are sensitive to
874 -- changes in orphan instances/rules.
876 -- In GHC 6.8.x the above line read "True", and in
877 -- fact it recorded a dependency on *all* the
878 -- modules underneath in the dependency tree. This
879 -- happens to make orphans work right, but is too
880 -- expensive: it'll read too many interface files.
881 -- The 'isNothing maybe_iface' check above saved us
882 -- from generating many of these usages (at least in
883 -- one-shot mode), but that's even more bogus!
887 mkIfaceExports :: [AvailInfo]
888 -> [(Module, [GenAvailInfo OccName])]
889 -- Group by module and sort by occurrence
890 -- This keeps the list in canonical order
891 mkIfaceExports exports
892 = [ (mod, eltsFM avails)
893 | (mod, avails) <- fmToList groupFM
896 -- Group by the module where the exported entities are defined
897 -- (which may not be the same for all Names in an Avail)
898 -- Deliberately use FiniteMap rather than UniqFM so we
899 -- get a canonical ordering
900 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
901 groupFM = foldl add emptyModuleEnv exports
903 add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
904 -> Module -> GenAvailInfo OccName
905 -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
906 add_one env mod avail
907 = extendModuleEnv_C plusFM env mod
908 (unitFM (occNameFS (availName avail)) avail)
910 -- NB: we should not get T(X) and T(Y) in the export list
911 -- else the plusFM will simply discard one! They
912 -- should have been combined by now.
914 = add_one env (nameModule n) (Avail (nameOccName n))
916 add env (AvailTC tc ns)
917 = foldl add_for_mod env mods
919 tc_occ = nameOccName tc
920 mods = nub (map nameModule ns)
921 -- Usually just one, but see Note [Original module]
924 = add_one env mod (AvailTC tc_occ (sort names_from_mod))
925 -- NB. sort the children, we need a canonical order
927 names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
930 Note [Orignal module]
931 ~~~~~~~~~~~~~~~~~~~~~
933 module X where { data family T }
934 module Y( T(..) ) where { import X; data instance T Int = MkT Int }
935 The exported Avail from Y will look like
938 - only MkT is brought into scope by the data instance;
939 - but the parent (used for grouping and naming in T(..) exports) is X.T
940 - and in this case we export X.T too
942 In the result of MkIfaceExports, the names are grouped by defining module,
943 so we may need to split up a single Avail into multiple ones.
946 %************************************************************************
948 Load the old interface file for this module (unless
949 we have it aleady), and check whether it is up to date
952 %************************************************************************
955 checkOldIface :: HscEnv
957 -> Bool -- Source unchanged
958 -> Maybe ModIface -- Old interface from compilation manager, if any
959 -> IO (RecompileRequired, Maybe ModIface)
961 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
962 = do { showPass (hsc_dflags hsc_env)
963 ("Checking old interface for " ++
964 showSDoc (ppr (ms_mod mod_summary))) ;
966 ; initIfaceCheck hsc_env $
967 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
970 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
971 -> IfG (Bool, Maybe ModIface)
972 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
973 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
974 { when (not source_unchanged)
975 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
977 -- If the source has changed and we're in interactive mode, avoid reading
978 -- an interface; just return the one we might have been supplied with.
979 ; let dflags = hsc_dflags hsc_env
980 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
981 return (outOfDate, maybe_iface)
983 case maybe_iface of {
984 Just old_iface -> do -- Use the one we already have
985 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
986 ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
987 ; return (recomp, Just old_iface) }
991 -- Try and read the old interface for the current module
992 -- from the .hi file left from the last time we compiled it
993 { let iface_path = msHiFilePath mod_summary
994 ; read_result <- readIface (ms_mod mod_summary) iface_path False
995 ; case read_result of {
996 Failed err -> do -- Old interface file not found, or garbled; give up
997 { traceIf (text "FYI: cannot read old interface file:"
999 ; return (outOfDate, Nothing) }
1001 ; Succeeded iface -> do
1003 -- We have got the old iface; check its versions
1004 { traceIf (text "Read the interface file" <+> text iface_path)
1005 ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1006 ; return (recomp, Just iface)
1011 @recompileRequired@ is called from the HscMain. It checks whether
1012 a recompilation is required. It needs access to the persistent state,
1013 finder, etc, because it may have to load lots of interface files to
1014 check their versions.
1017 type RecompileRequired = Bool
1018 upToDate, outOfDate :: Bool
1019 upToDate = False -- Recompile not required
1020 outOfDate = True -- Recompile required
1022 checkVersions :: HscEnv
1023 -> Bool -- True <=> source unchanged
1025 -> ModIface -- Old interface
1026 -> IfG RecompileRequired
1027 checkVersions hsc_env source_unchanged mod_summary iface
1028 | not source_unchanged
1031 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1032 ppr (mi_module iface) <> colon)
1034 ; recomp <- checkDependencies hsc_env mod_summary iface
1035 ; if recomp then return outOfDate else do {
1037 -- Source code unchanged and no errors yet... carry on
1039 -- First put the dependent-module info, read from the old
1040 -- interface, into the envt, so that when we look for
1041 -- interfaces we look for the right one (.hi or .hi-boot)
1043 -- It's just temporary because either the usage check will succeed
1044 -- (in which case we are done with this module) or it'll fail (in which
1045 -- case we'll compile the module from scratch anyhow).
1047 -- We do this regardless of compilation mode, although in --make mode
1048 -- all the dependent modules should be in the HPT already, so it's
1050 updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
1052 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1053 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1056 -- This is a bit of a hack really
1057 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1058 mod_deps = mkModDeps (dep_mods (mi_deps iface))
1061 -- If the direct imports of this module are resolved to targets that
1062 -- are not among the dependencies of the previous interface file,
1063 -- then we definitely need to recompile. This catches cases like
1064 -- - an exposed package has been upgraded
1065 -- - we are compiling with different package flags
1066 -- - a home module that was shadowing a package module has been removed
1067 -- - a new home module has been added that shadows a package module
1070 -- Returns True if recompilation is required.
1071 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1072 checkDependencies hsc_env summary iface
1073 = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1075 prev_dep_mods = dep_mods (mi_deps iface)
1076 prev_dep_pkgs = dep_pkgs (mi_deps iface)
1078 this_pkg = thisPackage (hsc_dflags hsc_env)
1080 orM = foldr f (return False)
1081 where f m rest = do b <- m; if b then return True else rest
1083 dep_missing (L _ mod) = do
1084 find_res <- liftIO $ findImportedModule hsc_env mod Nothing
1088 -> if moduleName mod `notElem` map fst prev_dep_mods
1089 then do traceHiDiffs $
1090 text "imported module " <> quotes (ppr mod) <>
1091 text " not among previous dependencies"
1096 -> if pkg `notElem` prev_dep_pkgs
1097 then do traceHiDiffs $
1098 text "imported module " <> quotes (ppr mod) <>
1099 text " is from package " <> quotes (ppr pkg) <>
1100 text ", which is not among previous dependencies"
1104 where pkg = modulePackageId mod
1105 _otherwise -> return outOfDate
1107 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1108 -> IfG RecompileRequired
1109 needInterface mod continue
1110 = do -- Load the imported interface if possible
1111 let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1112 traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1114 mb_iface <- loadInterface doc_str mod ImportBySystem
1115 -- Load the interface, but don't complain on failure;
1116 -- Instead, get an Either back which we can test
1119 Failed _ -> (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1121 -- Couldn't find or parse a module mentioned in the
1122 -- old interface file. Don't complain: it might
1123 -- just be that the current module doesn't need that
1124 -- import and it's been deleted
1125 Succeeded iface -> continue iface
1128 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1129 -- Given the usage information extracted from the old
1130 -- M.hi file for the module being compiled, figure out
1131 -- whether M needs to be recompiled.
1133 checkModUsage _this_pkg UsagePackageModule{
1135 usg_mod_hash = old_mod_hash }
1136 = needInterface mod $ \iface -> do
1137 checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1138 -- We only track the ABI hash of package modules, rather than
1139 -- individual entity usages, so if the ABI hash changes we must
1140 -- recompile. This is safe but may entail more recompilation when
1141 -- a dependent package has changed.
1143 checkModUsage this_pkg UsageHomeModule{
1144 usg_mod_name = mod_name,
1145 usg_mod_hash = old_mod_hash,
1146 usg_exports = maybe_old_export_hash,
1147 usg_entities = old_decl_hash }
1149 let mod = mkModule this_pkg mod_name
1150 needInterface mod $ \iface -> do
1153 new_mod_hash = mi_mod_hash iface
1154 new_decl_hash = mi_hash_fn iface
1155 new_export_hash = mi_exp_hash iface
1158 recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1159 if not recompile then return upToDate else do
1161 -- CHECK EXPORT LIST
1162 checkMaybeHash maybe_old_export_hash new_export_hash
1163 (ptext (sLit " Export list changed")) $ do
1165 -- CHECK ITEMS ONE BY ONE
1166 recompile <- checkList [ checkEntityUsage new_decl_hash u
1167 | u <- old_decl_hash]
1169 then return outOfDate -- This one failed, so just bail out now
1170 else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
1172 ------------------------
1173 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1174 checkModuleFingerprint old_mod_hash new_mod_hash
1175 | new_mod_hash == old_mod_hash
1176 = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1179 = out_of_date_hash (ptext (sLit " Module fingerprint has changed"))
1180 old_mod_hash new_mod_hash
1182 ------------------------
1183 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1184 -> IfG RecompileRequired -> IfG RecompileRequired
1185 checkMaybeHash maybe_old_hash new_hash doc continue
1186 | Just hash <- maybe_old_hash, hash /= new_hash
1187 = out_of_date_hash doc hash new_hash
1191 ------------------------
1192 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1193 -> (OccName, Fingerprint)
1195 checkEntityUsage new_hash (name,old_hash)
1196 = case new_hash name of
1198 Nothing -> -- We used it before, but it ain't there now
1199 out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1201 Just (_, new_hash) -- It's there, but is it up to date?
1202 | new_hash == old_hash -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_hash))
1204 | otherwise -> out_of_date_hash (ptext (sLit " Out of date:") <+> ppr name)
1207 up_to_date, out_of_date :: SDoc -> IfG Bool
1208 up_to_date msg = traceHiDiffs msg >> return upToDate
1209 out_of_date msg = traceHiDiffs msg >> return outOfDate
1211 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1212 out_of_date_hash msg old_hash new_hash
1213 = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1215 ----------------------
1216 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1217 -- This helper is used in two places
1218 checkList [] = return upToDate
1219 checkList (check:checks) = do recompile <- check
1221 then return outOfDate
1222 else checkList checks
1225 %************************************************************************
1227 Converting things to their Iface equivalents
1229 %************************************************************************
1232 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1233 -- Assumption: the thing is already tidied, so that locally-bound names
1234 -- (lambdas, for-alls) already have non-clashing OccNames
1235 -- Reason: Iface stuff uses OccNames, and the conversion here does
1236 -- not do tidying on the way
1237 tyThingToIfaceDecl (AnId id)
1238 = IfaceId { ifName = getOccName id,
1239 ifType = toIfaceType (idType id),
1242 info = case toIfaceIdInfo (idInfo id) of
1244 items -> HasInfo items
1246 tyThingToIfaceDecl (AClass clas)
1247 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1248 ifName = getOccName clas,
1249 ifTyVars = toIfaceTvBndrs clas_tyvars,
1250 ifFDs = map toIfaceFD clas_fds,
1251 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1252 ifSigs = map toIfaceClassOp op_stuff,
1253 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1255 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1256 = classExtraBigSig clas
1257 tycon = classTyCon clas
1259 toIfaceClassOp (sel_id, def_meth)
1260 = ASSERT(sel_tyvars == clas_tyvars)
1261 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1263 -- Be careful when splitting the type, because of things
1264 -- like class Foo a where
1265 -- op :: (?x :: String) => a -> a
1266 -- and class Baz a where
1267 -- op :: (Ord a) => a -> a
1268 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1269 op_ty = funResultTy rho_ty
1271 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1273 tyThingToIfaceDecl (ATyCon tycon)
1275 = IfaceSyn { ifName = getOccName tycon,
1276 ifTyVars = toIfaceTvBndrs tyvars,
1277 ifOpenSyn = syn_isOpen,
1278 ifSynRhs = toIfaceType syn_tyki,
1279 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1283 = IfaceData { ifName = getOccName tycon,
1284 ifTyVars = toIfaceTvBndrs tyvars,
1285 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1286 ifCons = ifaceConDecls (algTyConRhs tycon),
1287 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1288 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1289 ifGeneric = tyConHasGenerics tycon,
1290 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1292 | isForeignTyCon tycon
1293 = IfaceForeign { ifName = getOccName tycon,
1294 ifExtName = tyConExtName tycon }
1296 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1298 tyvars = tyConTyVars tycon
1299 (syn_isOpen, syn_tyki) = case synTyConRhs tycon of
1300 OpenSynTyCon ki _ -> (True , ki)
1301 SynonymTyCon ty -> (False, ty)
1303 ifaceConDecls (NewTyCon { data_con = con }) =
1304 IfNewTyCon (ifaceConDecl con)
1305 ifaceConDecls (DataTyCon { data_cons = cons }) =
1306 IfDataTyCon (map ifaceConDecl cons)
1307 ifaceConDecls OpenTyCon {} = IfOpenDataTyCon
1308 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1309 -- The last case happens when a TyCon has been trimmed during tidying
1310 -- Furthermore, tyThingToIfaceDecl is also used
1311 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1312 -- AbstractTyCon case is perfectly sensible.
1314 ifaceConDecl data_con
1315 = IfCon { ifConOcc = getOccName (dataConName data_con),
1316 ifConInfix = dataConIsInfix data_con,
1317 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1318 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1319 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1320 ifConCtxt = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1321 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1322 ifConFields = map getOccName
1323 (dataConFieldLabels data_con),
1324 ifConStricts = dataConStrictMarks data_con }
1326 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1328 famInstToIface Nothing = Nothing
1329 famInstToIface (Just (famTyCon, instTys)) =
1330 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1332 tyThingToIfaceDecl (ADataCon dc)
1333 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1336 getFS :: NamedThing a => a -> FastString
1337 getFS x = occNameFS (getOccName x)
1339 --------------------------
1340 instanceToIfaceInst :: Instance -> IfaceInst
1341 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1342 is_cls = cls_name, is_tcs = mb_tcs })
1343 = ASSERT( cls_name == className cls )
1344 IfaceInst { ifDFun = dfun_name,
1346 ifInstCls = cls_name,
1347 ifInstTys = map do_rough mb_tcs,
1350 do_rough Nothing = Nothing
1351 do_rough (Just n) = Just (toIfaceTyCon_name n)
1353 dfun_name = idName dfun_id
1354 mod = nameModule dfun_name
1355 is_local name = nameIsLocalOrFrom mod name
1357 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1358 (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1359 -- Slightly awkward: we need the Class to get the fundeps
1360 (tvs, fds) = classTvsFds cls
1361 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1362 orph | is_local cls_name = Just (nameOccName cls_name)
1363 | all isJust mb_ns = head mb_ns
1364 | otherwise = Nothing
1366 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1367 -- that is not in the "determined" arguments
1368 mb_ns | null fds = [choose_one arg_names]
1369 | otherwise = map do_one fds
1370 do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1371 , not (tv `elem` rtvs)]
1373 choose_one :: [NameSet] -> Maybe OccName
1374 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1376 (n : _) -> Just (nameOccName n)
1378 --------------------------
1379 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1380 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1383 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1384 , ifFamInstFam = fam
1385 , ifFamInstTys = map do_rough mb_tcs }
1387 do_rough Nothing = Nothing
1388 do_rough (Just n) = Just (toIfaceTyCon_name n)
1390 --------------------------
1391 toIfaceLetBndr :: Id -> IfaceLetBndr
1392 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1393 (toIfaceType (idType id))
1396 -- Stripped-down version of tcIfaceIdInfo
1397 -- Change this if you want to export more IdInfo for
1398 -- non-top-level Ids. Don't forget to change
1399 -- CoreTidy.tidyLetBndr too!
1401 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1403 inline_prag = inlinePragInfo id_info
1404 prag_info | isAlwaysActive inline_prag = NoInfo
1405 | otherwise = HasInfo [HsInline inline_prag]
1407 --------------------------
1408 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1409 toIfaceIdInfo id_info
1410 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1411 inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
1413 ------------ Arity --------------
1414 arity_info = arityInfo id_info
1415 arity_hsinfo | arity_info == 0 = Nothing
1416 | otherwise = Just (HsArity arity_info)
1418 ------------ Caf Info --------------
1419 caf_info = cafInfo id_info
1420 caf_hsinfo = case caf_info of
1421 NoCafRefs -> Just HsNoCafRefs
1424 ------------ Strictness --------------
1425 -- No point in explicitly exporting TopSig
1426 strict_hsinfo = case newStrictnessInfo id_info of
1427 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1430 ------------ Worker --------------
1431 work_info = workerInfo id_info
1432 has_worker = workerExists work_info
1433 wrkr_hsinfo = case work_info of
1434 HasWorker work_id wrap_arity ->
1435 Just (HsWorker ((idName work_id)) wrap_arity)
1438 ------------ Unfolding --------------
1439 -- The unfolding is redundant if there is a worker
1440 unfold_info = unfoldingInfo id_info
1441 rhs = unfoldingTemplate unfold_info
1442 no_unfolding = neverUnfold unfold_info
1443 -- The CoreTidy phase retains unfolding info iff
1444 -- we want to expose the unfolding, taking into account
1445 -- unconditional NOINLINE, etc. See TidyPgm.addExternal
1446 unfold_hsinfo | no_unfolding = Nothing
1447 | has_worker = Nothing -- Unfolding is implicit
1448 | otherwise = Just (HsUnfold (toIfaceExpr rhs))
1450 ------------ Inline prag --------------
1451 inline_prag = inlinePragInfo id_info
1452 inline_hsinfo | isAlwaysActive inline_prag = Nothing
1453 | no_unfolding && not has_worker = Nothing
1454 -- If the iface file give no unfolding info, we
1455 -- don't need to say when inlining is OK!
1456 | otherwise = Just (HsInline inline_prag)
1458 --------------------------
1459 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1460 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1461 = pprTrace "toHsRule: builtin" (ppr fn) $
1464 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1465 ru_act = act, ru_bndrs = bndrs,
1466 ru_args = args, ru_rhs = rhs })
1467 = IfaceRule { ifRuleName = name, ifActivation = act,
1468 ifRuleBndrs = map toIfaceBndr bndrs,
1470 ifRuleArgs = map do_arg args,
1471 ifRuleRhs = toIfaceExpr rhs,
1474 -- For type args we must remove synonyms from the outermost
1475 -- level. Reason: so that when we read it back in we'll
1476 -- construct the same ru_rough field as we have right now;
1478 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1479 do_arg arg = toIfaceExpr arg
1481 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1482 -- A rule is an orphan only if none of the variables
1483 -- mentioned on its left-hand side are locally defined
1484 lhs_names = fn : nameSetToList (exprsFreeNames args)
1485 -- No need to delete bndrs, because
1486 -- exprsFreeNames finds only External names
1488 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1489 (n : _) -> Just (nameOccName n)
1492 bogusIfaceRule :: Name -> IfaceRule
1493 bogusIfaceRule id_name
1494 = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1495 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1496 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1498 ---------------------
1499 toIfaceExpr :: CoreExpr -> IfaceExpr
1500 toIfaceExpr (Var v) = toIfaceVar v
1501 toIfaceExpr (Lit l) = IfaceLit l
1502 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1503 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1504 toIfaceExpr (App f a) = toIfaceApp f [a]
1505 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1506 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1507 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1508 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1510 ---------------------
1511 toIfaceNote :: Note -> IfaceNote
1512 toIfaceNote (SCC cc) = IfaceSCC cc
1513 toIfaceNote InlineMe = IfaceInlineMe
1514 toIfaceNote (CoreNote s) = IfaceCoreNote s
1516 ---------------------
1517 toIfaceBind :: Bind Id -> IfaceBinding
1518 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1519 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1521 ---------------------
1522 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1523 -> (IfaceConAlt, [FastString], IfaceExpr)
1524 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1526 ---------------------
1527 toIfaceCon :: AltCon -> IfaceConAlt
1528 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1529 | otherwise = IfaceDataAlt (getName dc)
1531 tc = dataConTyCon dc
1533 toIfaceCon (LitAlt l) = IfaceLitAlt l
1534 toIfaceCon DEFAULT = IfaceDefault
1536 ---------------------
1537 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1538 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1539 toIfaceApp (Var v) as
1540 = case isDataConWorkId_maybe v of
1541 -- We convert the *worker* for tuples into IfaceTuples
1542 Just dc | isTupleTyCon tc && saturated
1543 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1545 val_args = dropWhile isTypeArg as
1546 saturated = val_args `lengthIs` idArity v
1547 tup_args = map toIfaceExpr val_args
1548 tc = dataConTyCon dc
1550 _ -> mkIfaceApps (toIfaceVar v) as
1552 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1554 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1555 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1557 ---------------------
1558 toIfaceVar :: Id -> IfaceExpr
1560 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1561 -- Foreign calls have special syntax
1562 | isExternalName name = IfaceExt name
1563 | Just (TickBox m ix) <- isTickBoxOp_maybe v
1565 | otherwise = IfaceLcl (getFS name)