2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
7 mkUsageInfo, -- Construct the usage info for a module
9 mkIface, -- Build a ModIface from a ModGuts,
10 -- including computing version information
12 writeIfaceFile, -- Write the interface file
14 checkOldIface -- See if recompilation is required, by
15 -- comparing version information
19 -----------------------------------------------
20 MkIface.lhs deals with versioning
21 -----------------------------------------------
23 Here's the version-related info in an interface file
25 module Foo 8 -- module-version
26 3 -- export-list-version
28 Usages: -- Version info for what this compilation of Foo imported
29 Baz 3 -- Module version
30 [4] -- The export-list version if Foo depended on it
31 (g,2) -- Function and its version
32 (T,1) -- Type and its version
34 <version> f :: Int -> Int {- Unfolding: \x -> Wib.t[2] x -}
35 -- The [2] says that f's unfolding
36 -- mentions verison 2 of Wib.t
38 -----------------------------------------------
40 -----------------------------------------------
43 * In the mi_usages information in an interface, we record the
44 version number of each free variable of the module
46 * In mkIface, we compute the version number of each exported thing A.f
47 by comparing its A.f's info with its new info, and bumping its
48 version number if it differs. If A.f mentions B.g, and B.g's version
49 number has changed, then we count A.f as having changed too.
51 * In checkOldIface we compare the mi_usages for the module with
52 the actual version info for all each thing recorded in mi_usages
57 We count A.f as changing if its fixity changes
61 If a rule changes, we want to recompile any module that might be
62 affected by that rule. For non-orphan rules, this is relatively easy.
63 If module M defines f, and a rule for f, just arrange that the version
64 number for M.f changes if any of the rules for M.f change. Any module
65 that does not depend on M.f can't be affected by the rule-change
68 Orphan rules (ones whose 'head function' is not defined in M) are
69 harder. Here's what we do.
71 * We have a per-module orphan-rule version number which changes if
72 any orphan rule changes. (It's unaffected by non-orphan rules.)
74 * We record usage info for any orphan module 'below' this one,
75 giving the orphan-rule version number. We recompile if this
78 The net effect is that if an orphan rule changes, we recompile every
79 module above it. That's very conservative, but it's devilishly hard
80 to know what it might affect, so we just have to be conservative.
84 In an iface file we have
86 instance Eq a => Eq [a] = dfun29
89 We have a version number for dfun29, covering its unfolding
90 etc. Suppose we are compiling a module M that imports A only
91 indirectly. If typechecking M uses this instance decl, we record the
92 dependency on A.dfun29 as if it were a free variable of the module
93 (via the tcg_inst_usages accumulator). That means that A will appear
94 in M's usage list. If the shape of the instance declaration changes,
95 then so will dfun29's version, triggering a recompilation.
97 Adding an instance declaration, or changing an instance decl that is
98 not currently used, is more tricky. (This really only makes a
99 difference when we have overlapping instance decls, because then the
100 new instance decl might kick in to override the old one.) We handle
101 this in a very similar way that we handle rules above.
103 * For non-orphan instance decls, identify one locally-defined tycon/class
104 mentioned in the decl. Treat the instance decl as part of the defn of that
105 tycon/class, so that if the shape of the instance decl changes, so does the
106 tycon/class; that in turn will force recompilation of anything that uses
109 * For orphan instance decls, act the same way as for orphan rules.
110 Indeed, we use the same global orphan-rule version number.
114 mkUsageInfo figures out what the ``usage information'' for this
115 moudule is; that is, what it must record in its interface file as the
118 We produce a line for every module B below the module, A, currently being
121 to record the fact that A does import B indirectly. This is used to decide
122 to look to look for B.hi rather than B.hi-boot when compiling a module that
123 imports A. This line says that A imports B, but uses nothing in it.
124 So we'll get an early bale-out when compiling A if B's version changes.
126 The usage information records:
129 \item (a) anything reachable from its body code
130 \item (b) any module exported with a @module Foo@
131 \item (c) anything reachable from an exported item
134 Why (b)? Because if @Foo@ changes then this module's export list
135 will change, so we must recompile this module at least as far as
136 making a new interface file --- but in practice that means complete
139 Why (c)? Consider this:
141 module A( f, g ) where | module B( f ) where
142 import B( f ) | f = h 3
146 Here, @B.f@ isn't used in A. Should we nevertheless record @B.f@ in
147 @A@'s usages? Our idea is that we aren't going to touch A.hi if it is
148 *identical* to what it was before. If anything about @B.f@ changes
149 than anyone who imports @A@ should be recompiled in case they use
150 @B.f@ (they'll get an early exit if they don't). So, if anything
151 about @B.f@ changes we'd better make sure that something in A.hi
152 changes, and the convenient way to do that is to record the version
153 number @B.f@ in A.hi in the usage list. If B.f changes that'll force a
154 complete recompiation of A, which is overkill but it's the only way to
155 write a new, slightly different, A.hi.
157 But the example is tricker. Even if @B.f@ doesn't change at all,
158 @B.h@ may do so, and this change may not be reflected in @f@'s version
159 number. But with -O, a module that imports A must be recompiled if
160 @B.h@ changes! So A must record a dependency on @B.h@. So we treat
161 the occurrence of @B.f@ in the export list *just as if* it were in the
162 code of A, and thereby haul in all the stuff reachable from it.
164 *** Conclusion: if A mentions B.f in its export list,
165 behave just as if A mentioned B.f in its source code,
166 and slurp in B.f and all its transitive closure ***
168 [NB: If B was compiled with -O, but A isn't, we should really *still*
169 haul in all the unfoldings for B, in case the module that imports A *is*
170 compiled with -O. I think this is the case.]
174 #include "HsVersions.h"
176 import IfaceSyn -- All of it
177 import IfaceType ( toIfaceTvBndrs, toIfaceType, toIfaceContext )
178 import LoadIface ( readIface, loadInterface, pprModIface )
179 import Id ( Id, idName, idType, idInfo, idArity, isDataConWorkId_maybe, isFCallId_maybe )
180 import IdInfo ( IdInfo, CafInfo(..), WorkerInfo(..),
181 arityInfo, cafInfo, newStrictnessInfo,
182 workerInfo, unfoldingInfo, inlinePragInfo )
183 import NewDemand ( isTopSig )
185 import Class ( classExtraBigSig, classTyCon )
186 import TyCon ( TyCon, AlgTyConRhs(..), isRecursiveTyCon, isForeignTyCon,
187 isSynTyCon, isAlgTyCon, isPrimTyCon, isFunTyCon,
188 isTupleTyCon, tupleTyConBoxity, tyConStupidTheta,
189 tyConHasGenerics, tyConArgVrcs, synTyConRhs, isGadtSyntaxTyCon,
190 tyConArity, tyConTyVars, algTyConRhs, tyConExtName )
191 import DataCon ( dataConName, dataConFieldLabels, dataConStrictMarks,
192 dataConTyCon, dataConIsInfix, dataConUnivTyVars, dataConExTyVars, dataConEqSpec,
193 dataConTheta, dataConOrigArgTys )
194 import Type ( TyThing(..), splitForAllTys, funResultTy )
195 import TcType ( deNoteType )
196 import TysPrim ( alphaTyVars )
197 import InstEnv ( Instance(..) )
199 import HscTypes ( ModIface(..), ModDetails(..),
200 ModGuts(..), HscEnv(..), hscEPS, Dependencies(..), FixItem(..),
201 ModSummary(..), msHiFilePath,
202 mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
204 GenAvailInfo(..), availName,
205 ExternalPackageState(..),
206 Usage(..), IsBootInterface,
207 Deprecs(..), IfaceDeprecs, Deprecations,
212 import DynFlags ( GhcMode(..), DynFlags(..), DynFlag(..), dopt )
213 import Name ( Name, nameModule, nameOccName, nameParent,
214 isExternalName, isInternalName, nameParent_maybe, isWiredInName,
215 isImplicitName, NamedThing(..) )
218 import OccName ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
220 OccSet, emptyOccSet, elemOccSet, occSetElts,
221 extendOccSet, extendOccSetList,
222 isEmptyOccSet, intersectOccSet, intersectsOccSet,
226 import BasicTypes ( Version, initialVersion, bumpVersion, isAlwaysActive,
227 Activation(..), RecFlag(..), boolToRecFlag )
229 import Util ( createDirectoryHierarchy, directoryOf, sortLe, seqList, lengthIs )
230 import BinIface ( writeBinIface )
231 import Unique ( Unique, Uniquable(..) )
232 import ErrUtils ( dumpIfSet_dyn, showPass )
233 import Digraph ( stronglyConnComp, SCC(..) )
234 import SrcLoc ( SrcSpan )
236 import PackageConfig ( PackageId )
240 import Monad ( when )
241 import List ( insert )
242 import Maybes ( orElse, mapCatMaybes, isNothing, isJust,
243 expectJust, catMaybes, MaybeErr(..) )
248 %************************************************************************
250 \subsection{Completing an interface}
252 %************************************************************************
256 -> Maybe ModIface -- The old interface, if we have it
257 -> ModGuts -- Usages, deprecations, etc
258 -> ModDetails -- The trimmed, tidied interface
259 -> IO (ModIface, -- The new one, complete with decls and versions
260 Bool) -- True <=> there was an old Iface, and the new one
261 -- is identical, so no need to write it
263 mkIface hsc_env maybe_old_iface
264 (ModGuts{ mg_module = this_mod,
268 mg_rdr_env = rdr_env,
269 mg_fix_env = fix_env,
270 mg_deprecs = src_deprecs })
271 (ModDetails{ md_insts = insts,
274 md_exports = exports })
276 -- NB: notice that mkIface does not look at the bindings
277 -- only at the TypeEnv. The previous Tidy phase has
278 -- put exactly the info into the TypeEnv that we want
279 -- to expose in the interface
281 = do { eps <- hscEPS hsc_env
282 ; let { ext_nm_rhs = mkExtNameFn hsc_env eps this_mod
283 ; ext_nm_lhs = mkLhsNameFn this_mod
285 ; decls = [ tyThingToIfaceDecl ext_nm_rhs thing
286 | thing <- typeEnvElts type_env,
287 let name = getName thing,
288 not (isImplicitName name || isWiredInName name) ]
289 -- Don't put implicit Ids and class tycons in the interface file
290 -- Nor wired-in things; the compiler knows about them anyhow
292 ; fixities = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
293 ; deprecs = mkIfaceDeprec src_deprecs
294 ; iface_rules = map (coreRuleToIfaceRule ext_nm_lhs ext_nm_rhs) rules
295 ; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts
297 ; intermediate_iface = ModIface {
298 mi_module = this_mod,
302 mi_exports = mkIfaceExports exports,
303 mi_insts = sortLe le_inst iface_insts,
304 mi_rules = sortLe le_rule iface_rules,
305 mi_fixities = fixities,
306 mi_deprecs = deprecs,
307 mi_globals = Just rdr_env,
309 -- Left out deliberately: filled in by addVersionInfo
310 mi_mod_vers = initialVersion,
311 mi_exp_vers = initialVersion,
312 mi_rule_vers = initialVersion,
313 mi_orphan = False, -- Always set by addVersionInfo, but
314 -- it's a strict field, so we can't omit it.
315 mi_decls = deliberatelyOmitted "decls",
316 mi_ver_fn = deliberatelyOmitted "ver_fn",
318 -- And build the cached values
319 mi_dep_fn = mkIfaceDepCache deprecs,
320 mi_fix_fn = mkIfaceFixCache fixities }
322 -- Add version information
323 ; (new_iface, no_change_at_all, pp_diffs, pp_orphs)
324 = _scc_ "versioninfo"
325 addVersionInfo maybe_old_iface intermediate_iface decls
329 ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags)
330 (printDump (expectJust "mkIface" pp_orphs))
331 ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
332 ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
333 (pprModIface new_iface)
335 ; return (new_iface, no_change_at_all) }
337 r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
338 i1 `le_inst` i2 = ifDFun i1 <= ifDFun i2
340 dflags = hsc_dflags hsc_env
341 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
344 -----------------------------
345 writeIfaceFile :: ModLocation -> ModIface -> IO ()
346 writeIfaceFile location new_iface
347 = do createDirectoryHierarchy (directoryOf hi_file_path)
348 writeBinIface hi_file_path new_iface
349 where hi_file_path = ml_hi_file location
352 -----------------------------
353 mkExtNameFn :: HscEnv -> ExternalPackageState -> Module -> Name -> IfaceExtName
354 mkExtNameFn hsc_env eps this_mod
357 hpt = hsc_HPT hsc_env
361 | mod == this_mod = case nameParent_maybe name of
362 Nothing -> LocalTop occ
363 Just par -> LocalTopSub occ (nameOccName par)
364 | isWiredInName name = ExtPkg mod occ
365 | is_home mod = HomePkg mod_name occ vers
366 | otherwise = ExtPkg mod occ
368 dflags = hsc_dflags hsc_env
369 this_pkg = thisPackage dflags
370 is_home mod = modulePackageId mod == this_pkg
372 mod = nameModule name
373 mod_name = moduleName mod
374 occ = nameOccName name
375 par_occ = nameOccName (nameParent name)
376 -- The version of the *parent* is the one want
377 vers = lookupVersion mod par_occ
379 lookupVersion :: Module -> OccName -> Version
380 -- Even though we're looking up a home-package thing, in
381 -- one-shot mode the imported interfaces may be in the PIT
382 lookupVersion mod occ
383 = mi_ver_fn iface occ `orElse`
384 pprPanic "lookupVers1" (ppr mod <+> ppr occ)
386 iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
387 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
390 ---------------------
391 -- mkLhsNameFn ignores versioning info altogether
392 -- It is used for the LHS of instance decls and rules, where we
393 -- there's no point in recording version info
394 mkLhsNameFn :: Module -> Name -> IfaceExtName
395 mkLhsNameFn this_mod name
396 | isInternalName name = pprTrace "mkLhsNameFn: unexpected internal" (ppr name) $
397 LocalTop occ -- Should not happen
398 | mod == this_mod = LocalTop occ
399 | otherwise = ExtPkg mod occ
401 mod = nameModule name
402 occ = nameOccName name
405 -----------------------------
406 -- Compute version numbers for local decls
408 addVersionInfo :: Maybe ModIface -- The old interface, read from M.hi
409 -> ModIface -- The new interface decls (lacking decls)
410 -> [IfaceDecl] -- The new decls
412 Bool, -- True <=> no changes at all; no need to write new Iface
414 Maybe SDoc) -- Warnings about orphans
416 addVersionInfo Nothing new_iface new_decls
417 -- No old interface, so definitely write a new one!
418 = (new_iface { mi_orphan = anyNothing ifInstOrph (mi_insts new_iface)
419 || anyNothing ifRuleOrph (mi_rules new_iface),
420 mi_decls = [(initialVersion, decl) | decl <- new_decls],
421 mi_ver_fn = \n -> Just initialVersion },
423 ptext SLIT("No old interface file"),
424 pprOrphans orph_insts orph_rules)
426 orph_insts = filter (isNothing . ifInstOrph) (mi_insts new_iface)
427 orph_rules = filter (isNothing . ifRuleOrph) (mi_rules new_iface)
429 addVersionInfo (Just old_iface@(ModIface { mi_mod_vers = old_mod_vers,
430 mi_exp_vers = old_exp_vers,
431 mi_rule_vers = old_rule_vers,
432 mi_decls = old_decls,
433 mi_ver_fn = old_decl_vers,
434 mi_fix_fn = old_fixities }))
435 new_iface@(ModIface { mi_fix_fn = new_fixities })
438 | no_change_at_all = (old_iface, True, ptext SLIT("Interface file unchanged"), pp_orphs)
439 | otherwise = (final_iface, False, vcat [ptext SLIT("Interface file has changed"),
440 nest 2 pp_diffs], pp_orphs)
442 final_iface = new_iface { mi_mod_vers = bump_unless no_output_change old_mod_vers,
443 mi_exp_vers = bump_unless no_export_change old_exp_vers,
444 mi_rule_vers = bump_unless no_rule_change old_rule_vers,
445 mi_orphan = not (null new_orph_rules && null new_orph_insts),
446 mi_decls = decls_w_vers,
447 mi_ver_fn = mkIfaceVerCache decls_w_vers }
449 decls_w_vers = [(add_vers decl, decl) | decl <- new_decls]
452 (old_non_orph_insts, old_orph_insts) = mkOrphMap ifInstOrph (mi_insts old_iface)
453 (new_non_orph_insts, new_orph_insts) = mkOrphMap ifInstOrph (mi_insts new_iface)
454 same_insts occ = eqMaybeBy (eqListBy eqIfInst)
455 (lookupOccEnv old_non_orph_insts occ)
456 (lookupOccEnv new_non_orph_insts occ)
458 (old_non_orph_rules, old_orph_rules) = mkOrphMap ifRuleOrph (mi_rules old_iface)
459 (new_non_orph_rules, new_orph_rules) = mkOrphMap ifRuleOrph (mi_rules new_iface)
460 same_rules occ = eqMaybeBy (eqListBy eqIfRule)
461 (lookupOccEnv old_non_orph_rules occ)
462 (lookupOccEnv new_non_orph_rules occ)
464 -- Computing what changed
465 no_output_change = no_decl_change && no_rule_change &&
466 no_export_change && no_deprec_change
467 no_export_change = mi_exports new_iface == mi_exports old_iface -- Kept sorted
468 no_decl_change = isEmptyOccSet changed_occs
469 no_rule_change = not (changedWrt changed_occs (eqListBy eqIfRule old_orph_rules new_orph_rules)
470 || changedWrt changed_occs (eqListBy eqIfInst old_orph_insts new_orph_insts))
471 no_deprec_change = mi_deprecs new_iface == mi_deprecs old_iface
473 -- If the usages havn't changed either, we don't need to write the interface file
474 no_other_changes = mi_usages new_iface == mi_usages old_iface &&
475 mi_deps new_iface == mi_deps old_iface
476 no_change_at_all = no_output_change && no_other_changes
478 pp_diffs = vcat [pp_change no_export_change "Export list"
479 (ppr old_exp_vers <+> arrow <+> ppr (mi_exp_vers final_iface)),
480 pp_change no_rule_change "Rules"
481 (ppr old_rule_vers <+> arrow <+> ppr (mi_rule_vers final_iface)),
482 pp_change no_deprec_change "Deprecations" empty,
483 pp_change no_other_changes "Usages" empty,
485 pp_change True what info = empty
486 pp_change False what info = text what <+> ptext SLIT("changed") <+> info
489 old_decl_env = mkOccEnv [(ifName decl, decl) | (_,decl) <- old_decls]
490 same_fixity n = bool (old_fixities n == new_fixities n)
493 -- Adding version info
494 new_version = bumpVersion old_mod_vers -- Start from the old module version, not from zero
495 -- so that if you remove f, and then add it again,
496 -- you don't thereby reduce f's version number
497 add_vers decl | occ `elemOccSet` changed_occs = new_version
498 | otherwise = expectJust "add_vers" (old_decl_vers occ)
499 -- If it's unchanged, there jolly well
500 where -- should be an old version number
504 changed_occs :: OccSet
505 changed_occs = computeChangedOccs eq_info
507 eq_info :: [(OccName, IfaceEq)]
508 eq_info = map check_eq new_decls
509 check_eq new_decl | Just old_decl <- lookupOccEnv old_decl_env occ
510 = (occ, new_decl `eqIfDecl` old_decl &&&
511 eq_indirects new_decl)
512 | otherwise {- No corresponding old decl -}
515 occ = ifName new_decl
517 eq_indirects :: IfaceDecl -> IfaceEq
518 -- When seeing if two decls are the same, remember to
519 -- check whether any relevant fixity or rules have changed
520 eq_indirects (IfaceId {ifName = occ}) = eq_ind_occ occ
521 eq_indirects (IfaceClass {ifName = cls_occ, ifSigs = sigs})
522 = same_insts cls_occ &&&
523 eq_ind_occs [op | IfaceClassOp op _ _ <- sigs]
524 eq_indirects (IfaceData {ifName = tc_occ, ifCons = cons})
525 = same_insts tc_occ &&& same_fixity tc_occ &&& -- The TyCon can have a fixity too
526 eq_ind_occs (map ifConOcc (visibleIfConDecls cons))
527 eq_indirects other = Equal -- Synonyms and foreign declarations
529 eq_ind_occ :: OccName -> IfaceEq -- For class ops and Ids; check fixity and rules
530 eq_ind_occ occ = same_fixity occ &&& same_rules occ
531 eq_ind_occs = foldr ((&&&) . eq_ind_occ) Equal
535 pp_decl_diffs :: SDoc -- Nothing => no changes
537 | isEmptyOccSet changed_occs = empty
539 = vcat [ptext SLIT("Changed occs:") <+> ppr (occSetElts changed_occs),
540 ptext SLIT("Version change for these decls:"),
541 nest 2 (vcat (map show_change new_decls))]
543 eq_env = mkOccEnv eq_info
545 | not (occ `elemOccSet` changed_occs) = empty
547 = vcat [ppr occ <+> ppr (old_decl_vers occ) <+> arrow <+> ppr new_version,
550 occ = ifName new_decl
551 why = case lookupOccEnv eq_env occ of
552 Just (EqBut occs) -> sep [ppr occ <> colon, ptext SLIT("Free vars (only) changed:"),
553 nest 2 (braces (fsep (map ppr (occSetElts
554 (occs `intersectOccSet` changed_occs)))))]
556 | Just old_decl <- lookupOccEnv old_decl_env occ
557 -> vcat [ptext SLIT("Old:") <+> ppr old_decl,
558 ptext SLIT("New:") <+> ppr new_decl]
560 -> ppr occ <+> ptext SLIT("only in new interface")
561 other -> pprPanic "MkIface.show_change" (ppr occ)
563 pp_orphs = pprOrphans new_orph_insts new_orph_rules
565 pprOrphans insts rules
566 | null insts && null rules = Nothing
569 if null insts then empty else
570 hang (ptext SLIT("Warning: orphan instances:"))
571 2 (vcat (map ppr insts)),
572 if null rules then empty else
573 hang (ptext SLIT("Warning: orphan rules:"))
574 2 (vcat (map ppr rules))
577 computeChangedOccs :: [(OccName, IfaceEq)] -> OccSet
578 computeChangedOccs eq_info
579 = foldl add_changes emptyOccSet (stronglyConnComp edges)
581 edges :: [((OccName,IfaceEq), Unique, [Unique])]
582 edges = [ (node, getUnique occ, map getUnique occs)
583 | node@(occ, iface_eq) <- eq_info
584 , let occs = case iface_eq of
585 EqBut occ_set -> occSetElts occ_set
588 -- Changes in declarations
589 add_changes :: OccSet -> SCC (OccName, IfaceEq) -> OccSet
590 add_changes so_far (AcyclicSCC (occ, iface_eq))
591 | changedWrt so_far iface_eq -- This one has changed
592 = extendOccSet so_far occ
593 add_changes so_far (CyclicSCC pairs)
594 | changedWrt so_far (foldr1 (&&&) (map snd pairs)) -- One of this group has changed
595 = extendOccSetList so_far (map fst pairs)
596 add_changes so_far other = so_far
598 changedWrt :: OccSet -> IfaceEq -> Bool
599 changedWrt so_far Equal = False
600 changedWrt so_far NotEqual = True
601 changedWrt so_far (EqBut kids) = so_far `intersectsOccSet` kids
603 ----------------------
604 -- mkOrphMap partitions instance decls or rules into
605 -- (a) an OccEnv for ones that are not orphans,
606 -- mapping the local OccName to a list of its decls
607 -- (b) a list of orphan decls
608 mkOrphMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ
609 -- Nothing for an orphan decl
610 -> [decl] -- Sorted into canonical order
611 -> (OccEnv [decl], -- Non-orphan decls associated with their key;
612 -- each sublist in canonical order
613 [decl]) -- Orphan decls; in canonical order
614 mkOrphMap get_key decls
615 = foldl go (emptyOccEnv, []) decls
617 go (non_orphs, orphs) d
618 | Just occ <- get_key d
619 = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
620 | otherwise = (non_orphs, d:orphs)
622 anyNothing :: (a -> Maybe b) -> [a] -> Bool
623 anyNothing p [] = False
624 anyNothing p (x:xs) = isNothing (p x) || anyNothing p xs
626 ----------------------
627 mkIfaceDeprec :: Deprecations -> IfaceDeprecs
628 mkIfaceDeprec NoDeprecs = NoDeprecs
629 mkIfaceDeprec (DeprecAll t) = DeprecAll t
630 mkIfaceDeprec (DeprecSome env) = DeprecSome (sortLe (<=) (nameEnvElts env))
632 ----------------------
633 bump_unless :: Bool -> Version -> Version
634 bump_unless True v = v -- True <=> no change
635 bump_unless False v = bumpVersion v
639 %*********************************************************
641 \subsection{Keeping track of what we've slurped, and version numbers}
643 %*********************************************************
647 mkUsageInfo :: HscEnv
648 -> ModuleEnv (Module, Bool, SrcSpan)
649 -> [(ModuleName, IsBootInterface)]
650 -> NameSet -> IO [Usage]
651 mkUsageInfo hsc_env dir_imp_mods dep_mods used_names
652 = do { eps <- hscEPS hsc_env
653 ; let usages = mk_usage_info (eps_PIT eps) hsc_env
654 dir_imp_mods dep_mods used_names
655 ; usages `seqList` return usages }
656 -- seq the list of Usages returned: occasionally these
657 -- don't get evaluated for a while and we can end up hanging on to
658 -- the entire collection of Ifaces.
660 mk_usage_info pit hsc_env dir_imp_mods dep_mods proto_used_names
661 = mapCatMaybes mkUsage dep_mods
662 -- ToDo: do we need to sort into canonical order?
664 hpt = hsc_HPT hsc_env
665 dflags = hsc_dflags hsc_env
667 used_names = mkNameSet $ -- Eliminate duplicates
668 [ nameParent n -- Just record usage on the 'main' names
669 | n <- nameSetToList proto_used_names
670 , not (isWiredInName n) -- Don't record usages for wired-in names
671 , isExternalName n -- Ignore internal names
674 -- ent_map groups together all the things imported and used
675 -- from a particular module in this package
676 ent_map :: ModuleEnv [OccName]
677 ent_map = foldNameSet add_mv emptyModuleEnv used_names
678 add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [occ]
680 occ = nameOccName name
681 mod = nameModule name
682 add_item occs _ = occ:occs
684 depend_on_exports mod = case lookupModuleEnv dir_imp_mods mod of
685 Just (_,no_imp,_) -> not no_imp
688 -- We want to create a Usage for a home module if
689 -- a) we used something from; has something in used_names
690 -- b) we imported all of it, even if we used nothing from it
691 -- (need to recompile if its export list changes: export_vers)
692 -- c) is a home-package orphan module (need to recompile if its
693 -- instance decls change: rules_vers)
694 mkUsage :: (ModuleName, IsBootInterface) -> Maybe Usage
695 mkUsage (mod_name, _)
696 | isNothing maybe_iface -- We can't depend on it if we didn't
697 || (null used_occs -- load its interface.
698 && isNothing export_vers
700 = Nothing -- Record no usage info
703 = Just (Usage { usg_name = mod_name,
705 usg_exports = export_vers,
706 usg_entities = ent_vers,
707 usg_rules = rules_vers })
709 maybe_iface = lookupIfaceByModule dflags hpt pit mod
710 -- In one-shot mode, the interfaces for home-package
711 -- modules accumulate in the PIT not HPT. Sigh.
713 mod = mkModule (thisPackage dflags) mod_name
715 Just iface = maybe_iface
716 orphan_mod = mi_orphan iface
717 version_env = mi_ver_fn iface
718 mod_vers = mi_mod_vers iface
719 rules_vers = mi_rule_vers iface
720 export_vers | depend_on_exports mod = Just (mi_exp_vers iface)
721 | otherwise = Nothing
723 -- The sort is to put them into canonical order
724 used_occs = lookupModuleEnv ent_map mod `orElse` []
725 ent_vers :: [(OccName,Version)]
726 ent_vers = [ (occ, version_env occ `orElse` initialVersion)
727 | occ <- sortLe (<=) used_occs]
731 mkIfaceExports :: NameSet -> [(Module, [GenAvailInfo OccName])]
732 -- Group by module and sort by occurrence
733 -- This keeps the list in canonical order
734 mkIfaceExports exports
735 = [ (mod, eltsUFM avails)
736 | (mod, avails) <- fmToList groupFM
739 groupFM :: ModuleEnv (UniqFM (GenAvailInfo OccName))
740 -- Deliberately use the FastString so we
741 -- get a canonical ordering
742 groupFM = foldl add emptyModuleEnv (nameSetToList exports)
744 add env name = extendModuleEnv_C add_avail env mod
745 (unitUFM avail_fs avail)
747 occ = nameOccName name
748 mod = nameModule name
749 avail | Just p <- nameParent_maybe name = AvailTC (nameOccName p) [occ]
750 | isTcOcc occ = AvailTC occ [occ]
751 | otherwise = Avail occ
752 avail_fs = occNameFS (availName avail)
753 add_avail avail_fm _ = addToUFM_C add_item avail_fm avail_fs avail
755 add_item (AvailTC p occs) _ = AvailTC p (List.insert occ occs)
756 add_item (Avail n) _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name)
760 %************************************************************************
762 Load the old interface file for this module (unless
763 we have it aleady), and check whether it is up to date
766 %************************************************************************
769 checkOldIface :: HscEnv
771 -> Bool -- Source unchanged
772 -> Maybe ModIface -- Old interface from compilation manager, if any
773 -> IO (RecompileRequired, Maybe ModIface)
775 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
776 = do { showPass (hsc_dflags hsc_env)
777 ("Checking old interface for " ++
778 showSDoc (ppr (ms_mod mod_summary))) ;
780 ; initIfaceCheck hsc_env $
781 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
784 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
785 = -- CHECK WHETHER THE SOURCE HAS CHANGED
786 ifM (not source_unchanged)
787 (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
790 -- If the source has changed and we're in interactive mode, avoid reading
791 -- an interface; just return the one we might have been supplied with.
792 getGhcMode `thenM` \ ghc_mode ->
793 if (ghc_mode == Interactive || ghc_mode == JustTypecheck)
794 && not source_unchanged then
795 returnM (outOfDate, maybe_iface)
798 case maybe_iface of {
799 Just old_iface -> do -- Use the one we already have
800 recomp <- checkVersions hsc_env source_unchanged old_iface
801 return (recomp, Just old_iface)
805 -- Try and read the old interface for the current module
806 -- from the .hi file left from the last time we compiled it
808 iface_path = msHiFilePath mod_summary
810 readIface (ms_mod mod_summary) iface_path False `thenM` \ read_result ->
811 case read_result of {
812 Failed err -> -- Old interface file not found, or garbled; give up
813 traceIf (text "FYI: cannot read old interface file:"
814 $$ nest 4 err) `thenM_`
815 returnM (outOfDate, Nothing)
819 -- We have got the old iface; check its versions
820 checkVersions hsc_env source_unchanged iface `thenM` \ recomp ->
821 returnM (recomp, Just iface)
825 @recompileRequired@ is called from the HscMain. It checks whether
826 a recompilation is required. It needs access to the persistent state,
827 finder, etc, because it may have to load lots of interface files to
828 check their versions.
831 type RecompileRequired = Bool
832 upToDate = False -- Recompile not required
833 outOfDate = True -- Recompile required
835 checkVersions :: HscEnv
836 -> Bool -- True <=> source unchanged
837 -> ModIface -- Old interface
838 -> IfG RecompileRequired
839 checkVersions hsc_env source_unchanged iface
840 | not source_unchanged
843 = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
844 ppr (mi_module iface) <> colon)
846 -- Source code unchanged and no errors yet... carry on
848 -- First put the dependent-module info, read from the old interface, into the envt,
849 -- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
851 -- It's just temporary because either the usage check will succeed
852 -- (in which case we are done with this module) or it'll fail (in which
853 -- case we'll compile the module from scratch anyhow).
855 -- We do this regardless of compilation mode
856 ; updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
858 ; let this_pkg = thisPackage (hsc_dflags hsc_env)
859 ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
862 -- This is a bit of a hack really
863 mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
864 mod_deps = mkModDeps (dep_mods (mi_deps iface))
866 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
867 -- Given the usage information extracted from the old
868 -- M.hi file for the module being compiled, figure out
869 -- whether M needs to be recompiled.
871 checkModUsage this_pkg (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
872 usg_rules = old_rule_vers,
873 usg_exports = maybe_old_export_vers,
874 usg_entities = old_decl_vers })
875 = -- Load the imported interface is possible
877 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
879 traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_`
882 mod = mkModule this_pkg mod_name
884 loadInterface doc_str mod ImportBySystem `thenM` \ mb_iface ->
885 -- Load the interface, but don't complain on failure;
886 -- Instead, get an Either back which we can test
889 Failed exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"),
891 -- Couldn't find or parse a module mentioned in the
892 -- old interface file. Don't complain -- it might just be that
893 -- the current module doesn't need that import and it's been deleted
897 new_mod_vers = mi_mod_vers iface
898 new_decl_vers = mi_ver_fn iface
899 new_export_vers = mi_exp_vers iface
900 new_rule_vers = mi_rule_vers iface
903 checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile ->
904 if not recompile then
909 if checkExportList maybe_old_export_vers new_export_vers then
910 out_of_date_vers (ptext SLIT(" Export list changed"))
911 (expectJust "checkModUsage" maybe_old_export_vers)
916 if old_rule_vers /= new_rule_vers then
917 out_of_date_vers (ptext SLIT(" Rules changed"))
918 old_rule_vers new_rule_vers
921 -- CHECK ITEMS ONE BY ONE
922 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenM` \ recompile ->
924 returnM outOfDate -- This one failed, so just bail out now
926 up_to_date (ptext SLIT(" Great! The bits I use are up to date"))
929 ------------------------
930 checkModuleVersion old_mod_vers new_mod_vers
931 | new_mod_vers == old_mod_vers
932 = up_to_date (ptext SLIT("Module version unchanged"))
935 = out_of_date_vers (ptext SLIT(" Module version has changed"))
936 old_mod_vers new_mod_vers
938 ------------------------
939 checkExportList Nothing new_vers = upToDate
940 checkExportList (Just v) new_vers = v /= new_vers
942 ------------------------
943 checkEntityUsage new_vers (name,old_vers)
944 = case new_vers name of
946 Nothing -> -- We used it before, but it ain't there now
947 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
949 Just new_vers -- It's there, but is it up to date?
950 | new_vers == old_vers -> traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenM_`
952 | otherwise -> out_of_date_vers (ptext SLIT(" Out of date:") <+> ppr name)
955 up_to_date msg = traceHiDiffs msg `thenM_` returnM upToDate
956 out_of_date msg = traceHiDiffs msg `thenM_` returnM outOfDate
957 out_of_date_vers msg old_vers new_vers
958 = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers])
960 ----------------------
961 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
962 -- This helper is used in two places
963 checkList [] = returnM upToDate
964 checkList (check:checks) = check `thenM` \ recompile ->
971 %************************************************************************
973 Converting things to their Iface equivalents
975 %************************************************************************
978 tyThingToIfaceDecl :: (Name -> IfaceExtName) -> TyThing -> IfaceDecl
979 -- Assumption: the thing is already tidied, so that locally-bound names
980 -- (lambdas, for-alls) already have non-clashing OccNames
981 -- Reason: Iface stuff uses OccNames, and the conversion here does
982 -- not do tidying on the way
983 tyThingToIfaceDecl ext (AnId id)
984 = IfaceId { ifName = getOccName id,
985 ifType = toIfaceType ext (idType id),
988 info = case toIfaceIdInfo ext (idInfo id) of
990 items -> HasInfo items
992 tyThingToIfaceDecl ext (AClass clas)
993 = IfaceClass { ifCtxt = toIfaceContext ext sc_theta,
994 ifName = getOccName clas,
995 ifTyVars = toIfaceTvBndrs clas_tyvars,
996 ifFDs = map toIfaceFD clas_fds,
997 ifSigs = map toIfaceClassOp op_stuff,
998 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
999 ifVrcs = tyConArgVrcs tycon }
1001 (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
1002 tycon = classTyCon clas
1004 toIfaceClassOp (sel_id, def_meth)
1005 = ASSERT(sel_tyvars == clas_tyvars)
1006 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType ext op_ty)
1008 -- Be careful when splitting the type, because of things
1009 -- like class Foo a where
1010 -- op :: (?x :: String) => a -> a
1011 -- and class Baz a where
1012 -- op :: (Ord a) => a -> a
1013 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1014 op_ty = funResultTy rho_ty
1016 toIfaceFD (tvs1, tvs2) = (map (occNameFS.getOccName) tvs1, map (occNameFS.getOccName) tvs2)
1018 tyThingToIfaceDecl ext (ATyCon tycon)
1020 = IfaceSyn { ifName = getOccName tycon,
1021 ifTyVars = toIfaceTvBndrs tyvars,
1022 ifVrcs = tyConArgVrcs tycon,
1023 ifSynRhs = toIfaceType ext syn_ty }
1026 = IfaceData { ifName = getOccName tycon,
1027 ifTyVars = toIfaceTvBndrs tyvars,
1028 ifCtxt = toIfaceContext ext (tyConStupidTheta tycon),
1029 ifCons = ifaceConDecls (algTyConRhs tycon),
1030 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
1031 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1032 ifVrcs = tyConArgVrcs tycon,
1033 ifGeneric = tyConHasGenerics tycon }
1035 | isForeignTyCon tycon
1036 = IfaceForeign { ifName = getOccName tycon,
1037 ifExtName = tyConExtName tycon }
1039 | isPrimTyCon tycon || isFunTyCon tycon
1040 -- Needed in GHCi for ':info Int#', for example
1041 = IfaceData { ifName = getOccName tycon,
1042 ifTyVars = toIfaceTvBndrs (take (tyConArity tycon) alphaTyVars),
1044 ifCons = IfAbstractTyCon,
1045 ifGadtSyntax = False,
1047 ifRec = NonRecursive,
1048 ifVrcs = tyConArgVrcs tycon }
1050 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1052 tyvars = tyConTyVars tycon
1053 syn_ty = synTyConRhs tycon
1055 ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con)
1056 ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
1057 ifaceConDecls AbstractTyCon = IfAbstractTyCon
1058 -- The last case happens when a TyCon has been trimmed during tidying
1059 -- Furthermore, tyThingToIfaceDecl is also used
1060 -- in TcRnDriver for GHCi, when browsing a module, in which case the
1061 -- AbstractTyCon case is perfectly sensible.
1063 ifaceConDecl data_con
1064 = IfCon { ifConOcc = getOccName (dataConName data_con),
1065 ifConInfix = dataConIsInfix data_con,
1066 ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1067 ifConExTvs = toIfaceTvBndrs (dataConExTyVars data_con),
1068 ifConEqSpec = to_eq_spec (dataConEqSpec data_con),
1069 ifConCtxt = toIfaceContext ext (dataConTheta data_con),
1070 ifConArgTys = map (toIfaceType ext) (dataConOrigArgTys data_con),
1071 ifConFields = map getOccName (dataConFieldLabels data_con),
1072 ifConStricts = dataConStrictMarks data_con }
1074 to_eq_spec spec = [(getOccName tv, toIfaceType ext ty) | (tv,ty) <- spec]
1076 tyThingToIfaceDecl ext (ADataCon dc)
1077 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
1080 --------------------------
1081 instanceToIfaceInst :: (Name -> IfaceExtName) -> Instance -> IfaceInst
1082 instanceToIfaceInst ext_lhs ispec@(Instance { is_dfun = dfun_id, is_flag = oflag,
1083 is_cls = cls, is_tcs = mb_tcs,
1085 = IfaceInst { ifDFun = getOccName dfun_id,
1087 ifInstCls = ext_lhs cls,
1088 ifInstTys = map do_rough mb_tcs,
1091 do_rough Nothing = Nothing
1092 do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
1094 --------------------------
1095 toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
1096 toIfaceIdInfo ext id_info
1097 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1098 inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
1100 ------------ Arity --------------
1101 arity_info = arityInfo id_info
1102 arity_hsinfo | arity_info == 0 = Nothing
1103 | otherwise = Just (HsArity arity_info)
1105 ------------ Caf Info --------------
1106 caf_info = cafInfo id_info
1107 caf_hsinfo = case caf_info of
1108 NoCafRefs -> Just HsNoCafRefs
1111 ------------ Strictness --------------
1112 -- No point in explicitly exporting TopSig
1113 strict_hsinfo = case newStrictnessInfo id_info of
1114 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1117 ------------ Worker --------------
1118 work_info = workerInfo id_info
1119 has_worker = case work_info of { HasWorker _ _ -> True; other -> False }
1120 wrkr_hsinfo = case work_info of
1121 HasWorker work_id wrap_arity ->
1122 Just (HsWorker (ext (idName work_id)) wrap_arity)
1125 ------------ Unfolding --------------
1126 -- The unfolding is redundant if there is a worker
1127 unfold_info = unfoldingInfo id_info
1128 rhs = unfoldingTemplate unfold_info
1129 no_unfolding = neverUnfold unfold_info
1130 -- The CoreTidy phase retains unfolding info iff
1131 -- we want to expose the unfolding, taking into account
1132 -- unconditional NOINLINE, etc. See TidyPgm.addExternal
1133 unfold_hsinfo | no_unfolding = Nothing
1134 | has_worker = Nothing -- Unfolding is implicit
1135 | otherwise = Just (HsUnfold (toIfaceExpr ext rhs))
1137 ------------ Inline prag --------------
1138 inline_prag = inlinePragInfo id_info
1139 inline_hsinfo | isAlwaysActive inline_prag = Nothing
1140 | no_unfolding && not has_worker = Nothing
1141 -- If the iface file give no unfolding info, we
1142 -- don't need to say when inlining is OK!
1143 | otherwise = Just (HsInline inline_prag)
1145 --------------------------
1146 coreRuleToIfaceRule :: (Name -> IfaceExtName) -- For the LHS names
1147 -> (Name -> IfaceExtName) -- For the RHS names
1148 -> CoreRule -> IfaceRule
1149 coreRuleToIfaceRule ext_lhs ext_rhs (BuiltinRule { ru_fn = fn})
1150 = pprTrace "toHsRule: builtin" (ppr fn) $
1151 bogusIfaceRule (mkIfaceExtName fn)
1153 coreRuleToIfaceRule ext_lhs ext_rhs
1154 (Rule { ru_name = name, ru_fn = fn, ru_act = act, ru_bndrs = bndrs,
1155 ru_args = args, ru_rhs = rhs, ru_orph = orph })
1156 = IfaceRule { ifRuleName = name, ifActivation = act,
1157 ifRuleBndrs = map (toIfaceBndr ext_lhs) bndrs,
1158 ifRuleHead = ext_lhs fn,
1159 ifRuleArgs = map do_arg args,
1160 ifRuleRhs = toIfaceExpr ext_rhs rhs,
1163 -- For type args we must remove synonyms from the outermost
1164 -- level. Reason: so that when we read it back in we'll
1165 -- construct the same ru_rough field as we have right now;
1167 do_arg (Type ty) = IfaceType (toIfaceType ext_lhs (deNoteType ty))
1168 do_arg arg = toIfaceExpr ext_lhs arg
1170 bogusIfaceRule :: IfaceExtName -> IfaceRule
1171 bogusIfaceRule id_name
1172 = IfaceRule { ifRuleName = FSLIT("bogus"), ifActivation = NeverActive,
1173 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1174 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1176 ---------------------
1177 toIfaceExpr :: (Name -> IfaceExtName) -> CoreExpr -> IfaceExpr
1178 toIfaceExpr ext (Var v) = toIfaceVar ext v
1179 toIfaceExpr ext (Lit l) = IfaceLit l
1180 toIfaceExpr ext (Type ty) = IfaceType (toIfaceType ext ty)
1181 toIfaceExpr ext (Lam x b) = IfaceLam (toIfaceBndr ext x) (toIfaceExpr ext b)
1182 toIfaceExpr ext (App f a) = toIfaceApp ext f [a]
1183 toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (occNameFS (getOccName x)) (toIfaceType ext ty) (map (toIfaceAlt ext) as)
1184 toIfaceExpr ext (Let b e) = IfaceLet (toIfaceBind ext b) (toIfaceExpr ext e)
1185 toIfaceExpr ext (Cast e co) = IfaceCast (toIfaceExpr ext e) (toIfaceType ext co)
1186 toIfaceExpr ext (Note n e) = IfaceNote (toIfaceNote ext n) (toIfaceExpr ext e)
1188 ---------------------
1189 toIfaceNote ext (SCC cc) = IfaceSCC cc
1190 toIfaceNote ext InlineMe = IfaceInlineMe
1191 toIfaceNote ext (CoreNote s) = IfaceCoreNote s
1193 ---------------------
1194 toIfaceBind ext (NonRec b r) = IfaceNonRec (toIfaceIdBndr ext b) (toIfaceExpr ext r)
1195 toIfaceBind ext (Rec prs) = IfaceRec [(toIfaceIdBndr ext b, toIfaceExpr ext r) | (b,r) <- prs]
1197 ---------------------
1198 toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map (occNameFS.getOccName) bs, toIfaceExpr ext r)
1200 ---------------------
1201 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1202 | otherwise = IfaceDataAlt (getOccName dc)
1204 tc = dataConTyCon dc
1206 toIfaceCon (LitAlt l) = IfaceLitAlt l
1207 toIfaceCon DEFAULT = IfaceDefault
1209 ---------------------
1210 toIfaceApp ext (App f a) as = toIfaceApp ext f (a:as)
1211 toIfaceApp ext (Var v) as
1212 = case isDataConWorkId_maybe v of
1213 -- We convert the *worker* for tuples into IfaceTuples
1214 Just dc | isTupleTyCon tc && saturated
1215 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1217 val_args = dropWhile isTypeArg as
1218 saturated = val_args `lengthIs` idArity v
1219 tup_args = map (toIfaceExpr ext) val_args
1220 tc = dataConTyCon dc
1222 other -> mkIfaceApps ext (toIfaceVar ext v) as
1224 toIfaceApp ext e as = mkIfaceApps ext (toIfaceExpr ext e) as
1226 mkIfaceApps ext f as = foldl (\f a -> IfaceApp f (toIfaceExpr ext a)) f as
1228 ---------------------
1229 toIfaceVar :: (Name -> IfaceExtName) -> Id -> IfaceExpr
1231 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType ext (idType v))
1232 -- Foreign calls have special syntax
1233 | isExternalName name = IfaceExt (ext name)
1234 | otherwise = IfaceLcl (occNameFS (nameOccName name))