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