2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
8 mkUsageInfo, -- Construct the usage info for a module
10 mkIface, -- Build a ModIface from a ModGuts,
11 -- including computing version information
13 writeIfaceFile, -- Write the interface file
15 checkOldIface, -- See if recompilation is required, by
16 -- comparing version information
18 tyThingToIfaceDecl -- Converting things to their Iface equivalents
22 -----------------------------------------------
23 MkIface.lhs deals with versioning
24 -----------------------------------------------
26 Here's the version-related info in an interface file
28 module Foo 8 -- module-version
29 3 -- export-list-version
31 Usages: -- Version info for what this compilation of Foo imported
32 Baz 3 -- Module version
33 [4] -- The export-list version if Foo depended on it
34 (g,2) -- Function and its version
35 (T,1) -- Type and its version
37 <version> f :: Int -> Int {- Unfolding: \x -> Wib.t[2] x -}
38 -- The [2] says that f's unfolding
39 -- mentions verison 2 of Wib.t
41 -----------------------------------------------
43 -----------------------------------------------
46 * In the mi_usages information in an interface, we record the
47 version number of each free variable of the module
49 * In mkIface, we compute the version number of each exported thing A.f
50 by comparing its A.f's info with its new info, and bumping its
51 version number if it differs. If A.f mentions B.g, and B.g's version
52 number has changed, then we count A.f as having changed too.
54 * In checkOldIface we compare the mi_usages for the module with
55 the actual version info for all each thing recorded in mi_usages
60 We count A.f as changing if its fixity changes
64 If a rule changes, we want to recompile any module that might be
65 affected by that rule. For non-orphan rules, this is relatively easy.
66 If module M defines f, and a rule for f, just arrange that the version
67 number for M.f changes if any of the rules for M.f change. Any module
68 that does not depend on M.f can't be affected by the rule-change
71 Orphan rules (ones whose 'head function' is not defined in M) are
72 harder. Here's what we do.
74 * We have a per-module orphan-rule version number which changes if
75 any orphan rule changes. (It's unaffected by non-orphan rules.)
77 * We record usage info for any orphan module 'below' this one,
78 giving the orphan-rule version number. We recompile if this
81 The net effect is that if an orphan rule changes, we recompile every
82 module above it. That's very conservative, but it's devilishly hard
83 to know what it might affect, so we just have to be conservative.
87 In an iface file we have
89 instance Eq a => Eq [a] = dfun29
92 We have a version number for dfun29, covering its unfolding
93 etc. Suppose we are compiling a module M that imports A only
94 indirectly. If typechecking M uses this instance decl, we record the
95 dependency on A.dfun29 as if it were a free variable of the module
96 (via the tcg_inst_usages accumulator). That means that A will appear
97 in M's usage list. If the shape of the instance declaration changes,
98 then so will dfun29's version, triggering a recompilation.
100 Adding an instance declaration, or changing an instance decl that is
101 not currently used, is more tricky. (This really only makes a
102 difference when we have overlapping instance decls, because then the
103 new instance decl might kick in to override the old one.) We handle
104 this in a very similar way that we handle rules above.
106 * For non-orphan instance decls, identify one locally-defined tycon/class
107 mentioned in the decl. Treat the instance decl as part of the defn of that
108 tycon/class, so that if the shape of the instance decl changes, so does the
109 tycon/class; that in turn will force recompilation of anything that uses
112 * For orphan instance decls, act the same way as for orphan rules.
113 Indeed, we use the same global orphan-rule version number.
117 mkUsageInfo figures out what the ``usage information'' for this
118 moudule is; that is, what it must record in its interface file as the
121 We produce a line for every module B below the module, A, currently being
124 to record the fact that A does import B indirectly. This is used to decide
125 to look to look for B.hi rather than B.hi-boot when compiling a module that
126 imports A. This line says that A imports B, but uses nothing in it.
127 So we'll get an early bale-out when compiling A if B's version changes.
129 The usage information records:
132 \item (a) anything reachable from its body code
133 \item (b) any module exported with a @module Foo@
134 \item (c) anything reachable from an exported item
137 Why (b)? Because if @Foo@ changes then this module's export list
138 will change, so we must recompile this module at least as far as
139 making a new interface file --- but in practice that means complete
142 Why (c)? Consider this:
144 module A( f, g ) where | module B( f ) where
145 import B( f ) | f = h 3
149 Here, @B.f@ isn't used in A. Should we nevertheless record @B.f@ in
150 @A@'s usages? Our idea is that we aren't going to touch A.hi if it is
151 *identical* to what it was before. If anything about @B.f@ changes
152 than anyone who imports @A@ should be recompiled in case they use
153 @B.f@ (they'll get an early exit if they don't). So, if anything
154 about @B.f@ changes we'd better make sure that something in A.hi
155 changes, and the convenient way to do that is to record the version
156 number @B.f@ in A.hi in the usage list. If B.f changes that'll force a
157 complete recompiation of A, which is overkill but it's the only way to
158 write a new, slightly different, A.hi.
160 But the example is tricker. Even if @B.f@ doesn't change at all,
161 @B.h@ may do so, and this change may not be reflected in @f@'s version
162 number. But with -O, a module that imports A must be recompiled if
163 @B.h@ changes! So A must record a dependency on @B.h@. So we treat
164 the occurrence of @B.f@ in the export list *just as if* it were in the
165 code of A, and thereby haul in all the stuff reachable from it.
167 *** Conclusion: if A mentions B.f in its export list,
168 behave just as if A mentioned B.f in its source code,
169 and slurp in B.f and all its transitive closure ***
171 [NB: If B was compiled with -O, but A isn't, we should really *still*
172 haul in all the unfoldings for B, in case the module that imports A *is*
173 compiled with -O. I think this is the case.]
177 #include "HsVersions.h"
208 import PackageConfig hiding ( Version )
210 import BasicTypes hiding ( SuccessFlag(..) )
212 import Util hiding ( eqListBy )
223 %************************************************************************
225 \subsection{Completing an interface}
227 %************************************************************************
231 -> Maybe ModIface -- The old interface, if we have it
232 -> ModGuts -- Usages, deprecations, etc
233 -> ModDetails -- The trimmed, tidied interface
234 -> IO (ModIface, -- The new one, complete with decls and versions
235 Bool) -- True <=> there was an old Iface, and the new one
236 -- is identical, so no need to write it
238 mkIface hsc_env maybe_old_iface
239 (ModGuts{ mg_module = this_mod,
243 mg_rdr_env = rdr_env,
244 mg_fix_env = fix_env,
245 mg_deprecs = src_deprecs,
246 mg_vect_info = vect_info })
247 (ModDetails{ md_insts = insts,
248 md_fam_insts = fam_insts,
251 md_exports = exports })
253 -- NB: notice that mkIface does not look at the bindings
254 -- only at the TypeEnv. The previous Tidy phase has
255 -- put exactly the info into the TypeEnv that we want
256 -- to expose in the interface
258 = do { eps <- hscEPS hsc_env
259 ; let { entities = typeEnvElts type_env ;
260 decls = [ tyThingToIfaceDecl entity
261 | entity <- entities,
262 let name = getName entity,
263 not (isImplicitTyThing entity),
264 -- No implicit Ids and class tycons in the interface file
265 not (isWiredInName name),
266 -- Nor wired-in things; the compiler knows about them anyhow
267 nameIsLocalOrFrom this_mod name ]
268 -- Sigh: see Note [Root-main Id] in TcRnDriver
270 ; fixities = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
271 ; deprecs = mkIfaceDeprec src_deprecs
272 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
273 ; iface_insts = map instanceToIfaceInst insts
274 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
276 ; intermediate_iface = ModIface {
277 mi_module = this_mod,
281 mi_exports = mkIfaceExports exports,
283 -- Sort these lexicographically, so that
284 -- the result is stable across compilations
285 mi_insts = sortLe le_inst iface_insts,
286 mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
287 mi_rules = sortLe le_rule iface_rules,
289 mi_fixities = fixities,
290 mi_deprecs = deprecs,
291 mi_globals = Just rdr_env,
293 -- Left out deliberately: filled in by addVersionInfo
294 mi_mod_vers = initialVersion,
295 mi_exp_vers = initialVersion,
296 mi_rule_vers = initialVersion,
297 mi_orphan = False, -- Always set by addVersionInfo, but
298 -- it's a strict field, so we can't omit it.
299 mi_finsts = False, -- Ditto
300 mi_decls = deliberatelyOmitted "decls",
301 mi_ver_fn = deliberatelyOmitted "ver_fn",
303 mi_vect_info = flattenVectInfo vect_info,
305 -- And build the cached values
306 mi_dep_fn = mkIfaceDepCache deprecs,
307 mi_fix_fn = mkIfaceFixCache fixities }
309 -- Add version information
310 ; ext_ver_fn = mkParentVerFun hsc_env eps
311 ; (new_iface, no_change_at_all, pp_diffs, pp_orphs)
312 = _scc_ "versioninfo"
313 addVersionInfo ext_ver_fn maybe_old_iface
314 intermediate_iface decls
318 ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags)
319 (printDump (expectJust "mkIface" pp_orphs))
320 ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
321 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
322 (pprModIface new_iface)
324 ; return (new_iface, no_change_at_all) }
326 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
327 i1 `le_inst` i2 = ifDFun i1 `le_occ` ifDFun i2
328 i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
330 le_occ :: Name -> Name -> Bool
331 -- Compare lexicographically by OccName, *not* by unique, because
332 -- the latter is not stable across compilations
333 le_occ n1 n2 = nameOccName n1 <= nameOccName n2
335 dflags = hsc_dflags hsc_env
336 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
337 ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
339 flattenVectInfo (VectInfo ccVar) = IfaceVectInfo (nameSetToList ccVar)
341 -----------------------------
342 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
343 writeIfaceFile dflags location new_iface
344 = do createDirectoryHierarchy (directoryOf hi_file_path)
345 writeBinIface dflags hi_file_path new_iface
346 where hi_file_path = ml_hi_file location
349 -- -----------------------------------------------------------------------------
350 -- Look up parents and versions of Names
352 -- This is like a global version of the mi_ver_fn field in each ModIface.
353 -- Given a Name, it finds the ModIface, and then uses mi_ver_fn to get
354 -- the parent and version info.
357 :: HscEnv -- needed to look up versions
358 -> ExternalPackageState -- ditto
359 -> (Name -> (OccName,Version))
360 mkParentVerFun hsc_env eps
363 mod = nameModule name
364 occ = nameOccName name
365 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
366 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
368 mi_ver_fn iface occ `orElse`
369 pprPanic "lookupVers1" (ppr mod <+> ppr occ)
371 hpt = hsc_HPT hsc_env
374 -----------------------------------------------------------------------------
375 -- Compute version numbers for local decls
378 :: (Name -> (OccName,Version)) -- lookup parents and versions of names
379 -> Maybe ModIface -- The old interface, read from M.hi
380 -> ModIface -- The new interface (lacking decls)
381 -> [IfaceDecl] -- The new decls
382 -> (ModIface, -- Updated interface
383 Bool, -- True <=> no changes at all; no need to write Iface
385 Maybe SDoc) -- Warnings about orphans
387 addVersionInfo ver_fn Nothing new_iface new_decls
388 -- No old interface, so definitely write a new one!
389 = (new_iface { mi_orphan = not (null orph_insts && null orph_rules)
390 , mi_finsts = not . null $ mi_fam_insts new_iface
391 , mi_decls = [(initialVersion, decl) | decl <- new_decls]
392 , mi_ver_fn = mkIfaceVerCache (zip (repeat initialVersion)
396 ptext SLIT("No old interface file"),
397 pprOrphans orph_insts orph_rules)
399 orph_insts = filter (isNothing . ifInstOrph) (mi_insts new_iface)
400 orph_rules = filter (isNothing . ifRuleOrph) (mi_rules new_iface)
402 addVersionInfo ver_fn (Just old_iface@(ModIface {
403 mi_mod_vers = old_mod_vers,
404 mi_exp_vers = old_exp_vers,
405 mi_rule_vers = old_rule_vers,
406 mi_decls = old_decls,
407 mi_ver_fn = old_decl_vers,
408 mi_fix_fn = old_fixities }))
409 new_iface@(ModIface { mi_fix_fn = new_fixities })
412 = (old_iface, True, ptext SLIT("Interface file unchanged"), pp_orphs)
414 = (final_iface, False, vcat [ptext SLIT("Interface file has changed"),
415 nest 2 pp_diffs], pp_orphs)
417 final_iface = new_iface {
418 mi_mod_vers = bump_unless no_output_change old_mod_vers,
419 mi_exp_vers = bump_unless no_export_change old_exp_vers,
420 mi_rule_vers = bump_unless no_rule_change old_rule_vers,
421 mi_orphan = not (null new_orph_rules && null new_orph_insts),
422 mi_finsts = not . null $ mi_fam_insts new_iface,
423 mi_decls = decls_w_vers,
424 mi_ver_fn = mkIfaceVerCache decls_w_vers }
426 decls_w_vers = [(add_vers decl, decl) | decl <- new_decls]
429 (old_non_orph_insts, old_orph_insts) =
430 mkOrphMap ifInstOrph (mi_insts old_iface)
431 (new_non_orph_insts, new_orph_insts) =
432 mkOrphMap ifInstOrph (mi_insts new_iface)
433 old_fam_insts = mi_fam_insts old_iface
434 new_fam_insts = mi_fam_insts new_iface
435 same_insts occ = eqMaybeBy (eqListBy eqIfInst)
436 (lookupOccEnv old_non_orph_insts occ)
437 (lookupOccEnv new_non_orph_insts occ)
439 (old_non_orph_rules, old_orph_rules) =
440 mkOrphMap ifRuleOrph (mi_rules old_iface)
441 (new_non_orph_rules, new_orph_rules) =
442 mkOrphMap ifRuleOrph (mi_rules new_iface)
443 same_rules occ = eqMaybeBy (eqListBy eqIfRule)
444 (lookupOccEnv old_non_orph_rules occ)
445 (lookupOccEnv new_non_orph_rules occ)
447 -- Computing what changed
448 no_output_change = no_decl_change && no_rule_change &&
449 no_export_change && no_deprec_change
450 no_export_change = mi_exports new_iface == mi_exports old_iface
452 no_decl_change = isEmptyOccSet changed_occs
453 no_rule_change = not (changedWrtNames changed_occs (eqListBy eqIfRule old_orph_rules new_orph_rules)
454 || changedWrtNames changed_occs (eqListBy eqIfInst old_orph_insts new_orph_insts)
455 || changedWrtNames changed_occs (eqListBy eqIfFamInst old_fam_insts new_fam_insts))
456 no_deprec_change = mi_deprecs new_iface == mi_deprecs old_iface
458 -- If the usages havn't changed either, we don't need to write the interface file
459 no_other_changes = mi_usages new_iface == mi_usages old_iface &&
460 mi_deps new_iface == mi_deps old_iface
461 no_change_at_all = no_output_change && no_other_changes
463 pp_diffs = vcat [pp_change no_export_change "Export list"
464 (ppr old_exp_vers <+> arrow <+> ppr (mi_exp_vers final_iface)),
465 pp_change no_rule_change "Rules"
466 (ppr old_rule_vers <+> arrow <+> ppr (mi_rule_vers final_iface)),
467 pp_change no_deprec_change "Deprecations" empty,
468 pp_change no_other_changes "Usages" empty,
470 pp_change True what info = empty
471 pp_change False what info = text what <+> ptext SLIT("changed") <+> info
474 old_decl_env = mkOccEnv [(ifName decl, decl) | (_,decl) <- old_decls]
475 same_fixity n = bool (old_fixities n == new_fixities n)
478 -- Adding version info
479 new_version = bumpVersion old_mod_vers
480 -- Start from the old module version, not from
481 -- zero so that if you remove f, and then add
482 -- it again, you don't thereby reduce f's
485 add_vers decl | occ `elemOccSet` changed_occs = new_version
486 | otherwise = snd (expectJust "add_vers" (old_decl_vers occ))
487 -- If it's unchanged, there jolly well
488 where -- should be an old version number
492 -- Deciding which declarations have changed
494 -- For each local decl, the IfaceEq gives the list of things that
495 -- must be unchanged for the declaration as a whole to be unchanged.
496 eq_info :: [(OccName, IfaceEq)]
497 eq_info = map check_eq new_decls
499 | Just old_decl <- lookupOccEnv old_decl_env occ
500 = (occ, new_decl `eqIfDecl` old_decl &&& eq_indirects new_decl)
501 | otherwise {- No corresponding old decl -}
504 occ = ifName new_decl
506 eq_indirects :: IfaceDecl -> IfaceEq
507 -- When seeing if two decls are the same, remember to
508 -- check whether any relevant fixity or rules have changed
509 eq_indirects (IfaceId {ifName = occ}) = eq_ind_occ occ
510 eq_indirects (IfaceClass {ifName = cls_occ, ifSigs = sigs})
511 = same_insts cls_occ &&&
512 eq_ind_occs [op | IfaceClassOp op _ _ <- sigs]
513 eq_indirects (IfaceData {ifName = tc_occ, ifCons = cons})
514 = same_insts tc_occ &&& same_fixity tc_occ &&& -- The TyCon can have a fixity too
515 eq_ind_occs (map ifConOcc (visibleIfConDecls cons))
516 eq_indirects other = Equal -- Synonyms and foreign declarations
518 eq_ind_occ :: OccName -> IfaceEq -- For class ops and Ids; check fixity and rules
519 eq_ind_occ occ = same_fixity occ &&& same_rules occ
520 eq_ind_occs = foldr ((&&&) . eq_ind_occ) Equal
522 -- The Occs of declarations that changed.
523 changed_occs :: OccSet
524 changed_occs = computeChangedOccs ver_fn (mi_module new_iface)
525 (mi_usages old_iface) eq_info
529 pp_decl_diffs :: SDoc -- Nothing => no changes
531 | isEmptyOccSet changed_occs = empty
533 = vcat [ptext SLIT("Changed occs:") <+> ppr (occSetElts changed_occs),
534 ptext SLIT("Version change for these decls:"),
535 nest 2 (vcat (map show_change new_decls))]
537 eq_env = mkOccEnv eq_info
539 | not (occ `elemOccSet` changed_occs) = empty
541 = vcat [ppr occ <+> ppr (old_decl_vers occ) <+> arrow <+> ppr new_version,
544 occ = ifName new_decl
545 why = case lookupOccEnv eq_env occ of
546 Just (EqBut names) -> sep [ppr occ <> colon, ptext SLIT("Free vars (only) changed:") <> ppr names,
547 nest 2 (braces (fsep (map ppr (occSetElts
548 (occs `intersectOccSet` changed_occs)))))]
549 where occs = mkOccSet (map nameOccName (nameSetToList names))
551 | Just old_decl <- lookupOccEnv old_decl_env occ
552 -> vcat [ptext SLIT("Old:") <+> ppr old_decl,
553 ptext SLIT("New:") <+> ppr new_decl]
555 -> ppr occ <+> ptext SLIT("only in new interface")
556 other -> pprPanic "MkIface.show_change" (ppr occ)
558 pp_orphs = pprOrphans new_orph_insts new_orph_rules
561 pprOrphans insts rules
562 | null insts && null rules = Nothing
565 if null insts then empty else
566 hang (ptext SLIT("Warning: orphan instances:"))
567 2 (vcat (map ppr insts)),
568 if null rules then empty else
569 hang (ptext SLIT("Warning: orphan rules:"))
570 2 (vcat (map ppr rules))
574 :: (Name -> (OccName,Version)) -- get parents and versions
575 -> Module -- This module
576 -> [Usage] -- Usages from old iface
577 -> [(OccName, IfaceEq)] -- decl names, equality conditions
578 -> OccSet -- set of things that have changed
579 computeChangedOccs ver_fn this_module old_usages eq_info
580 = foldl add_changes emptyOccSet (stronglyConnComp edges)
583 -- return True if an external name has changed
584 name_changed :: Name -> Bool
586 | Just ents <- lookupUFM usg_modmap (moduleName mod)
587 = case lookupUFM ents parent_occ of
588 Nothing -> pprPanic "computeChangedOccs" (ppr nm)
589 Just v -> v < new_version
590 | otherwise = False -- must be in another package
593 (parent_occ, new_version) = ver_fn nm
595 -- Turn the usages from the old ModIface into a mapping
596 usg_modmap = listToUFM [ (usg_mod usg, listToUFM (usg_entities usg))
597 | usg <- old_usages ]
599 get_local_eq_info :: GenIfaceEq NameSet -> GenIfaceEq OccSet
600 get_local_eq_info Equal = Equal
601 get_local_eq_info NotEqual = NotEqual
602 get_local_eq_info (EqBut ns) = foldNameSet f Equal ns
603 where f name eq | nameModule name == this_module =
604 EqBut (unitOccSet (nameOccName name)) `and_occifeq` eq
605 | name_changed name = NotEqual
608 local_eq_infos = mapSnd get_local_eq_info eq_info
610 edges :: [((OccName, OccIfaceEq), Unique, [Unique])]
611 edges = [ (node, getUnique occ, map getUnique occs)
612 | node@(occ, iface_eq) <- local_eq_infos
613 , let occs = case iface_eq of
614 EqBut occ_set -> occSetElts occ_set
617 -- Changes in declarations
618 add_changes :: OccSet -> SCC (OccName, OccIfaceEq) -> OccSet
619 add_changes so_far (AcyclicSCC (occ, iface_eq))
620 | changedWrt so_far iface_eq -- This one has changed
621 = extendOccSet so_far occ
622 add_changes so_far (CyclicSCC pairs)
623 | changedWrt so_far (foldr1 and_occifeq iface_eqs)
624 -- One of this group has changed
625 = extendOccSetList so_far occs
626 where (occs, iface_eqs) = unzip pairs
627 add_changes so_far other = so_far
629 type OccIfaceEq = GenIfaceEq OccSet
631 changedWrt :: OccSet -> OccIfaceEq -> Bool
632 changedWrt so_far Equal = False
633 changedWrt so_far NotEqual = True
634 changedWrt so_far (EqBut kids) = so_far `intersectsOccSet` kids
636 changedWrtNames :: OccSet -> IfaceEq -> Bool
637 changedWrtNames so_far Equal = False
638 changedWrtNames so_far NotEqual = True
639 changedWrtNames so_far (EqBut kids) =
640 so_far `intersectsOccSet` mkOccSet (map nameOccName (nameSetToList kids))
642 and_occifeq :: OccIfaceEq -> OccIfaceEq -> OccIfaceEq
643 Equal `and_occifeq` x = x
644 NotEqual `and_occifeq` x = NotEqual
645 EqBut nms `and_occifeq` Equal = EqBut nms
646 EqBut nms `and_occifeq` NotEqual = NotEqual
647 EqBut nms1 `and_occifeq` EqBut nms2 = EqBut (nms1 `unionOccSets` nms2)
649 ----------------------
650 -- mkOrphMap partitions instance decls or rules into
651 -- (a) an OccEnv for ones that are not orphans,
652 -- mapping the local OccName to a list of its decls
653 -- (b) a list of orphan decls
654 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
655 -- Nothing for an orphan decl
656 -> [decl] -- Sorted into canonical order
657 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
658 -- each sublist in canonical order
659 [decl]) -- Orphan decls; in canonical order
660 mkOrphMap get_key decls
661 = foldl go (emptyOccEnv, []) decls
663 go (non_orphs, orphs) d
664 | Just occ <- get_key d
665 = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
666 | otherwise = (non_orphs, d:orphs)
668 ----------------------
669 mkIfaceDeprec :: Deprecations -> IfaceDeprecs
670 mkIfaceDeprec NoDeprecs = NoDeprecs
671 mkIfaceDeprec (DeprecAll t) = DeprecAll t
672 mkIfaceDeprec (DeprecSome env) = DeprecSome (sortLe (<=) (nameEnvElts env))
674 ----------------------
675 bump_unless :: Bool -> Version -> Version
676 bump_unless True v = v -- True <=> no change
677 bump_unless False v = bumpVersion v
681 %*********************************************************
683 \subsection{Keeping track of what we've slurped, and version numbers}
685 %*********************************************************
689 mkUsageInfo :: HscEnv
690 -> ModuleEnv (Module, Bool, SrcSpan)
691 -> [(ModuleName, IsBootInterface)]
692 -> NameSet -> IO [Usage]
693 mkUsageInfo hsc_env dir_imp_mods dep_mods used_names
694 = do { eps <- hscEPS hsc_env
695 ; let usages = mk_usage_info (eps_PIT eps) hsc_env
696 dir_imp_mods dep_mods used_names
697 ; usages `seqList` return usages }
698 -- seq the list of Usages returned: occasionally these
699 -- don't get evaluated for a while and we can end up hanging on to
700 -- the entire collection of Ifaces.
702 mk_usage_info pit hsc_env dir_imp_mods dep_mods used_names
703 = mapCatMaybes mkUsage dep_mods
704 -- ToDo: do we need to sort into canonical order?
706 hpt = hsc_HPT hsc_env
707 dflags = hsc_dflags hsc_env
709 -- ent_map groups together all the things imported and used
710 -- from a particular module in this package
711 ent_map :: ModuleEnv [OccName]
712 ent_map = foldNameSet add_mv emptyModuleEnv used_names
714 | isWiredInName name = mv_map -- ignore wired-in names
716 = case nameModule_maybe name of
717 Nothing -> mv_map -- ignore internal names
718 Just mod -> extendModuleEnv_C add_item mv_map mod [occ]
720 occ = nameOccName name
721 add_item occs _ = occ:occs
723 depend_on_exports mod = case lookupModuleEnv dir_imp_mods mod of
724 Just (_,no_imp,_) -> not no_imp
727 -- We want to create a Usage for a home module if
728 -- a) we used something from; has something in used_names
729 -- b) we imported all of it, even if we used nothing from it
730 -- (need to recompile if its export list changes: export_vers)
731 -- c) is a home-package orphan or family-instance module (need to
732 -- recompile if its instance decls change: rules_vers)
733 mkUsage :: (ModuleName, IsBootInterface) -> Maybe Usage
734 mkUsage (mod_name, _)
735 | isNothing maybe_iface -- We can't depend on it if we didn't
736 || (null used_occs -- load its interface.
737 && isNothing export_vers
740 = Nothing -- Record no usage info
743 = Just (Usage { usg_name = mod_name,
745 usg_exports = export_vers,
746 usg_entities = fmToList ent_vers,
747 usg_rules = rules_vers })
749 maybe_iface = lookupIfaceByModule dflags hpt pit mod
750 -- In one-shot mode, the interfaces for home-package
751 -- modules accumulate in the PIT not HPT. Sigh.
753 mod = mkModule (thisPackage dflags) mod_name
755 Just iface = maybe_iface
756 orphan_mod = mi_orphan iface
757 finsts_mod = mi_finsts iface
758 version_env = mi_ver_fn iface
759 mod_vers = mi_mod_vers iface
760 rules_vers = mi_rule_vers iface
761 export_vers | depend_on_exports mod = Just (mi_exp_vers iface)
762 | otherwise = Nothing
764 used_occs = lookupModuleEnv ent_map mod `orElse` []
766 -- Making a FiniteMap here ensures that (a) we remove duplicates
767 -- when we have usages on several subordinates of a single parent,
768 -- and (b) that the usages emerge in a canonical order, which
769 -- is why we use FiniteMap rather than OccEnv: FiniteMap works
770 -- using Ord on the OccNames, which is a lexicographic ordering.
771 ent_vers :: FiniteMap OccName Version
772 ent_vers = listToFM (map lookup_occ used_occs)
775 case version_env occ of
776 Nothing -> pprTrace "hmm, strange" (ppr mod <+> ppr occ) $
777 (occ, initialVersion) -- does this ever happen?
778 Just (parent, version) -> (parent, version)
782 mkIfaceExports :: [AvailInfo]
783 -> [(Module, [GenAvailInfo OccName])]
784 -- Group by module and sort by occurrence
785 -- This keeps the list in canonical order
786 mkIfaceExports exports
787 = [ (mod, eltsFM avails)
788 | (mod, avails) <- fmToList groupFM
791 -- Deliberately use FiniteMap rather than UniqFM so we
792 -- get a canonical ordering
793 groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
794 groupFM = foldl add emptyModuleEnv exports
797 = extendModuleEnv_C add_avail env mod (unitFM avail_fs avail_occ)
799 avail_occ = availToOccs avail
800 mod = nameModule (availName avail)
801 avail_fs = occNameFS (availName avail_occ)
802 add_avail avail_fm _ = addToFM avail_fm avail_fs avail_occ
804 availToOccs (Avail n) = Avail (nameOccName n)
805 availToOccs (AvailTC tc ns) = AvailTC (nameOccName tc) (map nameOccName ns)
809 %************************************************************************
811 Load the old interface file for this module (unless
812 we have it aleady), and check whether it is up to date
815 %************************************************************************
818 checkOldIface :: HscEnv
820 -> Bool -- Source unchanged
821 -> Maybe ModIface -- Old interface from compilation manager, if any
822 -> IO (RecompileRequired, Maybe ModIface)
824 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
825 = do { showPass (hsc_dflags hsc_env)
826 ("Checking old interface for " ++
827 showSDoc (ppr (ms_mod mod_summary))) ;
829 ; initIfaceCheck hsc_env $
830 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
833 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
834 = do -- CHECK WHETHER THE SOURCE HAS CHANGED
835 { ifM (not source_unchanged)
836 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
838 -- If the source has changed and we're in interactive mode, avoid reading
839 -- an interface; just return the one we might have been supplied with.
840 ; let dflags = hsc_dflags hsc_env
841 ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
842 return (outOfDate, maybe_iface)
844 case maybe_iface of {
845 Just old_iface -> do -- Use the one we already have
846 { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
847 ; recomp <- checkVersions hsc_env source_unchanged old_iface
848 ; return (recomp, Just old_iface) }
852 -- Try and read the old interface for the current module
853 -- from the .hi file left from the last time we compiled it
854 { let iface_path = msHiFilePath mod_summary
855 ; read_result <- readIface (ms_mod mod_summary) iface_path False
856 ; case read_result of {
857 Failed err -> do -- Old interface file not found, or garbled; give up
858 { traceIf (text "FYI: cannot read old interface file:"
860 ; return (outOfDate, Nothing) }
862 ; Succeeded iface -> do
864 -- We have got the old iface; check its versions
865 { traceIf (text "Read the interface file" <+> text iface_path)
866 ; recomp <- checkVersions hsc_env source_unchanged iface
867 ; returnM (recomp, Just iface)
871 @recompileRequired@ is called from the HscMain. It checks whether
872 a recompilation is required. It needs access to the persistent state,
873 finder, etc, because it may have to load lots of interface files to
874 check their versions.
877 type RecompileRequired = Bool
878 upToDate = False -- Recompile not required
879 outOfDate = True -- Recompile required
881 checkVersions :: HscEnv
882 -> Bool -- True <=> source unchanged
883 -> ModIface -- Old interface
884 -> IfG RecompileRequired
885 checkVersions hsc_env source_unchanged iface
886 | not source_unchanged
889 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
890 ppr (mi_module iface) <> colon)
892 -- Source code unchanged and no errors yet... carry on
894 -- First put the dependent-module info, read from the old interface, into the envt,
895 -- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
897 -- It's just temporary because either the usage check will succeed
898 -- (in which case we are done with this module) or it'll fail (in which
899 -- case we'll compile the module from scratch anyhow).
901 -- We do this regardless of compilation mode, although in --make mode
902 -- all the dependent modules should be in the HPT already, so it's
904 ; updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
906 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
907 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
910 -- This is a bit of a hack really
911 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
912 mod_deps = mkModDeps (dep_mods (mi_deps iface))
914 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
915 -- Given the usage information extracted from the old
916 -- M.hi file for the module being compiled, figure out
917 -- whether M needs to be recompiled.
919 checkModUsage this_pkg (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
920 usg_rules = old_rule_vers,
921 usg_exports = maybe_old_export_vers,
922 usg_entities = old_decl_vers })
923 = -- Load the imported interface is possible
925 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
927 traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_`
930 mod = mkModule this_pkg mod_name
932 loadInterface doc_str mod ImportBySystem `thenM` \ mb_iface ->
933 -- Load the interface, but don't complain on failure;
934 -- Instead, get an Either back which we can test
937 Failed exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"),
939 -- Couldn't find or parse a module mentioned in the
940 -- old interface file. Don't complain -- it might just be that
941 -- the current module doesn't need that import and it's been deleted
945 new_mod_vers = mi_mod_vers iface
946 new_decl_vers = mi_ver_fn iface
947 new_export_vers = mi_exp_vers iface
948 new_rule_vers = mi_rule_vers iface
951 checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile ->
952 if not recompile then
957 if checkExportList maybe_old_export_vers new_export_vers then
958 out_of_date_vers (ptext SLIT(" Export list changed"))
959 (expectJust "checkModUsage" maybe_old_export_vers)
964 if old_rule_vers /= new_rule_vers then
965 out_of_date_vers (ptext SLIT(" Rules changed"))
966 old_rule_vers new_rule_vers
969 -- CHECK ITEMS ONE BY ONE
970 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenM` \ recompile ->
972 returnM outOfDate -- This one failed, so just bail out now
974 up_to_date (ptext SLIT(" Great! The bits I use are up to date"))
977 ------------------------
978 checkModuleVersion old_mod_vers new_mod_vers
979 | new_mod_vers == old_mod_vers
980 = up_to_date (ptext SLIT("Module version unchanged"))
983 = out_of_date_vers (ptext SLIT(" Module version has changed"))
984 old_mod_vers new_mod_vers
986 ------------------------
987 checkExportList Nothing new_vers = upToDate
988 checkExportList (Just v) new_vers = v /= new_vers
990 ------------------------
991 checkEntityUsage new_vers (name,old_vers)
992 = case new_vers name of
994 Nothing -> -- We used it before, but it ain't there now
995 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
997 Just (_, new_vers) -- It's there, but is it up to date?
998 | new_vers == old_vers -> traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenM_`
1000 | otherwise -> out_of_date_vers (ptext SLIT(" Out of date:") <+> ppr name)
1003 up_to_date msg = traceHiDiffs msg `thenM_` returnM upToDate
1004 out_of_date msg = traceHiDiffs msg `thenM_` returnM outOfDate
1005 out_of_date_vers msg old_vers new_vers
1006 = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers])
1008 ----------------------
1009 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1010 -- This helper is used in two places
1011 checkList [] = returnM upToDate
1012 checkList (check:checks) = check `thenM` \ recompile ->
1019 %************************************************************************
1021 Converting things to their Iface equivalents
1023 %************************************************************************
1026 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1027 -- Assumption: the thing is already tidied, so that locally-bound names
1028 -- (lambdas, for-alls) already have non-clashing OccNames
1029 -- Reason: Iface stuff uses OccNames, and the conversion here does
1030 -- not do tidying on the way
1031 tyThingToIfaceDecl (AnId id)
1032 = IfaceId { ifName = getOccName id,
1033 ifType = toIfaceType (idType id),
1036 info = case toIfaceIdInfo (idInfo id) of
1038 items -> HasInfo items
1040 tyThingToIfaceDecl (AClass clas)
1041 = IfaceClass { ifCtxt = toIfaceContext sc_theta,
1042 ifName = getOccName clas,
1043 ifTyVars = toIfaceTvBndrs clas_tyvars,
1044 ifFDs = map toIfaceFD clas_fds,
1045 ifATs = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1046 ifSigs = map toIfaceClassOp op_stuff,
1047 ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
1049 (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1050 = classExtraBigSig clas
1051 tycon = classTyCon clas
1053 toIfaceClassOp (sel_id, def_meth)
1054 = ASSERT(sel_tyvars == clas_tyvars)
1055 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1057 -- Be careful when splitting the type, because of things
1058 -- like class Foo a where
1059 -- op :: (?x :: String) => a -> a
1060 -- and class Baz a where
1061 -- op :: (Ord a) => a -> a
1062 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1063 op_ty = funResultTy rho_ty
1065 toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1067 tyThingToIfaceDecl (ATyCon tycon)
1069 = IfaceSyn { ifName = getOccName tycon,
1070 ifTyVars = toIfaceTvBndrs tyvars,
1071 ifOpenSyn = syn_isOpen,
1072 ifSynRhs = toIfaceType syn_tyki }
1075 = IfaceData { ifName = getOccName tycon,
1076 ifTyVars = toIfaceTvBndrs tyvars,
1077 ifCtxt = toIfaceContext (tyConStupidTheta tycon),
1078 ifCons = ifaceConDecls (algTyConRhs tycon),
1079 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1080 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1081 ifGeneric = tyConHasGenerics tycon,
1082 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1084 | isForeignTyCon tycon
1085 = IfaceForeign { ifName = getOccName tycon,
1086 ifExtName = tyConExtName tycon }
1088 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1090 tyvars = tyConTyVars tycon
1091 (syn_isOpen, syn_tyki) = case synTyConRhs tycon of
1092 OpenSynTyCon ki _ -> (True , ki)
1093 SynonymTyCon ty -> (False, ty)
1095 ifaceConDecls (NewTyCon { data_con = con }) =
1096 IfNewTyCon (ifaceConDecl con)
1097 ifaceConDecls (DataTyCon { data_cons = cons }) =
1098 IfDataTyCon (map ifaceConDecl cons)
1099 ifaceConDecls OpenTyCon { otIsNewtype = False } = IfOpenDataTyCon
1100 ifaceConDecls OpenTyCon { otIsNewtype = True } = IfOpenNewTyCon
1101 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1102 -- The last case happens when a TyCon has been trimmed during tidying
1103 -- Furthermore, tyThingToIfaceDecl is also used
1104 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1105 -- AbstractTyCon case is perfectly sensible.
1107 ifaceConDecl data_con
1108 = IfCon { ifConOcc = getOccName (dataConName data_con),
1109 ifConInfix = dataConIsInfix data_con,
1110 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1111 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1112 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1113 ifConCtxt = toIfaceContext (dataConTheta data_con),
1114 ifConArgTys = map toIfaceType (dataConOrigArgTys data_con),
1115 ifConFields = map getOccName
1116 (dataConFieldLabels data_con),
1117 ifConStricts = dataConStrictMarks data_con }
1119 to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1121 famInstToIface Nothing = Nothing
1122 famInstToIface (Just (famTyCon, instTys)) =
1123 Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1125 tyThingToIfaceDecl (ADataCon dc)
1126 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1129 getFS x = occNameFS (getOccName x)
1131 --------------------------
1132 instanceToIfaceInst :: Instance -> IfaceInst
1133 instanceToIfaceInst ispec@(Instance { is_dfun = dfun_id, is_flag = oflag,
1134 is_cls = cls_name, is_tcs = mb_tcs })
1135 = ASSERT( cls_name == className cls )
1136 IfaceInst { ifDFun = dfun_name,
1138 ifInstCls = cls_name,
1139 ifInstTys = map do_rough mb_tcs,
1142 do_rough Nothing = Nothing
1143 do_rough (Just n) = Just (toIfaceTyCon_name n)
1145 dfun_name = idName dfun_id
1146 mod = nameModule dfun_name
1147 is_local name = nameIsLocalOrFrom mod name
1149 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1150 (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1151 -- Slightly awkward: we need the Class to get the fundeps
1152 (tvs, fds) = classTvsFds cls
1153 arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1154 orph | is_local cls_name = Just (nameOccName cls_name)
1155 | all isJust mb_ns = head mb_ns
1156 | otherwise = Nothing
1158 mb_ns :: [Maybe OccName] -- One for each fundep; a locally-defined name
1159 -- that is not in the "determined" arguments
1160 mb_ns | null fds = [choose_one arg_names]
1161 | otherwise = map do_one fds
1162 do_one (ltvs,rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1163 , not (tv `elem` rtvs)]
1165 choose_one :: [NameSet] -> Maybe OccName
1166 choose_one nss = case nameSetToList (unionManyNameSets nss) of
1168 (n:ns) -> Just (nameOccName n)
1170 --------------------------
1171 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1172 famInstToIfaceFamInst fi@(FamInst { fi_tycon = tycon,
1173 fi_fam = fam, fi_tcs = mb_tcs })
1174 = IfaceFamInst { ifFamInstTyCon = toIfaceTyCon tycon
1175 , ifFamInstFam = fam
1176 , ifFamInstTys = map do_rough mb_tcs }
1178 do_rough Nothing = Nothing
1179 do_rough (Just n) = Just (toIfaceTyCon_name n)
1181 --------------------------
1182 toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
1183 (toIfaceType (idType id))
1186 -- Stripped-down version of tcIfaceIdInfo
1187 -- Change this if you want to export more IdInfo for
1188 -- non-top-level Ids. Don't forget to change
1189 -- CoreTidy.tidyLetBndr too!
1191 -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1193 inline_prag = inlinePragInfo id_info
1194 prag_info | isAlwaysActive inline_prag = NoInfo
1195 | otherwise = HasInfo [HsInline inline_prag]
1197 --------------------------
1198 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1199 toIfaceIdInfo id_info
1200 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1201 inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
1203 ------------ Arity --------------
1204 arity_info = arityInfo id_info
1205 arity_hsinfo | arity_info == 0 = Nothing
1206 | otherwise = Just (HsArity arity_info)
1208 ------------ Caf Info --------------
1209 caf_info = cafInfo id_info
1210 caf_hsinfo = case caf_info of
1211 NoCafRefs -> Just HsNoCafRefs
1214 ------------ Strictness --------------
1215 -- No point in explicitly exporting TopSig
1216 strict_hsinfo = case newStrictnessInfo id_info of
1217 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1220 ------------ Worker --------------
1221 work_info = workerInfo id_info
1222 has_worker = case work_info of { HasWorker _ _ -> True; other -> False }
1223 wrkr_hsinfo = case work_info of
1224 HasWorker work_id wrap_arity ->
1225 Just (HsWorker ((idName work_id)) wrap_arity)
1228 ------------ Unfolding --------------
1229 -- The unfolding is redundant if there is a worker
1230 unfold_info = unfoldingInfo id_info
1231 rhs = unfoldingTemplate unfold_info
1232 no_unfolding = neverUnfold unfold_info
1233 -- The CoreTidy phase retains unfolding info iff
1234 -- we want to expose the unfolding, taking into account
1235 -- unconditional NOINLINE, etc. See TidyPgm.addExternal
1236 unfold_hsinfo | no_unfolding = Nothing
1237 | has_worker = Nothing -- Unfolding is implicit
1238 | otherwise = Just (HsUnfold (toIfaceExpr rhs))
1240 ------------ Inline prag --------------
1241 inline_prag = inlinePragInfo id_info
1242 inline_hsinfo | isAlwaysActive inline_prag = Nothing
1243 | no_unfolding && not has_worker = Nothing
1244 -- If the iface file give no unfolding info, we
1245 -- don't need to say when inlining is OK!
1246 | otherwise = Just (HsInline inline_prag)
1248 --------------------------
1249 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1250 coreRuleToIfaceRule mod (BuiltinRule { ru_fn = fn})
1251 = pprTrace "toHsRule: builtin" (ppr fn) $
1254 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1255 ru_act = act, ru_bndrs = bndrs,
1256 ru_args = args, ru_rhs = rhs })
1257 = IfaceRule { ifRuleName = name, ifActivation = act,
1258 ifRuleBndrs = map toIfaceBndr bndrs,
1260 ifRuleArgs = map do_arg args,
1261 ifRuleRhs = toIfaceExpr rhs,
1264 -- For type args we must remove synonyms from the outermost
1265 -- level. Reason: so that when we read it back in we'll
1266 -- construct the same ru_rough field as we have right now;
1268 do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1269 do_arg arg = toIfaceExpr arg
1271 -- Compute orphanhood. See Note [Orphans] in IfaceSyn
1272 -- A rule is an orphan only if none of the variables
1273 -- mentioned on its left-hand side are locally defined
1274 lhs_names = fn : nameSetToList (exprsFreeNames args)
1275 -- No need to delete bndrs, because
1276 -- exprsFreeNames finds only External names
1278 orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1279 (n:ns) -> Just (nameOccName n)
1282 bogusIfaceRule :: Name -> IfaceRule
1283 bogusIfaceRule id_name
1284 = IfaceRule { ifRuleName = FSLIT("bogus"), ifActivation = NeverActive,
1285 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1286 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1288 ---------------------
1289 toIfaceExpr :: CoreExpr -> IfaceExpr
1290 toIfaceExpr (Var v) = toIfaceVar v
1291 toIfaceExpr (Lit l) = IfaceLit l
1292 toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
1293 toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1294 toIfaceExpr (App f a) = toIfaceApp f [a]
1295 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1296 toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1297 toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceType co)
1298 toIfaceExpr (Note n e) = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1300 ---------------------
1301 toIfaceNote (SCC cc) = IfaceSCC cc
1302 toIfaceNote InlineMe = IfaceInlineMe
1303 toIfaceNote (CoreNote s) = IfaceCoreNote s
1305 ---------------------
1306 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1307 toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1309 ---------------------
1310 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1312 ---------------------
1313 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1314 | otherwise = IfaceDataAlt (getName dc)
1316 tc = dataConTyCon dc
1318 toIfaceCon (LitAlt l) = IfaceLitAlt l
1319 toIfaceCon DEFAULT = IfaceDefault
1321 ---------------------
1322 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1323 toIfaceApp (Var v) as
1324 = case isDataConWorkId_maybe v of
1325 -- We convert the *worker* for tuples into IfaceTuples
1326 Just dc | isTupleTyCon tc && saturated
1327 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1329 val_args = dropWhile isTypeArg as
1330 saturated = val_args `lengthIs` idArity v
1331 tup_args = map toIfaceExpr val_args
1332 tc = dataConTyCon dc
1334 other -> mkIfaceApps (toIfaceVar v) as
1336 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1338 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1340 ---------------------
1341 toIfaceVar :: Id -> IfaceExpr
1343 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1344 -- Foreign calls have special syntax
1345 | isExternalName name = IfaceExt name
1346 | otherwise = IfaceLcl (getFS name)