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