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