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