Use MD5 checksums for recompilation checking (fixes #1372, #1959)
[ghc.git] / compiler / iface / MkIface.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 %
5
6 \begin{code}
7 module MkIface ( 
8         mkUsedNames,
9         mkDependencies,
10         mkIface,        -- Build a ModIface from a ModGuts, 
11                         -- including computing version information
12
13         mkIfaceTc,
14
15         writeIfaceFile, -- Write the interface file
16
17         checkOldIface,  -- See if recompilation is required, by
18                         -- comparing version information
19
20         tyThingToIfaceDecl -- Converting things to their Iface equivalents
21  ) where
22 \end{code}
23
24         -----------------------------------------------
25                 MkIface.lhs deals with versioning
26         -----------------------------------------------
27
28 Here's the fingerprint-related info in an interface file
29
30   module Foo xxxxxxxxxxxxxxxx  -- module fingerprint
31              yyyyyyyyyyyyyyyy  -- export list fingerprint
32              zzzzzzzzzzzzzzzz  -- rule fingerprint
33     Usages:     -- Version info for what this compilation of Foo imported
34         Baz xxxxxxxxxxxxxxxx    -- Module version
35             [yyyyyyyyyyyyyyyy]  -- The export-list version
36                                 -- ( if Foo depended on it)
37             (g,zzzzzzzzzzzzzzzz) -- Function and its version
38             (T,wwwwwwwwwwwwwwww) -- Type and its version
39
40     <fingerprint> f :: Int -> Int {- Unfolding: \x -> Wib.t x -}
41         
42         -----------------------------------------------
43                         Basic idea
44         -----------------------------------------------
45
46 Basic idea: 
47   * In the mi_usages information in an interface, we record the 
48     fingerprint of each free variable of the module
49
50   * In mkIface, we compute the fingerprint of each exported thing A.f.
51     For each external thing that A.f refers to, we include the fingerprint
52     of the external reference when computing the fingerprint of A.f.  So
53     if anything that A.f depends on changes, then A.f's fingerprint will
54     change.
55
56   * In checkOldIface we compare the mi_usages for the module with
57     the actual fingerprint for all each thing recorded in mi_usages
58
59 Fixities
60 ~~~~~~~~
61 We count A.f as changing if its fixity changes
62
63 Rules
64 ~~~~~
65 If a rule changes, we want to recompile any module that might be
66 affected by that rule.  For non-orphan rules, this is relatively easy.
67 If module M defines f, and a rule for f, just arrange that the fingerprint
68 for M.f changes if any of the rules for M.f change.  Any module
69 that does not depend on M.f can't be affected by the rule-change
70 either.
71
72 Orphan rules (ones whose 'head function' is not defined in M) are
73 harder.  Here's what we do.
74
75   * We have a per-module orphan-rule fingerprint which changes if 
76     any orphan rule changes. (It's unaffected by non-orphan rules.)
77
78   * We record usage info for any orphan module 'below' this one,
79     giving the orphan-rule fingerprint.  We recompile if this 
80     changes. 
81
82 The net effect is that if an orphan rule changes, we recompile every
83 module above it.  That's very conservative, but it's devilishly hard
84 to know what it might affect, so we just have to be conservative.
85
86 Instance decls
87 ~~~~~~~~~~~~~~
88 In an iface file we have
89      module A where
90         instance Eq a => Eq [a]  =  dfun29
91         dfun29 :: ... 
92
93 We have a fingerprint for dfun29, covering its unfolding
94 etc. Suppose we are compiling a module M that imports A only
95 indirectly.  If typechecking M uses this instance decl, we record the
96 dependency on A.dfun29 as if it were a free variable of the module
97 (via the tcg_inst_usages accumulator).  That means that A will appear
98 in M's usage list.  If the shape of the instance declaration changes,
99 then so will dfun29's fingerprint, triggering a recompilation.
100
101 Adding an instance declaration, or changing an instance decl that is
102 not currently used, is more tricky.  (This really only makes a
103 difference when we have overlapping instance decls, because then the
104 new instance decl might kick in to override the old one.)  We handle
105 this in a very similar way that we handle rules above.
106
107   * For non-orphan instance decls, identify one locally-defined tycon/class
108     mentioned in the decl.  Treat the instance decl as part of the defn of that
109     tycon/class, so that if the shape of the instance decl changes, so does the
110     tycon/class; that in turn will force recompilation of anything that uses
111     that tycon/class.
112
113   * For orphan instance decls, act the same way as for orphan rules.
114     Indeed, we use the same global orphan-rule version number.
115
116 mkUsageInfo
117 ~~~~~~~~~~~
118 mkUsageInfo figures out what the ``usage information'' for this
119 moudule is; that is, what it must record in its interface file as the
120 things it uses.  
121
122 We produce a line for every module B below the module, A, currently being
123 compiled:
124         import B <n> ;
125 to record the fact that A does import B indirectly.  This is used to decide
126 to look for B.hi rather than B.hi-boot when compiling a module that
127 imports A.  This line says that A imports B, but uses nothing in it.
128 So we'll get an early bale-out when compiling A if B's fingerprint changes.
129
130 The usage information records:
131
132 \begin{itemize}
133 \item   (a) anything reachable from its body code
134 \item   (b) any module exported with a @module Foo@
135 \item   (c) anything reachable from an exported item
136 \end{itemize}
137
138 Why (b)?  Because if @Foo@ changes then this module's export list
139 will change, so we must recompile this module at least as far as
140 making a new interface file --- but in practice that means complete
141 recompilation.
142
143 Why (c)?  Consider this:
144 \begin{verbatim}
145         module A( f, g ) where  |       module B( f ) where
146           import B( f )         |         f = h 3
147           g = ...               |         h = ...
148 \end{verbatim}
149
150 Here, @B.f@ isn't used in A.  Should we nevertheless record @B.f@ in
151 @A@'s usages?  Our idea is that we aren't going to touch A.hi if it is
152 *identical* to what it was before.  If anything about @B.f@ changes
153 than anyone who imports @A@ should be recompiled in case they use
154 @B.f@ (they'll get an early exit if they don't).  So, if anything
155 about @B.f@ changes we'd better make sure that something in A.hi
156 changes, and the convenient way to do that is to record the version
157 number @B.f@ in A.hi in the usage list.  If B.f changes that'll force a
158 complete recompiation of A, which is overkill but it's the only way to 
159 write a new, slightly different, A.hi.
160
161 But the example is tricker.  Even if @B.f@ doesn't change at all,
162 @B.h@ may do so, and this change may not be reflected in @f@'s version
163 number.  But with -O, a module that imports A must be recompiled if
164 @B.h@ changes!  So A must record a dependency on @B.h@.  So we treat
165 the occurrence of @B.f@ in the export list *just as if* it were in the
166 code of A, and thereby haul in all the stuff reachable from it.
167
168         *** Conclusion: if A mentions B.f in its export list,
169             behave just as if A mentioned B.f in its source code,
170             and slurp in B.f and all its transitive closure ***
171
172 [NB: If B was compiled with -O, but A isn't, we should really *still*
173 haul in all the unfoldings for B, in case the module that imports A *is*
174 compiled with -O.  I think this is the case.]
175
176 SimonM [30/11/2007]: I believe the above is all out of date; the
177 current implementation doesn't do it this way.  Instead, when any of
178 the dependencies of a declaration changes, the version of the
179 declaration itself changes.
180
181 \begin{code}
182 #include "HsVersions.h"
183
184 import IfaceSyn
185 import IfaceType
186 import LoadIface
187 import Id
188 import IdInfo
189 import NewDemand
190 import CoreSyn
191 import CoreFVs
192 import Class
193 import TyCon
194 import DataCon
195 import Type
196 import TcType
197 import InstEnv
198 import FamInstEnv
199 import TcRnMonad
200 import HscTypes
201 import Finder
202 import DynFlags
203 import VarEnv
204 import Var
205 import Name
206 import RdrName
207 import NameEnv
208 import NameSet
209 import OccName
210 import Module
211 import BinIface
212 import ErrUtils
213 import Digraph
214 import SrcLoc
215 import Outputable
216 import BasicTypes       hiding ( SuccessFlag(..) )
217 import LazyUniqFM
218 import Unique
219 import Util             hiding ( eqListBy )
220 import FiniteMap
221 import FastString
222 import Maybes
223 import ListSetOps
224 import Binary
225 import Fingerprint
226 import Panic
227
228 import Control.Monad
229 import Data.List
230 import Data.IORef
231 import System.FilePath
232 \end{code}
233
234
235
236 %************************************************************************
237 %*                                                                      *
238 \subsection{Completing an interface}
239 %*                                                                      *
240 %************************************************************************
241
242 \begin{code}
243 mkIface :: HscEnv
244         -> Maybe Fingerprint    -- The old fingerprint, if we have it
245         -> ModDetails           -- The trimmed, tidied interface
246         -> ModGuts              -- Usages, deprecations, etc
247         -> IO (ModIface,        -- The new one
248                Bool)            -- True <=> there was an old Iface, and the 
249                                 --          new one is identical, so no need
250                                 --          to write it
251
252 mkIface hsc_env maybe_old_fingerprint mod_details
253          ModGuts{     mg_module    = this_mod,
254                       mg_boot      = is_boot,
255                       mg_used_names = used_names,
256                       mg_deps      = deps,
257                       mg_dir_imps  = dir_imp_mods,
258                       mg_rdr_env   = rdr_env,
259                       mg_fix_env   = fix_env,
260                       mg_deprecs   = deprecs,
261                       mg_hpc_info  = hpc_info }
262         = mkIface_ hsc_env maybe_old_fingerprint
263                    this_mod is_boot used_names deps rdr_env 
264                    fix_env deprecs hpc_info dir_imp_mods mod_details
265         
266 -- | make an interface from the results of typechecking only.  Useful
267 -- for non-optimising compilation, or where we aren't generating any
268 -- object code at all ('HscNothing').
269 mkIfaceTc :: HscEnv
270           -> Maybe Fingerprint  -- The old fingerprint, if we have it
271           -> ModDetails         -- gotten from mkBootModDetails, probably
272           -> TcGblEnv           -- Usages, deprecations, etc
273           -> IO (ModIface,
274                  Bool)
275 mkIfaceTc hsc_env maybe_old_fingerprint mod_details
276   tc_result@TcGblEnv{ tcg_mod = this_mod,
277                       tcg_src = hsc_src,
278                       tcg_imports = imports,
279                       tcg_rdr_env = rdr_env,
280                       tcg_fix_env = fix_env,
281                       tcg_deprecs = deprecs,
282                       tcg_hpc = other_hpc_info
283                     }
284   = do
285           used_names <- mkUsedNames tc_result
286           deps <- mkDependencies tc_result
287           let hpc_info = emptyHpcInfo other_hpc_info
288           mkIface_ hsc_env maybe_old_fingerprint
289                    this_mod (isHsBoot hsc_src) used_names deps rdr_env 
290                    fix_env deprecs hpc_info (imp_mods imports) mod_details
291         
292
293 mkUsedNames :: TcGblEnv -> IO NameSet
294 mkUsedNames 
295           TcGblEnv{ tcg_inst_uses = dfun_uses_var,
296                     tcg_dus = dus
297                   }
298  = do
299         dfun_uses <- readIORef dfun_uses_var            -- What dfuns are used
300         return (allUses dus `unionNameSets` dfun_uses)
301         
302 mkDependencies :: TcGblEnv -> IO Dependencies
303 mkDependencies
304           TcGblEnv{ tcg_mod = mod,
305                     tcg_imports = imports,
306                     tcg_th_used = th_var
307                   }
308  = do 
309       th_used   <- readIORef th_var                     -- Whether TH is used
310       let
311         dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
312                 -- M.hi-boot can be in the imp_dep_mods, but we must remove
313                 -- it before recording the modules on which this one depends!
314                 -- (We want to retain M.hi-boot in imp_dep_mods so that 
315                 --  loadHiBootInterface can see if M's direct imports depend 
316                 --  on M.hi-boot, and hence that we should do the hi-boot consistency 
317                 --  check.)
318
319                 -- Modules don't compare lexicographically usually, 
320                 -- but we want them to do so here.
321         le_mod :: Module -> Module -> Bool         
322         le_mod m1 m2 = moduleNameFS (moduleName m1) 
323                            <= moduleNameFS (moduleName m2)
324
325         le_dep_mod :: (ModuleName, IsBootInterface)
326                     -> (ModuleName, IsBootInterface) -> Bool         
327         le_dep_mod (m1,_) (m2,_) = moduleNameFS m1 <= moduleNameFS m2
328
329         
330         pkgs | th_used   = insertList thPackageId (imp_dep_pkgs imports)
331              | otherwise = imp_dep_pkgs imports
332
333       return Deps { dep_mods   = sortLe le_dep_mod dep_mods,
334                     dep_pkgs   = sortLe (<=)   pkgs,        
335                     dep_orphs  = sortLe le_mod (imp_orphs  imports),
336                     dep_finsts = sortLe le_mod (imp_finsts imports) }
337                 -- sort to get into canonical order
338
339
340 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
341          -> NameSet -> Dependencies -> GlobalRdrEnv
342          -> NameEnv FixItem -> Deprecations -> HpcInfo
343          -> ImportedMods
344          -> ModDetails
345          -> IO (ModIface, Bool)
346 mkIface_ hsc_env maybe_old_fingerprint 
347          this_mod is_boot used_names deps rdr_env fix_env src_deprecs hpc_info
348          dir_imp_mods
349          ModDetails{  md_insts     = insts, 
350                       md_fam_insts = fam_insts,
351                       md_rules     = rules,
352                       md_vect_info = vect_info,
353                       md_types     = type_env,
354                       md_exports   = exports }
355 -- NB:  notice that mkIface does not look at the bindings
356 --      only at the TypeEnv.  The previous Tidy phase has
357 --      put exactly the info into the TypeEnv that we want
358 --      to expose in the interface
359
360   = do  { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
361
362         ; let   { entities = typeEnvElts type_env ;
363                   decls  = [ tyThingToIfaceDecl entity
364                            | entity <- entities,
365                              let name = getName entity,
366                              not (isImplicitTyThing entity),
367                                 -- No implicit Ids and class tycons in the interface file
368                              not (isWiredInName name),
369                                 -- Nor wired-in things; the compiler knows about them anyhow
370                              nameIsLocalOrFrom this_mod name  ]
371                                 -- Sigh: see Note [Root-main Id] in TcRnDriver
372
373                 ; fixities    = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
374                 ; deprecs     = src_deprecs
375                 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
376                 ; iface_insts = map instanceToIfaceInst insts
377                 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
378                 ; iface_vect_info = flattenVectInfo vect_info
379
380                 ; intermediate_iface = ModIface { 
381                         mi_module   = this_mod,
382                         mi_boot     = is_boot,
383                         mi_deps     = deps,
384                         mi_usages   = usages,
385                         mi_exports  = mkIfaceExports exports,
386         
387                         -- Sort these lexicographically, so that
388                         -- the result is stable across compilations
389                         mi_insts    = sortLe le_inst iface_insts,
390                         mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
391                         mi_rules    = sortLe le_rule iface_rules,
392
393                         mi_vect_info = iface_vect_info,
394
395                         mi_fixities = fixities,
396                         mi_deprecs  = deprecs,
397                         mi_globals  = Just rdr_env,
398
399                         -- Left out deliberately: filled in by addVersionInfo
400                         mi_iface_hash = fingerprint0,
401                         mi_mod_hash  = fingerprint0,
402                         mi_exp_hash  = fingerprint0,
403                         mi_orphan_hash = fingerprint0,
404                         mi_orphan    = False,   -- Always set by addVersionInfo, but
405                                                 -- it's a strict field, so we can't omit it.
406                         mi_finsts    = False,   -- Ditto
407                         mi_decls     = deliberatelyOmitted "decls",
408                         mi_hash_fn   = deliberatelyOmitted "hash_fn",
409                         mi_hpc       = isHpcUsed hpc_info,
410
411                         -- And build the cached values
412                         mi_dep_fn = mkIfaceDepCache deprecs,
413                         mi_fix_fn = mkIfaceFixCache fixities }
414                 }
415
416         ; (new_iface, no_change_at_all, pp_orphs) 
417                 <- {-# SCC "versioninfo" #-}
418                          addFingerprints hsc_env maybe_old_fingerprint
419                                          intermediate_iface decls
420
421                 -- Debug printing
422         ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags) 
423                (printDump (expectJust "mkIface" pp_orphs))
424
425 -- XXX  ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
426
427         ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE" 
428                         (pprModIface new_iface)
429
430                 -- bug #1617: on reload we weren't updating the PrintUnqualified
431                 -- correctly.  This stems from the fact that the interface had
432                 -- not changed, so addVersionInfo returns the old ModIface
433                 -- with the old GlobalRdrEnv (mi_globals).
434         ; let final_iface = new_iface{ mi_globals = Just rdr_env }
435
436         ; return (final_iface, no_change_at_all) }
437   where
438      r1 `le_rule`     r2 = ifRuleName      r1    <=    ifRuleName      r2
439      i1 `le_inst`     i2 = ifDFun          i1 `le_occ` ifDFun          i2  
440      i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
441
442      le_occ :: Name -> Name -> Bool
443         -- Compare lexicographically by OccName, *not* by unique, because 
444         -- the latter is not stable across compilations
445      le_occ n1 n2 = nameOccName n1 <= nameOccName n2
446
447      dflags = hsc_dflags hsc_env
448      deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
449      ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
450
451      flattenVectInfo (VectInfo { vectInfoVar   = vVar
452                                , vectInfoTyCon = vTyCon
453                                }) = 
454        IfaceVectInfo { 
455          ifaceVectInfoVar        = [ Var.varName v 
456                                    | (v, _) <- varEnvElts vVar],
457          ifaceVectInfoTyCon      = [ tyConName t 
458                                    | (t, t_v) <- nameEnvElts vTyCon
459                                    , t /= t_v],
460          ifaceVectInfoTyConReuse = [ tyConName t
461                                    | (t, t_v) <- nameEnvElts vTyCon
462                                    , t == t_v]
463        } 
464
465 -----------------------------
466 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
467 writeIfaceFile dflags location new_iface
468     = do createDirectoryHierarchy (takeDirectory hi_file_path)
469          writeBinIface dflags hi_file_path new_iface
470     where hi_file_path = ml_hi_file location
471
472
473 -- -----------------------------------------------------------------------------
474 -- Look up parents and versions of Names
475
476 -- This is like a global version of the mi_hash_fn field in each ModIface.
477 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
478 -- the parent and version info.
479
480 mkHashFun
481         :: HscEnv                       -- needed to look up versions
482         -> ExternalPackageState         -- ditto
483         -> (Name -> Fingerprint)
484 mkHashFun hsc_env eps
485   = \name -> 
486       let 
487         mod = nameModule name
488         occ = nameOccName name
489         iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse` 
490                    pprPanic "lookupVers2" (ppr mod <+> ppr occ)
491       in  
492         snd (mi_hash_fn iface occ `orElse` 
493                   pprPanic "lookupVers1" (ppr mod <+> ppr occ))
494   where
495       hpt = hsc_HPT hsc_env
496       pit = eps_PIT eps
497
498 -- ---------------------------------------------------------------------------
499 -- Compute fingerprints for the interface
500
501 addFingerprints
502         :: HscEnv
503         -> Maybe Fingerprint -- the old fingerprint, if any
504         -> ModIface          -- The new interface (lacking decls)
505         -> [IfaceDecl]       -- The new decls
506         -> IO (ModIface,     -- Updated interface
507                Bool,         -- True <=> no changes at all; 
508                              -- no need to write Iface
509                Maybe SDoc)   -- Warnings about orphans
510
511 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
512  = do
513    eps <- hscEPS hsc_env
514    let
515         -- the ABI of a declaration represents everything that is made
516         -- visible about the declaration that a client can depend on.
517         -- see IfaceDeclABI below.
518        declABI :: IfaceDecl -> IfaceDeclABI 
519        declABI decl = (this_mod, decl, extras)
520         where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
521
522        edges :: [(IfaceDeclABI, Unique, [Unique])]
523        edges = [ (abi, getUnique (ifName decl), out)
524                | decl <- new_decls
525                , let abi = declABI decl
526                , let out = localOccs $ freeNamesDeclABI abi
527                ]
528
529        localOccs = map (getUnique . getParent . getOccName) 
530                         . filter ((== this_mod) . nameModule)
531                         . nameSetToList
532           where getParent occ = lookupOccEnv parent_map occ `orElse` occ
533
534         -- maps OccNames to their parents in the current module.
535         -- e.g. a reference to a constructor must be turned into a reference
536         -- to the TyCon for the purposes of calculating dependencies.
537        parent_map :: OccEnv OccName
538        parent_map = foldr extend emptyOccEnv new_decls
539           where extend d env = 
540                   extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
541                   where n = ifName d
542
543         -- strongly-connected groups of declarations, in dependency order
544        groups = stronglyConnComp edges
545
546        global_hash_fn = mkHashFun hsc_env eps
547
548         -- how to output Names when generating the data to fingerprint.
549         -- Here we want to output the fingerprint for each top-level
550         -- Name, whether it comes from the current module or another
551         -- module.  In this way, the fingerprint for a declaration will
552         -- change if the fingerprint for anything it refers to (transitively)
553         -- changes.
554        mk_put_name :: (OccEnv (OccName,Fingerprint))
555                    -> BinHandle -> Name -> IO  ()
556        mk_put_name local_env bh name
557           | isWiredInName name  =  putNameLiterally bh name 
558            -- wired-in names don't have fingerprints
559           | otherwise
560           = let hash | nameModule name /= this_mod =  global_hash_fn name
561                      | otherwise = 
562                         snd (lookupOccEnv local_env (getOccName name)
563                            `orElse` pprPanic "urk! lookup local fingerprint" 
564                                        (ppr name)) -- (undefined,fingerprint0))
565             in 
566             put_ bh hash
567
568         -- take a strongly-connected group of declarations and compute
569         -- its fingerprint.
570
571        fingerprint_group :: (OccEnv (OccName,Fingerprint), 
572                              [(Fingerprint,IfaceDecl)])
573                          -> SCC IfaceDeclABI
574                          -> IO (OccEnv (OccName,Fingerprint), 
575                                 [(Fingerprint,IfaceDecl)])
576
577        fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
578           = do let hash_fn = mk_put_name local_env
579                    decl = abiDecl abi
580                -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
581                hash <- computeFingerprint dflags hash_fn abi
582                return (extend_hash_env (hash,decl) local_env,
583                        (hash,decl) : decls_w_hashes)
584
585        fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
586           = do let decls = map abiDecl abis
587                    local_env' = foldr extend_hash_env local_env 
588                                    (zip (repeat fingerprint0) decls)
589                    hash_fn = mk_put_name local_env'
590                -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
591                let stable_abis = sortBy cmp_abiNames abis
592                 -- put the cycle in a canonical order
593                hash <- computeFingerprint dflags hash_fn stable_abis
594                let pairs = zip (repeat hash) decls
595                return (foldr extend_hash_env local_env pairs,
596                        pairs ++ decls_w_hashes)
597
598        extend_hash_env :: (Fingerprint,IfaceDecl)
599                        -> OccEnv (OccName,Fingerprint)
600                        -> OccEnv (OccName,Fingerprint)
601        extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
602         where
603           decl_name = ifName d
604           item = (decl_name, hash)
605           env1 = extendOccEnv env0 decl_name item
606           add_imp bndr env = extendOccEnv env bndr item
607             
608    --
609    (local_env, decls_w_hashes) <- 
610        foldM fingerprint_group (emptyOccEnv, []) groups
611
612    -- the export hash of a module depends on the orphan hashes of the
613    -- orphan modules below us in the dependeny tree.  This is the way
614    -- that changes in orphans get propagated all the way up the
615    -- dependency tree.  We only care about orphan modules in the current
616    -- package, because changes to orphans outside this package will be
617    -- tracked by the usage on the ABI hash of package modules that we import.
618    let orph_mods = sortBy (compare `on` (moduleNameFS.moduleName))
619                         . filter ((== this_pkg) . modulePackageId)
620                         $ dep_orphs (mi_deps iface0)
621    dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
622
623    orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
624                       (map IfaceInstABI orph_insts, orph_rules, fam_insts)
625
626    -- the export list hash doesn't depend on the fingerprints of
627    -- the Names it mentions, only the Names themselves, hence putNameLiterally.
628    export_hash <- computeFingerprint dflags putNameLiterally 
629                       (mi_exports iface0, orphan_hash, dep_orphan_hashes)
630
631    -- put the declarations in a canonical order, sorted by OccName
632    let sorted_decls = eltsFM $ listToFM $
633                           [(ifName d, e) | e@(_, d) <- decls_w_hashes]
634
635    -- the ABI hash depends on:
636    --   - decls
637    --   - export list
638    --   - orphans
639    --   - deprecations
640    --   - XXX vect info?
641    mod_hash <- computeFingerprint dflags putNameLiterally
642                       (map fst sorted_decls,
643                        export_hash,
644                        orphan_hash,
645                        mi_deprecs iface0)
646
647    -- The interface hash depends on:
648    --    - the ABI hash, plus
649    --    - usages
650    --    - deps
651    --    - hpc
652    iface_hash <- computeFingerprint dflags putNameLiterally
653                       (mod_hash, 
654                        mi_usages iface0,
655                        mi_deps iface0,
656                        mi_hpc iface0)
657
658    let
659     no_change_at_all = Just iface_hash == mb_old_fingerprint
660
661     final_iface = iface0 {
662                 mi_mod_hash    = mod_hash,
663                 mi_iface_hash  = iface_hash,
664                 mi_exp_hash    = export_hash,
665                 mi_orphan_hash = orphan_hash,
666                 mi_orphan      = not (null orph_rules && null orph_insts),
667                 mi_finsts      = not . null $ mi_fam_insts iface0,
668                 mi_decls       = sorted_decls,
669                 mi_hash_fn     = lookupOccEnv local_env }
670    --
671    return (final_iface, no_change_at_all, pp_orphs)
672
673   where
674     this_mod = mi_module iface0
675     dflags = hsc_dflags hsc_env
676     this_pkg = thisPackage dflags
677     (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
678     (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
679         -- ToDo: shouldn't we be splitting fam_insts into orphans and
680         -- non-orphans?
681     fam_insts = mi_fam_insts iface0
682     fix_fn = mi_fix_fn iface0
683     pp_orphs = pprOrphans orph_insts orph_rules
684
685
686 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
687 getOrphanHashes hsc_env mods = do
688   eps <- hscEPS hsc_env
689   let 
690     hpt        = hsc_HPT hsc_env
691     pit        = eps_PIT eps
692     dflags     = hsc_dflags hsc_env
693     get_orph_hash mod = 
694           case lookupIfaceByModule dflags hpt pit mod of
695             Nothing    -> pprPanic "moduleOrphanHash" (ppr mod)
696             Just iface -> mi_orphan_hash iface
697   --
698   return (map get_orph_hash mods)
699
700
701 -- The ABI of a declaration consists of:
702      -- the full name of the identifier (inc. module and package, because
703      --   these are used to construct the symbol name by which the 
704      --   identifier is known externally).
705      -- the fixity of the identifier
706      -- the declaration itself, as exposed to clients.  That is, the
707      --   definition of an Id is included in the fingerprint only if
708      --   it is made available as as unfolding in the interface.
709      -- for Ids: rules
710      -- for classes: instances, fixity & rules for methods
711      -- for datatypes: instances, fixity & rules for constrs
712 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
713
714 abiDecl :: IfaceDeclABI -> IfaceDecl
715 abiDecl (_, decl, _) = decl
716
717 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
718 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare` 
719                          ifName (abiDecl abi2)
720
721 freeNamesDeclABI :: IfaceDeclABI -> NameSet
722 freeNamesDeclABI (_mod, decl, extras) =
723   freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
724
725 data IfaceDeclExtras 
726   = IfaceIdExtras    Fixity [IfaceRule]
727   | IfaceDataExtras  Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
728   | IfaceClassExtras [IfaceInstABI] [(Fixity,[IfaceRule])]
729   | IfaceOtherDeclExtras
730
731 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
732 freeNamesDeclExtras (IfaceIdExtras    _ rules)
733   = unionManyNameSets (map freeNamesIfRule rules)
734 freeNamesDeclExtras (IfaceDataExtras  _ _insts subs)
735   = unionManyNameSets (map freeNamesSub subs)
736 freeNamesDeclExtras (IfaceClassExtras _insts subs)
737   = unionManyNameSets (map freeNamesSub subs)
738 freeNamesDeclExtras IfaceOtherDeclExtras
739   = emptyNameSet
740
741 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
742 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
743
744 instance Binary IfaceDeclExtras where
745   get _bh = panic "no get for IfaceDeclExtras"
746   put_ bh (IfaceIdExtras fix rules) = do
747    putByte bh 1; put_ bh fix; put_ bh rules
748   put_ bh (IfaceDataExtras fix insts cons) = do
749    putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
750   put_ bh (IfaceClassExtras insts methods) = do
751    putByte bh 3; put_ bh insts; put_ bh methods
752   put_ bh IfaceOtherDeclExtras = do
753    putByte bh 4
754
755 declExtras :: (OccName -> Fixity)
756            -> OccEnv [IfaceRule]
757            -> OccEnv [IfaceInst]
758            -> IfaceDecl
759            -> IfaceDeclExtras
760
761 declExtras fix_fn rule_env inst_env decl
762   = case decl of
763       IfaceId{} -> IfaceIdExtras (fix_fn n) 
764                         (lookupOccEnvL rule_env n)
765       IfaceData{ifCons=cons} -> 
766                      IfaceDataExtras (fix_fn n)
767                         (map IfaceInstABI $ lookupOccEnvL inst_env n)
768                         (map (id_extras . ifConOcc) (visibleIfConDecls cons))
769       IfaceClass{ifSigs=sigs} -> 
770                      IfaceClassExtras 
771                         (map IfaceInstABI $ lookupOccEnvL inst_env n)
772                         [id_extras op | IfaceClassOp op _ _ <- sigs]
773       _other -> IfaceOtherDeclExtras
774   where
775         n = ifName decl
776         id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
777
778 -- When hashing an instance, we omit the DFun.  This is because if a
779 -- DFun is used it will already have a separate entry in the usages
780 -- list, and we don't want changes to the DFun to cause the hash of
781 -- the instnace to change - that would cause unnecessary changes to
782 -- orphans, for example.
783 newtype IfaceInstABI = IfaceInstABI IfaceInst
784
785 instance Binary IfaceInstABI where
786   get = panic "no get for IfaceInstABI"
787   put_ bh (IfaceInstABI inst) = do
788     let ud  = getUserData bh
789         bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
790     put_ bh' inst
791
792 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
793 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
794
795 -- used when we want to fingerprint a structure without depending on the
796 -- fingerprints of external Names that it refers to.
797 putNameLiterally :: BinHandle -> Name -> IO ()
798 putNameLiterally bh name = do
799   put_ bh $! nameModule name
800   put_ bh $! nameOccName name
801
802 computeFingerprint :: Binary a
803                    => DynFlags 
804                    -> (BinHandle -> Name -> IO ())
805                    -> a
806                    -> IO Fingerprint
807
808 computeFingerprint _dflags put_name a = do
809   bh <- openBinMem (3*1024) -- just less than a block
810   ud <- newWriteState put_name putFS
811   bh <- return $ setUserData bh ud
812   put_ bh a
813   fingerprintBinMem bh
814
815 {-
816 -- for testing: use the md5sum command to generate fingerprints and
817 -- compare the results against our built-in version.
818   fp' <- oldMD5 dflags bh
819   if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
820                else return fp
821
822 oldMD5 dflags bh = do
823   tmp <- newTempName dflags "bin"
824   writeBinMem bh tmp
825   tmp2 <- newTempName dflags "md5"
826   let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
827   r <- system cmd
828   case r of
829     ExitFailure _ -> ghcError (PhaseFailed cmd r)
830     ExitSuccess -> do
831         hash_str <- readFile tmp2
832         return $! readHexFingerprint hash_str
833 -}
834
835 pprOrphans :: [IfaceInst] -> [IfaceRule] -> Maybe SDoc
836 pprOrphans insts rules
837   | null insts && null rules = Nothing
838   | otherwise
839   = Just $ vcat [
840         if null insts then empty else
841              hang (ptext (sLit "Warning: orphan instances:"))
842                 2 (vcat (map ppr insts)),
843         if null rules then empty else
844              hang (ptext (sLit "Warning: orphan rules:"))
845                 2 (vcat (map ppr rules))
846     ]
847
848 ----------------------
849 -- mkOrphMap partitions instance decls or rules into
850 --      (a) an OccEnv for ones that are not orphans, 
851 --          mapping the local OccName to a list of its decls
852 --      (b) a list of orphan decls
853 mkOrphMap :: (decl -> Maybe OccName)    -- (Just occ) for a non-orphan decl, keyed by occ
854                                         -- Nothing for an orphan decl
855           -> [decl]                     -- Sorted into canonical order
856           -> (OccEnv [decl],            -- Non-orphan decls associated with their key;
857                                         --      each sublist in canonical order
858               [decl])                   -- Orphan decls; in canonical order
859 mkOrphMap get_key decls
860   = foldl go (emptyOccEnv, []) decls
861   where
862     go (non_orphs, orphs) d
863         | Just occ <- get_key d
864         = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
865         | otherwise = (non_orphs, d:orphs)
866 \end{code}
867
868
869 %*********************************************************
870 %*                                                      *
871 \subsection{Keeping track of what we've slurped, and fingerprints}
872 %*                                                      *
873 %*********************************************************
874
875
876 \begin{code}
877 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
878 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
879   = do  { eps <- hscEPS hsc_env
880         ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
881                                      dir_imp_mods used_names
882         ; usages `seqList`  return usages }
883          -- seq the list of Usages returned: occasionally these
884          -- don't get evaluated for a while and we can end up hanging on to
885          -- the entire collection of Ifaces.
886
887 mk_usage_info :: PackageIfaceTable
888               -> HscEnv
889               -> Module
890               -> ImportedMods
891               -> NameSet
892               -> [Usage]
893 mk_usage_info pit hsc_env this_mod direct_imports used_names
894   = mapCatMaybes mkUsage usage_mods
895   where
896     hpt = hsc_HPT hsc_env
897     dflags = hsc_dflags hsc_env
898     this_pkg = thisPackage dflags
899
900     used_mods    = moduleEnvKeys ent_map
901     dir_imp_mods = (moduleEnvKeys direct_imports)
902     all_mods     = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
903     usage_mods   = sortBy stableModuleCmp all_mods
904                         -- canonical order is imported, to avoid interface-file
905                         -- wobblage.
906
907     -- ent_map groups together all the things imported and used
908     -- from a particular module
909     ent_map :: ModuleEnv [OccName]
910     ent_map  = foldNameSet add_mv emptyModuleEnv used_names
911      where
912       add_mv name mv_map
913         | isWiredInName name = mv_map  -- ignore wired-in names
914         | otherwise
915         = case nameModule_maybe name of
916              Nothing  -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
917              Just mod -> extendModuleEnv_C (++) mv_map mod [occ]
918                    where occ = nameOccName name
919     
920     -- We want to create a Usage for a home module if 
921     --  a) we used something from it; has something in used_names
922     --  b) we imported it, even if we used nothing from it
923     --     (need to recompile if its export list changes: export_fprint)
924     mkUsage :: Module -> Maybe Usage
925     mkUsage mod
926       | isNothing maybe_iface           -- We can't depend on it if we didn't
927                                         -- load its interface.
928       || mod == this_mod                -- We don't care about usages of
929                                         -- things in *this* module
930       = Nothing
931
932       | modulePackageId mod /= this_pkg
933       = Just UsagePackageModule{ usg_mod      = mod,
934                                  usg_mod_hash = mod_hash }
935         -- for package modules, we record the module hash only
936
937       | (null used_occs
938           && isNothing export_hash
939           && not is_direct_import
940           && not finsts_mod)
941       = Nothing                 -- Record no usage info
942         -- for directly-imported modules, we always want to record a usage
943         -- on the orphan hash.  This is what triggers a recompilation if
944         -- an orphan is added or removed somewhere below us in the future.
945     
946       | otherwise       
947       = Just UsageHomeModule { 
948                       usg_mod_name = moduleName mod,
949                       usg_mod_hash = mod_hash,
950                       usg_exports  = export_hash,
951                       usg_entities = fmToList ent_hashs }
952       where
953         maybe_iface  = lookupIfaceByModule dflags hpt pit mod
954                 -- In one-shot mode, the interfaces for home-package 
955                 -- modules accumulate in the PIT not HPT.  Sigh.
956
957         is_direct_import = mod `elemModuleEnv` direct_imports
958
959         Just iface   = maybe_iface
960         finsts_mod   = mi_finsts    iface
961         hash_env     = mi_hash_fn   iface
962         mod_hash     = mi_mod_hash  iface
963         export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
964                     | otherwise             = Nothing
965     
966         used_occs = lookupModuleEnv ent_map mod `orElse` []
967
968         -- Making a FiniteMap here ensures that (a) we remove duplicates
969         -- when we have usages on several subordinates of a single parent,
970         -- and (b) that the usages emerge in a canonical order, which
971         -- is why we use FiniteMap rather than OccEnv: FiniteMap works
972         -- using Ord on the OccNames, which is a lexicographic ordering.
973         ent_hashs :: FiniteMap OccName Fingerprint
974         ent_hashs = listToFM (map lookup_occ used_occs)
975         
976         lookup_occ occ = 
977             case hash_env occ of
978                 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
979                 Just r  -> r
980
981         depend_on_exports mod = 
982            case lookupModuleEnv direct_imports mod of
983                 Just _ -> True
984                   -- Even if we used 'import M ()', we have to register a
985                   -- usage on the export list because we are sensitive to
986                   -- changes in orphan instances/rules.
987                 Nothing -> False
988                   -- In GHC 6.8.x the above line read "True", and in
989                   -- fact it recorded a dependency on *all* the
990                   -- modules underneath in the dependency tree.  This
991                   -- happens to make orphans work right, but is too
992                   -- expensive: it'll read too many interface files.
993                   -- The 'isNothing maybe_iface' check above saved us
994                   -- from generating many of these usages (at least in
995                   -- one-shot mode), but that's even more bogus!
996 \end{code}
997
998 \begin{code}
999 mkIfaceExports :: [AvailInfo]
1000                -> [(Module, [GenAvailInfo OccName])]
1001   -- Group by module and sort by occurrence
1002   -- This keeps the list in canonical order
1003 mkIfaceExports exports
1004   = [ (mod, eltsFM avails)
1005     | (mod, avails) <- fmToList groupFM
1006     ]
1007   where
1008         -- Group by the module where the exported entities are defined
1009         -- (which may not be the same for all Names in an Avail)
1010         -- Deliberately use FiniteMap rather than UniqFM so we
1011         -- get a canonical ordering
1012     groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
1013     groupFM = foldl add emptyModuleEnv exports
1014
1015     add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
1016             -> Module -> GenAvailInfo OccName
1017             -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
1018     add_one env mod avail 
1019       =  extendModuleEnv_C plusFM env mod 
1020                 (unitFM (occNameFS (availName avail)) avail)
1021
1022         -- NB: we should not get T(X) and T(Y) in the export list
1023         --     else the plusFM will simply discard one!  They
1024         --     should have been combined by now.
1025     add env (Avail n)
1026       = add_one env (nameModule n) (Avail (nameOccName n))
1027
1028     add env (AvailTC tc ns)
1029       = foldl add_for_mod env mods
1030       where
1031         tc_occ = nameOccName tc
1032         mods   = nub (map nameModule ns)
1033                 -- Usually just one, but see Note [Original module]
1034
1035         add_for_mod env mod
1036             = add_one env mod (AvailTC tc_occ (sort names_from_mod))
1037               -- NB. sort the children, we need a canonical order
1038             where
1039               names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
1040 \end{code}
1041
1042 Note [Orignal module]
1043 ~~~~~~~~~~~~~~~~~~~~~
1044 Consider this:
1045         module X where { data family T }
1046         module Y( T(..) ) where { import X; data instance T Int = MkT Int }
1047 The exported Avail from Y will look like
1048         X.T{X.T, Y.MkT}
1049 That is, in Y, 
1050   - only MkT is brought into scope by the data instance;
1051   - but the parent (used for grouping and naming in T(..) exports) is X.T
1052   - and in this case we export X.T too
1053
1054 In the result of MkIfaceExports, the names are grouped by defining module,
1055 so we may need to split up a single Avail into multiple ones.
1056
1057
1058 %************************************************************************
1059 %*                                                                      *
1060         Load the old interface file for this module (unless
1061         we have it aleady), and check whether it is up to date
1062         
1063 %*                                                                      *
1064 %************************************************************************
1065
1066 \begin{code}
1067 checkOldIface :: HscEnv
1068               -> ModSummary
1069               -> Bool                   -- Source unchanged
1070               -> Maybe ModIface         -- Old interface from compilation manager, if any
1071               -> IO (RecompileRequired, Maybe ModIface)
1072
1073 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1074   = do  { showPass (hsc_dflags hsc_env) 
1075                    ("Checking old interface for " ++ 
1076                         showSDoc (ppr (ms_mod mod_summary))) ;
1077
1078         ; initIfaceCheck hsc_env $
1079           check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1080      }
1081
1082 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1083                 -> IfG (Bool, Maybe ModIface)
1084 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1085  =  do  -- CHECK WHETHER THE SOURCE HAS CHANGED
1086     { when (not source_unchanged)
1087            (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1088
1089      -- If the source has changed and we're in interactive mode, avoid reading
1090      -- an interface; just return the one we might have been supplied with.
1091     ; let dflags = hsc_dflags hsc_env
1092     ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1093          return (outOfDate, maybe_iface)
1094       else
1095       case maybe_iface of {
1096         Just old_iface -> do -- Use the one we already have
1097           { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1098           ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1099           ; return (recomp, Just old_iface) }
1100
1101       ; Nothing -> do
1102
1103         -- Try and read the old interface for the current module
1104         -- from the .hi file left from the last time we compiled it
1105     { let iface_path = msHiFilePath mod_summary
1106     ; read_result <- readIface (ms_mod mod_summary) iface_path False
1107     ; case read_result of {
1108          Failed err -> do       -- Old interface file not found, or garbled; give up
1109                 { traceIf (text "FYI: cannot read old interface file:"
1110                                  $$ nest 4 err)
1111                 ; return (outOfDate, Nothing) }
1112
1113       ;  Succeeded iface -> do
1114
1115         -- We have got the old iface; check its versions
1116     { traceIf (text "Read the interface file" <+> text iface_path)
1117     ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1118     ; return (recomp, Just iface)
1119     }}}}}
1120
1121 \end{code}
1122
1123 @recompileRequired@ is called from the HscMain.   It checks whether
1124 a recompilation is required.  It needs access to the persistent state,
1125 finder, etc, because it may have to load lots of interface files to
1126 check their versions.
1127
1128 \begin{code}
1129 type RecompileRequired = Bool
1130 upToDate, outOfDate :: Bool
1131 upToDate  = False       -- Recompile not required
1132 outOfDate = True        -- Recompile required
1133
1134 checkVersions :: HscEnv
1135               -> Bool           -- True <=> source unchanged
1136               -> ModSummary
1137               -> ModIface       -- Old interface
1138               -> IfG RecompileRequired
1139 checkVersions hsc_env source_unchanged mod_summary iface
1140   | not source_unchanged
1141   = return outOfDate
1142   | otherwise
1143   = do  { traceHiDiffs (text "Considering whether compilation is required for" <+> 
1144                         ppr (mi_module iface) <> colon)
1145
1146         ; recomp <- checkDependencies hsc_env mod_summary iface
1147         ; if recomp then return outOfDate else do {
1148
1149         -- Source code unchanged and no errors yet... carry on 
1150         --
1151         -- First put the dependent-module info, read from the old
1152         -- interface, into the envt, so that when we look for
1153         -- interfaces we look for the right one (.hi or .hi-boot)
1154         -- 
1155         -- It's just temporary because either the usage check will succeed 
1156         -- (in which case we are done with this module) or it'll fail (in which
1157         -- case we'll compile the module from scratch anyhow).
1158         --      
1159         -- We do this regardless of compilation mode, although in --make mode
1160         -- all the dependent modules should be in the HPT already, so it's
1161         -- quite redundant
1162           updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
1163
1164         ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1165         ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1166     }}
1167   where
1168         -- This is a bit of a hack really
1169     mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1170     mod_deps = mkModDeps (dep_mods (mi_deps iface))
1171
1172
1173 -- If the direct imports of this module are resolved to targets that
1174 -- are not among the dependencies of the previous interface file,
1175 -- then we definitely need to recompile.  This catches cases like
1176 --   - an exposed package has been upgraded
1177 --   - we are compiling with different package flags
1178 --   - a home module that was shadowing a package module has been removed
1179 --   - a new home module has been added that shadows a package module
1180 -- See bug #1372.
1181 --
1182 -- Returns True if recompilation is required.
1183 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1184 checkDependencies hsc_env summary iface
1185  = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1186   where
1187    prev_dep_mods = dep_mods (mi_deps iface)
1188    prev_dep_pkgs = dep_pkgs (mi_deps iface)
1189
1190    this_pkg = thisPackage (hsc_dflags hsc_env)
1191
1192    orM = foldr f (return False)
1193     where f m rest = do b <- m; if b then return True else rest
1194
1195    dep_missing (L _ mod) = do
1196      find_res <- liftIO $ findImportedModule hsc_env mod Nothing
1197      case find_res of
1198         Found _ mod
1199           | pkg == this_pkg
1200            -> if moduleName mod `notElem` map fst prev_dep_mods
1201                  then do traceHiDiffs $
1202                            text "imported module " <> quotes (ppr mod) <>
1203                            text " not among previous dependencies"
1204                          return outOfDate
1205                  else
1206                          return upToDate
1207           | otherwise
1208            -> if pkg `notElem` prev_dep_pkgs
1209                  then do traceHiDiffs $
1210                            text "imported module " <> quotes (ppr mod) <>
1211                            text " is from package " <> quotes (ppr pkg) <>
1212                            text ", which is not among previous dependencies"
1213                          return outOfDate
1214                  else
1215                          return upToDate
1216            where pkg = modulePackageId mod
1217         _otherwise  -> return outOfDate
1218
1219 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1220               -> IfG RecompileRequired
1221 needInterface mod continue
1222   = do  -- Load the imported interface if possible
1223     let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1224     traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1225
1226     mb_iface <- loadInterface doc_str mod ImportBySystem
1227         -- Load the interface, but don't complain on failure;
1228         -- Instead, get an Either back which we can test
1229
1230     case mb_iface of
1231         Failed _ ->  (out_of_date (sep [ptext (sLit "Couldn't load interface for module"), 
1232                                        ppr mod]));
1233                 -- Couldn't find or parse a module mentioned in the
1234                 -- old interface file.  Don't complain: it might
1235                 -- just be that the current module doesn't need that
1236                 -- import and it's been deleted
1237         Succeeded iface -> continue iface
1238
1239
1240 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1241 -- Given the usage information extracted from the old
1242 -- M.hi file for the module being compiled, figure out
1243 -- whether M needs to be recompiled.
1244
1245 checkModUsage _this_pkg UsagePackageModule{
1246                                 usg_mod = mod,
1247                                 usg_mod_hash = old_mod_hash }
1248   = needInterface mod $ \iface -> do
1249     checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1250         -- We only track the ABI hash of package modules, rather than
1251         -- individual entity usages, so if the ABI hash changes we must
1252         -- recompile.  This is safe but may entail more recompilation when
1253         -- a dependent package has changed.
1254
1255 checkModUsage this_pkg UsageHomeModule{ 
1256                                 usg_mod_name = mod_name, 
1257                                 usg_mod_hash = old_mod_hash,
1258                                 usg_exports = maybe_old_export_hash,
1259                                 usg_entities = old_decl_hash }
1260   = do
1261     let mod = mkModule this_pkg mod_name
1262     needInterface mod $ \iface -> do
1263
1264     let
1265         new_mod_hash    = mi_mod_hash    iface
1266         new_decl_hash   = mi_hash_fn     iface
1267         new_export_hash = mi_exp_hash    iface
1268
1269         -- CHECK MODULE
1270     recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1271     if not recompile then return upToDate else do
1272                                  
1273         -- CHECK EXPORT LIST
1274     checkMaybeHash maybe_old_export_hash new_export_hash
1275         (ptext (sLit "  Export list changed")) $ do
1276
1277         -- CHECK ITEMS ONE BY ONE
1278     recompile <- checkList [ checkEntityUsage new_decl_hash u 
1279                            | u <- old_decl_hash]
1280     if recompile 
1281       then return outOfDate     -- This one failed, so just bail out now
1282       else up_to_date (ptext (sLit "  Great!  The bits I use are up to date"))
1283
1284 ------------------------
1285 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1286 checkModuleFingerprint old_mod_hash new_mod_hash
1287   | new_mod_hash == old_mod_hash
1288   = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1289
1290   | otherwise
1291   = out_of_date_hash (ptext (sLit "  Module fingerprint has changed"))
1292                      old_mod_hash new_mod_hash
1293
1294 ------------------------
1295 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1296                -> IfG RecompileRequired -> IfG RecompileRequired
1297 checkMaybeHash maybe_old_hash new_hash doc continue
1298   | Just hash <- maybe_old_hash, hash /= new_hash
1299   = out_of_date_hash doc hash new_hash
1300   | otherwise
1301   = continue
1302
1303 ------------------------
1304 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1305                  -> (OccName, Fingerprint)
1306                  -> IfG Bool
1307 checkEntityUsage new_hash (name,old_hash)
1308   = case new_hash name of
1309
1310         Nothing       ->        -- We used it before, but it ain't there now
1311                           out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1312
1313         Just (_, new_hash)      -- It's there, but is it up to date?
1314           | new_hash == old_hash -> do traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_hash))
1315                                        return upToDate
1316           | otherwise            -> out_of_date_hash (ptext (sLit "  Out of date:") <+> ppr name)
1317                                                      old_hash new_hash
1318
1319 up_to_date, out_of_date :: SDoc -> IfG Bool
1320 up_to_date  msg = traceHiDiffs msg >> return upToDate
1321 out_of_date msg = traceHiDiffs msg >> return outOfDate
1322
1323 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1324 out_of_date_hash msg old_hash new_hash 
1325   = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1326
1327 ----------------------
1328 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1329 -- This helper is used in two places
1330 checkList []             = return upToDate
1331 checkList (check:checks) = do recompile <- check
1332                               if recompile
1333                                 then return outOfDate
1334                                 else checkList checks
1335 \end{code}
1336
1337 %************************************************************************
1338 %*                                                                      *
1339                 Converting things to their Iface equivalents
1340 %*                                                                      *
1341 %************************************************************************
1342
1343 \begin{code}
1344 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1345 -- Assumption: the thing is already tidied, so that locally-bound names
1346 --             (lambdas, for-alls) already have non-clashing OccNames
1347 -- Reason: Iface stuff uses OccNames, and the conversion here does
1348 --         not do tidying on the way
1349 tyThingToIfaceDecl (AnId id)
1350   = IfaceId { ifName   = getOccName id,
1351               ifType   = toIfaceType (idType id),
1352               ifIdInfo = info }
1353   where
1354     info = case toIfaceIdInfo (idInfo id) of
1355                 []    -> NoInfo
1356                 items -> HasInfo items
1357
1358 tyThingToIfaceDecl (AClass clas)
1359   = IfaceClass { ifCtxt   = toIfaceContext sc_theta,
1360                  ifName   = getOccName clas,
1361                  ifTyVars = toIfaceTvBndrs clas_tyvars,
1362                  ifFDs    = map toIfaceFD clas_fds,
1363                  ifATs    = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1364                  ifSigs   = map toIfaceClassOp op_stuff,
1365                  ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
1366   where
1367     (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff) 
1368       = classExtraBigSig clas
1369     tycon = classTyCon clas
1370
1371     toIfaceClassOp (sel_id, def_meth)
1372         = ASSERT(sel_tyvars == clas_tyvars)
1373           IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1374         where
1375                 -- Be careful when splitting the type, because of things
1376                 -- like         class Foo a where
1377                 --                op :: (?x :: String) => a -> a
1378                 -- and          class Baz a where
1379                 --                op :: (Ord a) => a -> a
1380           (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1381           op_ty                = funResultTy rho_ty
1382
1383     toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1384
1385 tyThingToIfaceDecl (ATyCon tycon)
1386   | isSynTyCon tycon
1387   = IfaceSyn {  ifName    = getOccName tycon,
1388                 ifTyVars  = toIfaceTvBndrs tyvars,
1389                 ifOpenSyn = syn_isOpen,
1390                 ifSynRhs  = toIfaceType syn_tyki,
1391                 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1392              }
1393
1394   | isAlgTyCon tycon
1395   = IfaceData { ifName    = getOccName tycon,
1396                 ifTyVars  = toIfaceTvBndrs tyvars,
1397                 ifCtxt    = toIfaceContext (tyConStupidTheta tycon),
1398                 ifCons    = ifaceConDecls (algTyConRhs tycon),
1399                 ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
1400                 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1401                 ifGeneric = tyConHasGenerics tycon,
1402                 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1403
1404   | isForeignTyCon tycon
1405   = IfaceForeign { ifName    = getOccName tycon,
1406                    ifExtName = tyConExtName tycon }
1407
1408   | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1409   where
1410     tyvars = tyConTyVars tycon
1411     (syn_isOpen, syn_tyki) = case synTyConRhs tycon of
1412                                OpenSynTyCon ki _ -> (True , ki)
1413                                SynonymTyCon ty   -> (False, ty)
1414
1415     ifaceConDecls (NewTyCon { data_con = con })     = 
1416       IfNewTyCon  (ifaceConDecl con)
1417     ifaceConDecls (DataTyCon { data_cons = cons })  = 
1418       IfDataTyCon (map ifaceConDecl cons)
1419     ifaceConDecls OpenTyCon {}                      = IfOpenDataTyCon
1420     ifaceConDecls AbstractTyCon                     = IfAbstractTyCon
1421         -- The last case happens when a TyCon has been trimmed during tidying
1422         -- Furthermore, tyThingToIfaceDecl is also used
1423         -- in TcRnDriver for GHCi, when browsing a module, in which case the
1424         -- AbstractTyCon case is perfectly sensible.
1425
1426     ifaceConDecl data_con 
1427         = IfCon   { ifConOcc     = getOccName (dataConName data_con),
1428                     ifConInfix   = dataConIsInfix data_con,
1429                     ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1430                     ifConExTvs   = toIfaceTvBndrs (dataConExTyVars data_con),
1431                     ifConEqSpec  = to_eq_spec (dataConEqSpec data_con),
1432                     ifConCtxt    = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1433                     ifConArgTys  = map toIfaceType (dataConOrigArgTys data_con),
1434                     ifConFields  = map getOccName 
1435                                        (dataConFieldLabels data_con),
1436                     ifConStricts = dataConStrictMarks data_con }
1437
1438     to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1439
1440     famInstToIface Nothing                    = Nothing
1441     famInstToIface (Just (famTyCon, instTys)) = 
1442       Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1443
1444 tyThingToIfaceDecl (ADataCon dc)
1445  = pprPanic "toIfaceDecl" (ppr dc)      -- Should be trimmed out earlier
1446
1447
1448 getFS :: NamedThing a => a -> FastString
1449 getFS x = occNameFS (getOccName x)
1450
1451 --------------------------
1452 instanceToIfaceInst :: Instance -> IfaceInst
1453 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1454                                 is_cls = cls_name, is_tcs = mb_tcs })
1455   = ASSERT( cls_name == className cls )
1456     IfaceInst { ifDFun    = dfun_name,
1457                 ifOFlag   = oflag,
1458                 ifInstCls = cls_name,
1459                 ifInstTys = map do_rough mb_tcs,
1460                 ifInstOrph = orph }
1461   where
1462     do_rough Nothing  = Nothing
1463     do_rough (Just n) = Just (toIfaceTyCon_name n)
1464
1465     dfun_name = idName dfun_id
1466     mod       = nameModule dfun_name
1467     is_local name = nameIsLocalOrFrom mod name
1468
1469         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
1470     (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1471                 -- Slightly awkward: we need the Class to get the fundeps
1472     (tvs, fds) = classTvsFds cls
1473     arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1474     orph | is_local cls_name = Just (nameOccName cls_name)
1475          | all isJust mb_ns  = head mb_ns
1476          | otherwise         = Nothing
1477     
1478     mb_ns :: [Maybe OccName]    -- One for each fundep; a locally-defined name
1479                                 -- that is not in the "determined" arguments
1480     mb_ns | null fds   = [choose_one arg_names]
1481           | otherwise  = map do_one fds
1482     do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1483                                           , not (tv `elem` rtvs)]
1484
1485     choose_one :: [NameSet] -> Maybe OccName
1486     choose_one nss = case nameSetToList (unionManyNameSets nss) of
1487                         []      -> Nothing
1488                         (n : _) -> Just (nameOccName n)
1489
1490 --------------------------
1491 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1492 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1493                                  fi_fam = fam,
1494                                  fi_tcs = mb_tcs })
1495   = IfaceFamInst { ifFamInstTyCon  = toIfaceTyCon tycon
1496                  , ifFamInstFam    = fam
1497                  , ifFamInstTys    = map do_rough mb_tcs }
1498   where
1499     do_rough Nothing  = Nothing
1500     do_rough (Just n) = Just (toIfaceTyCon_name n)
1501
1502 --------------------------
1503 toIfaceLetBndr :: Id -> IfaceLetBndr
1504 toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
1505                                (toIfaceType (idType id)) 
1506                                prag_info
1507   where
1508         -- Stripped-down version of tcIfaceIdInfo
1509         -- Change this if you want to export more IdInfo for
1510         -- non-top-level Ids.  Don't forget to change
1511         -- CoreTidy.tidyLetBndr too!
1512         --
1513         -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1514     id_info = idInfo id
1515     inline_prag = inlinePragInfo id_info
1516     prag_info | isAlwaysActive inline_prag = NoInfo
1517               | otherwise                  = HasInfo [HsInline inline_prag]
1518
1519 --------------------------
1520 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1521 toIfaceIdInfo id_info
1522   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, 
1523                inline_hsinfo, wrkr_hsinfo,  unfold_hsinfo] 
1524   where
1525     ------------  Arity  --------------
1526     arity_info = arityInfo id_info
1527     arity_hsinfo | arity_info == 0 = Nothing
1528                  | otherwise       = Just (HsArity arity_info)
1529
1530     ------------ Caf Info --------------
1531     caf_info   = cafInfo id_info
1532     caf_hsinfo = case caf_info of
1533                    NoCafRefs -> Just HsNoCafRefs
1534                    _other    -> Nothing
1535
1536     ------------  Strictness  --------------
1537         -- No point in explicitly exporting TopSig
1538     strict_hsinfo = case newStrictnessInfo id_info of
1539                         Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1540                         _other                        -> Nothing
1541
1542     ------------  Worker  --------------
1543     work_info   = workerInfo id_info
1544     has_worker  = workerExists work_info
1545     wrkr_hsinfo = case work_info of
1546                     HasWorker work_id wrap_arity -> 
1547                         Just (HsWorker ((idName work_id)) wrap_arity)
1548                     NoWorker -> Nothing
1549
1550     ------------  Unfolding  --------------
1551     -- The unfolding is redundant if there is a worker
1552     unfold_info  = unfoldingInfo id_info
1553     rhs          = unfoldingTemplate unfold_info
1554     no_unfolding = neverUnfold unfold_info
1555                         -- The CoreTidy phase retains unfolding info iff
1556                         -- we want to expose the unfolding, taking into account
1557                         -- unconditional NOINLINE, etc.  See TidyPgm.addExternal
1558     unfold_hsinfo | no_unfolding = Nothing                      
1559                   | has_worker   = Nothing      -- Unfolding is implicit
1560                   | otherwise    = Just (HsUnfold (toIfaceExpr rhs))
1561                                         
1562     ------------  Inline prag  --------------
1563     inline_prag = inlinePragInfo id_info
1564     inline_hsinfo | isAlwaysActive inline_prag     = Nothing
1565                   | no_unfolding && not has_worker = Nothing
1566                         -- If the iface file give no unfolding info, we 
1567                         -- don't need to say when inlining is OK!
1568                   | otherwise                      = Just (HsInline inline_prag)
1569
1570 --------------------------
1571 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1572 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1573   = pprTrace "toHsRule: builtin" (ppr fn) $
1574     bogusIfaceRule fn
1575
1576 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn, 
1577                                 ru_act = act, ru_bndrs = bndrs,
1578                                 ru_args = args, ru_rhs = rhs })
1579   = IfaceRule { ifRuleName  = name, ifActivation = act, 
1580                 ifRuleBndrs = map toIfaceBndr bndrs,
1581                 ifRuleHead  = fn, 
1582                 ifRuleArgs  = map do_arg args,
1583                 ifRuleRhs   = toIfaceExpr rhs,
1584                 ifRuleOrph  = orph }
1585   where
1586         -- For type args we must remove synonyms from the outermost
1587         -- level.  Reason: so that when we read it back in we'll
1588         -- construct the same ru_rough field as we have right now;
1589         -- see tcIfaceRule
1590     do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1591     do_arg arg       = toIfaceExpr arg
1592
1593         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
1594         -- A rule is an orphan only if none of the variables
1595         -- mentioned on its left-hand side are locally defined
1596     lhs_names = fn : nameSetToList (exprsFreeNames args)
1597                 -- No need to delete bndrs, because
1598                 -- exprsFreeNames finds only External names
1599
1600     orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1601                         (n : _) -> Just (nameOccName n)
1602                         []      -> Nothing
1603
1604 bogusIfaceRule :: Name -> IfaceRule
1605 bogusIfaceRule id_name
1606   = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,  
1607         ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [], 
1608         ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1609
1610 ---------------------
1611 toIfaceExpr :: CoreExpr -> IfaceExpr
1612 toIfaceExpr (Var v)       = toIfaceVar v
1613 toIfaceExpr (Lit l)       = IfaceLit l
1614 toIfaceExpr (Type ty)     = IfaceType (toIfaceType ty)
1615 toIfaceExpr (Lam x b)     = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1616 toIfaceExpr (App f a)     = toIfaceApp f [a]
1617 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1618 toIfaceExpr (Let b e)     = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1619 toIfaceExpr (Cast e co)   = IfaceCast (toIfaceExpr e) (toIfaceType co)
1620 toIfaceExpr (Note n e)    = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1621
1622 ---------------------
1623 toIfaceNote :: Note -> IfaceNote
1624 toIfaceNote (SCC cc)      = IfaceSCC cc
1625 toIfaceNote InlineMe      = IfaceInlineMe
1626 toIfaceNote (CoreNote s)  = IfaceCoreNote s
1627
1628 ---------------------
1629 toIfaceBind :: Bind Id -> IfaceBinding
1630 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1631 toIfaceBind (Rec prs)    = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1632
1633 ---------------------
1634 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1635            -> (IfaceConAlt, [FastString], IfaceExpr)
1636 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1637
1638 ---------------------
1639 toIfaceCon :: AltCon -> IfaceConAlt
1640 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1641                         | otherwise       = IfaceDataAlt (getName dc)
1642                         where
1643                           tc = dataConTyCon dc
1644            
1645 toIfaceCon (LitAlt l) = IfaceLitAlt l
1646 toIfaceCon DEFAULT    = IfaceDefault
1647
1648 ---------------------
1649 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1650 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1651 toIfaceApp (Var v) as
1652   = case isDataConWorkId_maybe v of
1653         -- We convert the *worker* for tuples into IfaceTuples
1654         Just dc |  isTupleTyCon tc && saturated 
1655                 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1656           where
1657             val_args  = dropWhile isTypeArg as
1658             saturated = val_args `lengthIs` idArity v
1659             tup_args  = map toIfaceExpr val_args
1660             tc        = dataConTyCon dc
1661
1662         _ -> mkIfaceApps (toIfaceVar v) as
1663
1664 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1665
1666 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1667 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1668
1669 ---------------------
1670 toIfaceVar :: Id -> IfaceExpr
1671 toIfaceVar v 
1672   | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1673           -- Foreign calls have special syntax
1674   | isExternalName name             = IfaceExt name
1675   | Just (TickBox m ix) <- isTickBoxOp_maybe v
1676                                     = IfaceTick m ix
1677   | otherwise                       = IfaceLcl (getFS name)
1678   where
1679     name = idName v
1680 \end{code}