Fix #481: use a safe recompilation check when Template Haskell is
[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    --   - XXX vect info?
552    mod_hash <- computeFingerprint putNameLiterally
553                       (map fst sorted_decls,
554                        export_hash,
555                        orphan_hash,
556                        mi_warns iface0)
557
558    -- The interface hash depends on:
559    --    - the ABI hash, plus
560    --    - usages
561    --    - deps
562    --    - hpc
563    iface_hash <- computeFingerprint putNameLiterally
564                       (mod_hash, 
565                        mi_usages iface0,
566                        sorted_deps,
567                        mi_hpc iface0)
568
569    let
570     no_change_at_all = Just iface_hash == mb_old_fingerprint
571
572     final_iface = iface0 {
573                 mi_mod_hash    = mod_hash,
574                 mi_iface_hash  = iface_hash,
575                 mi_exp_hash    = export_hash,
576                 mi_orphan_hash = orphan_hash,
577                 mi_orphan      = not (null orph_rules && null orph_insts),
578                 mi_finsts      = not . null $ mi_fam_insts iface0,
579                 mi_decls       = sorted_decls,
580                 mi_hash_fn     = lookupOccEnv local_env }
581    --
582    return (final_iface, no_change_at_all)
583
584   where
585     this_mod = mi_module iface0
586     dflags = hsc_dflags hsc_env
587     this_pkg = thisPackage dflags
588     (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
589     (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
590         -- ToDo: shouldn't we be splitting fam_insts into orphans and
591         -- non-orphans?
592     fam_insts = mi_fam_insts iface0
593     fix_fn = mi_fix_fn iface0
594
595
596 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
597 getOrphanHashes hsc_env mods = do
598   eps <- hscEPS hsc_env
599   let 
600     hpt        = hsc_HPT hsc_env
601     pit        = eps_PIT eps
602     dflags     = hsc_dflags hsc_env
603     get_orph_hash mod = 
604           case lookupIfaceByModule dflags hpt pit mod of
605             Nothing    -> pprPanic "moduleOrphanHash" (ppr mod)
606             Just iface -> mi_orphan_hash iface
607   --
608   return (map get_orph_hash mods)
609
610
611 sortDependencies :: Dependencies -> Dependencies
612 sortDependencies d
613  = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
614           dep_pkgs   = sortBy (stablePackageIdCmp `on` fst) (dep_pkgs d),
615           dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
616           dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
617 \end{code}
618
619
620 %************************************************************************
621 %*                                                                      *
622           The ABI of an IfaceDecl                                                                               
623 %*                                                                      *
624 %************************************************************************
625
626 Note [The ABI of an IfaceDecl]
627 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
628 The ABI of a declaration consists of:
629
630    (a) the full name of the identifier (inc. module and package,
631        because these are used to construct the symbol name by which
632        the identifier is known externally).
633
634    (b) the declaration itself, as exposed to clients.  That is, the
635        definition of an Id is included in the fingerprint only if
636        it is made available as as unfolding in the interface.
637
638    (c) the fixity of the identifier
639    (d) for Ids: rules
640    (e) for classes: instances, fixity & rules for methods
641    (f) for datatypes: instances, fixity & rules for constrs
642
643 Items (c)-(f) are not stored in the IfaceDecl, but instead appear
644 elsewhere in the interface file.  But they are *fingerprinted* with
645 the declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
646 and fingerprinting that as part of the declaration.
647
648 \begin{code}
649 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
650
651 data IfaceDeclExtras 
652   = IfaceIdExtras    Fixity [IfaceRule]
653   | IfaceDataExtras  Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
654   | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
655   | IfaceSynExtras   Fixity
656   | IfaceOtherDeclExtras
657
658 abiDecl :: IfaceDeclABI -> IfaceDecl
659 abiDecl (_, decl, _) = decl
660
661 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
662 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare` 
663                          ifName (abiDecl abi2)
664
665 freeNamesDeclABI :: IfaceDeclABI -> NameSet
666 freeNamesDeclABI (_mod, decl, extras) =
667   freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
668
669 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
670 freeNamesDeclExtras (IfaceIdExtras    _ rules)
671   = unionManyNameSets (map freeNamesIfRule rules)
672 freeNamesDeclExtras (IfaceDataExtras  _ insts subs)
673   = unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
674 freeNamesDeclExtras (IfaceClassExtras _ insts subs)
675   = unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
676 freeNamesDeclExtras (IfaceSynExtras _)
677   = emptyNameSet
678 freeNamesDeclExtras IfaceOtherDeclExtras
679   = emptyNameSet
680
681 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
682 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
683
684 instance Outputable IfaceDeclExtras where
685   ppr IfaceOtherDeclExtras       = empty
686   ppr (IfaceIdExtras  fix rules) = ppr_id_extras fix rules
687   ppr (IfaceSynExtras fix)       = ppr fix
688   ppr (IfaceDataExtras fix insts stuff)  = vcat [ppr fix, ppr_insts insts,
689                                                  ppr_id_extras_s stuff]
690   ppr (IfaceClassExtras fix insts stuff) = vcat [ppr fix, ppr_insts insts,
691                                                  ppr_id_extras_s stuff]
692
693 ppr_insts :: [IfaceInstABI] -> SDoc
694 ppr_insts _ = ptext (sLit "<insts>")
695
696 ppr_id_extras_s :: [(Fixity, [IfaceRule])] -> SDoc
697 ppr_id_extras_s stuff = vcat [ppr_id_extras f r | (f,r)<- stuff]
698
699 ppr_id_extras :: Fixity -> [IfaceRule] -> SDoc
700 ppr_id_extras fix rules = ppr fix $$ vcat (map ppr rules)
701
702 -- This instance is used only to compute fingerprints
703 instance Binary IfaceDeclExtras where
704   get _bh = panic "no get for IfaceDeclExtras"
705   put_ bh (IfaceIdExtras fix rules) = do
706    putByte bh 1; put_ bh fix; put_ bh rules
707   put_ bh (IfaceDataExtras fix insts cons) = do
708    putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
709   put_ bh (IfaceClassExtras fix insts methods) = do
710    putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
711   put_ bh (IfaceSynExtras fix) = do
712    putByte bh 4; put_ bh fix
713   put_ bh IfaceOtherDeclExtras = do
714    putByte bh 5
715
716 declExtras :: (OccName -> Fixity)
717            -> OccEnv [IfaceRule]
718            -> OccEnv [IfaceInst]
719            -> IfaceDecl
720            -> IfaceDeclExtras
721
722 declExtras fix_fn rule_env inst_env decl
723   = case decl of
724       IfaceId{} -> IfaceIdExtras (fix_fn n) 
725                         (lookupOccEnvL rule_env n)
726       IfaceData{ifCons=cons} -> 
727                      IfaceDataExtras (fix_fn n)
728                         (map ifDFun $ lookupOccEnvL inst_env n)
729                         (map (id_extras . ifConOcc) (visibleIfConDecls cons))
730       IfaceClass{ifSigs=sigs} -> 
731                      IfaceClassExtras (fix_fn n)
732                         (map ifDFun $ lookupOccEnvL inst_env n)
733                         [id_extras op | IfaceClassOp op _ _ <- sigs]
734       IfaceSyn{} -> IfaceSynExtras (fix_fn n)
735       _other -> IfaceOtherDeclExtras
736   where
737         n = ifName decl
738         id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
739
740 --
741 -- When hashing an instance, we hash only the DFunId, because that
742 -- depends on all the information about the instance.
743 --
744 type IfaceInstABI = IfExtName
745
746 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
747 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
748
749 -- used when we want to fingerprint a structure without depending on the
750 -- fingerprints of external Names that it refers to.
751 putNameLiterally :: BinHandle -> Name -> IO ()
752 putNameLiterally bh name = ASSERT( isExternalName name ) 
753   do { put_ bh $! nameModule name
754      ; put_ bh $! nameOccName name }
755
756 {-
757 -- for testing: use the md5sum command to generate fingerprints and
758 -- compare the results against our built-in version.
759   fp' <- oldMD5 dflags bh
760   if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
761                else return fp
762
763 oldMD5 dflags bh = do
764   tmp <- newTempName dflags "bin"
765   writeBinMem bh tmp
766   tmp2 <- newTempName dflags "md5"
767   let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
768   r <- system cmd
769   case r of
770     ExitFailure _ -> ghcError (PhaseFailed cmd r)
771     ExitSuccess -> do
772         hash_str <- readFile tmp2
773         return $! readHexFingerprint hash_str
774 -}
775
776 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
777 instOrphWarn unqual inst
778   = mkWarnMsg (getSrcSpan inst) unqual $
779     hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
780
781 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
782 ruleOrphWarn unqual mod rule
783   = mkWarnMsg silly_loc unqual $
784     ptext (sLit "Orphan rule:") <+> ppr rule
785   where
786     silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
787     -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
788     -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
789
790 ----------------------
791 -- mkOrphMap partitions instance decls or rules into
792 --      (a) an OccEnv for ones that are not orphans, 
793 --          mapping the local OccName to a list of its decls
794 --      (b) a list of orphan decls
795 mkOrphMap :: (decl -> Maybe OccName)    -- (Just occ) for a non-orphan decl, keyed by occ
796                                         -- Nothing for an orphan decl
797           -> [decl]                     -- Sorted into canonical order
798           -> (OccEnv [decl],            -- Non-orphan decls associated with their key;
799                                         --      each sublist in canonical order
800               [decl])                   -- Orphan decls; in canonical order
801 mkOrphMap get_key decls
802   = foldl go (emptyOccEnv, []) decls
803   where
804     go (non_orphs, orphs) d
805         | Just occ <- get_key d
806         = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
807         | otherwise = (non_orphs, d:orphs)
808 \end{code}
809
810
811 %************************************************************************
812 %*                                                                      *
813        Keeping track of what we've slurped, and fingerprints
814 %*                                                                      *
815 %************************************************************************
816
817 \begin{code}
818 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
819 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
820   = do  { eps <- hscEPS hsc_env
821         ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
822                                      dir_imp_mods used_names
823         ; usages `seqList`  return usages }
824          -- seq the list of Usages returned: occasionally these
825          -- don't get evaluated for a while and we can end up hanging on to
826          -- the entire collection of Ifaces.
827
828 mk_usage_info :: PackageIfaceTable
829               -> HscEnv
830               -> Module
831               -> ImportedMods
832               -> NameSet
833               -> [Usage]
834 mk_usage_info pit hsc_env this_mod direct_imports used_names
835   = mapCatMaybes mkUsage usage_mods
836   where
837     hpt = hsc_HPT hsc_env
838     dflags = hsc_dflags hsc_env
839     this_pkg = thisPackage dflags
840
841     used_mods    = moduleEnvKeys ent_map
842     dir_imp_mods = (moduleEnvKeys direct_imports)
843     all_mods     = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
844     usage_mods   = sortBy stableModuleCmp all_mods
845                         -- canonical order is imported, to avoid interface-file
846                         -- wobblage.
847
848     -- ent_map groups together all the things imported and used
849     -- from a particular module
850     ent_map :: ModuleEnv [OccName]
851     ent_map  = foldNameSet add_mv emptyModuleEnv used_names
852      where
853       add_mv name mv_map
854         | isWiredInName name = mv_map  -- ignore wired-in names
855         | otherwise
856         = case nameModule_maybe name of
857              Nothing  -> pprPanic "mkUsageInfo: internal name?" (ppr name)
858              Just mod -> -- This lambda function is really just a
859                          -- specialised (++); originally came about to
860                          -- avoid quadratic behaviour (trac #2680)
861                          extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod [occ]
862                    where occ = nameOccName name
863     
864     -- We want to create a Usage for a home module if 
865     --  a) we used something from it; has something in used_names
866     --  b) we imported it, even if we used nothing from it
867     --     (need to recompile if its export list changes: export_fprint)
868     mkUsage :: Module -> Maybe Usage
869     mkUsage mod
870       | isNothing maybe_iface           -- We can't depend on it if we didn't
871                                         -- load its interface.
872       || mod == this_mod                -- We don't care about usages of
873                                         -- things in *this* module
874       = Nothing
875
876       | modulePackageId mod /= this_pkg
877       = Just UsagePackageModule{ usg_mod      = mod,
878                                  usg_mod_hash = mod_hash,
879                                  usg_safe     = imp_safe }
880         -- for package modules, we record the module hash only
881
882       | (null used_occs
883           && isNothing export_hash
884           && not is_direct_import
885           && not finsts_mod)
886       = Nothing                 -- Record no usage info
887         -- for directly-imported modules, we always want to record a usage
888         -- on the orphan hash.  This is what triggers a recompilation if
889         -- an orphan is added or removed somewhere below us in the future.
890     
891       | otherwise       
892       = Just UsageHomeModule { 
893                       usg_mod_name = moduleName mod,
894                       usg_mod_hash = mod_hash,
895                       usg_exports  = export_hash,
896                       usg_entities = Map.toList ent_hashs,
897                       usg_safe     = imp_safe }
898       where
899         maybe_iface  = lookupIfaceByModule dflags hpt pit mod
900                 -- In one-shot mode, the interfaces for home-package
901                 -- modules accumulate in the PIT not HPT.  Sigh.
902
903         Just iface   = maybe_iface
904         finsts_mod   = mi_finsts    iface
905         hash_env     = mi_hash_fn   iface
906         mod_hash     = mi_mod_hash  iface
907         export_hash | depend_on_exports = Just (mi_exp_hash iface)
908                     | otherwise         = Nothing
909
910         (is_direct_import, imp_safe)
911             = case lookupModuleEnv direct_imports mod of
912                 Just ((_,_,_,safe):_xs) -> (True, safe)
913                 Just _                  -> pprPanic "mkUsage: empty direct import" empty
914                 Nothing                 -> (False, safeImplicitImpsReq dflags)
915                 -- Nothing case is for implicit imports like 'System.IO' when 'putStrLn'
916                 -- is used in the source code. We require them to be safe in Safe Haskell
917     
918         used_occs = lookupModuleEnv ent_map mod `orElse` []
919
920         -- Making a Map here ensures that (a) we remove duplicates
921         -- when we have usages on several subordinates of a single parent,
922         -- and (b) that the usages emerge in a canonical order, which
923         -- is why we use Map rather than OccEnv: Map works
924         -- using Ord on the OccNames, which is a lexicographic ordering.
925         ent_hashs :: Map OccName Fingerprint
926         ent_hashs = Map.fromList (map lookup_occ used_occs)
927         
928         lookup_occ occ = 
929             case hash_env occ of
930                 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
931                 Just r  -> r
932
933         depend_on_exports = is_direct_import
934         {- True
935               Even if we used 'import M ()', we have to register a
936               usage on the export list because we are sensitive to
937               changes in orphan instances/rules.
938            False
939               In GHC 6.8.x we always returned true, and in
940               fact it recorded a dependency on *all* the
941               modules underneath in the dependency tree.  This
942               happens to make orphans work right, but is too
943               expensive: it'll read too many interface files.
944               The 'isNothing maybe_iface' check above saved us
945               from generating many of these usages (at least in
946               one-shot mode), but that's even more bogus!
947         -}
948 \end{code}
949
950 \begin{code}
951 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
952 mkIfaceAnnotations = map mkIfaceAnnotation
953
954 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
955 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation { 
956         ifAnnotatedTarget = fmap nameOccName target,
957         ifAnnotatedValue = serialized
958     }
959 \end{code}
960
961 \begin{code}
962 mkIfaceExports :: [AvailInfo]
963                -> [(Module, [GenAvailInfo OccName])]
964                   -- Group by module and sort by occurrence
965 mkIfaceExports exports
966   = [ (mod, Map.elems avails)
967     | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
968                               (moduleEnvToList groupFM)
969                        -- NB. the Map.toList is in a random order,
970                        -- because Ord Module is not a predictable
971                        -- ordering.  Hence we perform a final sort
972                        -- using the stable Module ordering.
973     ]
974   where
975         -- Group by the module where the exported entities are defined
976         -- (which may not be the same for all Names in an Avail)
977         -- Deliberately use Map rather than UniqFM so we
978         -- get a canonical ordering
979     groupFM :: ModuleEnv (Map FastString (GenAvailInfo OccName))
980     groupFM = foldl add emptyModuleEnv exports
981
982     add_one :: ModuleEnv (Map FastString (GenAvailInfo OccName))
983             -> Module -> GenAvailInfo OccName
984             -> ModuleEnv (Map FastString (GenAvailInfo OccName))
985     add_one env mod avail 
986       -- XXX Is there a need to flip Map.union here?
987       =  extendModuleEnvWith (flip Map.union) env mod 
988                 (Map.singleton (occNameFS (availName avail)) avail)
989
990         -- NB: we should not get T(X) and T(Y) in the export list
991         --     else the Map.union will simply discard one!  They
992         --     should have been combined by now.
993     add env (Avail n)
994       = ASSERT( isExternalName n ) 
995         add_one env (nameModule n) (Avail (nameOccName n))
996
997     add env (AvailTC tc ns)
998       = ASSERT( all isExternalName ns ) 
999         foldl add_for_mod env mods
1000       where
1001         tc_occ = nameOccName tc
1002         mods   = nub (map nameModule ns)
1003                 -- Usually just one, but see Note [Original module]
1004
1005         add_for_mod env mod
1006             = add_one env mod (AvailTC tc_occ (sort names_from_mod))
1007               -- NB. sort the children, we need a canonical order
1008             where
1009               names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
1010 \end{code}
1011
1012 Note [Orignal module]
1013 ~~~~~~~~~~~~~~~~~~~~~
1014 Consider this:
1015         module X where { data family T }
1016         module Y( T(..) ) where { import X; data instance T Int = MkT Int }
1017 The exported Avail from Y will look like
1018         X.T{X.T, Y.MkT}
1019 That is, in Y, 
1020   - only MkT is brought into scope by the data instance;
1021   - but the parent (used for grouping and naming in T(..) exports) is X.T
1022   - and in this case we export X.T too
1023
1024 In the result of MkIfaceExports, the names are grouped by defining module,
1025 so we may need to split up a single Avail into multiple ones.
1026
1027
1028 %************************************************************************
1029 %*                                                                      *
1030         Load the old interface file for this module (unless
1031         we have it aleady), and check whether it is up to date
1032         
1033 %*                                                                      *
1034 %************************************************************************
1035
1036 \begin{code}
1037 checkOldIface :: HscEnv
1038               -> ModSummary
1039               -> SourceModified
1040               -> Maybe ModIface         -- Old interface from compilation manager, if any
1041               -> IO (RecompileRequired, Maybe ModIface)
1042
1043 checkOldIface hsc_env mod_summary source_modified maybe_iface
1044   = do  showPass (hsc_dflags hsc_env) $
1045             "Checking old interface for " ++ (showSDoc $ ppr $ ms_mod mod_summary)
1046         initIfaceCheck hsc_env $
1047             check_old_iface hsc_env mod_summary source_modified maybe_iface
1048
1049 check_old_iface :: HscEnv -> ModSummary -> SourceModified -> Maybe ModIface
1050                 -> IfG (Bool, Maybe ModIface)
1051 check_old_iface hsc_env mod_summary src_modified maybe_iface
1052   = let dflags = hsc_dflags hsc_env
1053         getIface =
1054              case maybe_iface of
1055                  Just _  -> do
1056                      traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1057                      return maybe_iface
1058                  Nothing -> do
1059                      let iface_path = msHiFilePath mod_summary
1060                      read_result <- readIface (ms_mod mod_summary) iface_path False
1061                      case read_result of
1062                          Failed err -> do
1063                              traceIf (text "FYI: cannont read old interface file:" $$ nest 4 err)
1064                              return Nothing
1065                          Succeeded iface -> do
1066                              traceIf (text "Read the interface file" <+> text iface_path)
1067                              return $ Just iface
1068
1069     in do
1070          let src_changed
1071               | dopt Opt_ForceRecomp (hsc_dflags hsc_env) = True
1072               | SourceModified <- src_modified = True
1073               | otherwise = False
1074
1075          when src_changed
1076              (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1077
1078          -- If the source has changed and we're in interactive mode,
1079          -- avoid reading an interface; just return the one we might
1080          -- have been supplied with.
1081          if not (isObjectTarget $ hscTarget dflags) && src_changed
1082             then return (outOfDate, maybe_iface)
1083             else do
1084                 -- Try and read the old interface for the current module
1085                 -- from the .hi file left from the last time we compiled it
1086                 maybe_iface' <- getIface
1087                 if src_changed
1088                    then return (outOfDate, maybe_iface')
1089                    else do
1090                 case maybe_iface' of
1091                     Nothing -> return (outOfDate, maybe_iface')
1092                     Just iface ->
1093                       -- We have got the old iface; check its versions
1094                       -- even in the SourceUnmodifiedAndStable case we
1095                       -- should check versions because some packages
1096                       -- might have changed or gone away.
1097                       checkVersions hsc_env mod_summary iface
1098 \end{code}
1099
1100 @recompileRequired@ is called from the HscMain.   It checks whether
1101 a recompilation is required.  It needs access to the persistent state,
1102 finder, etc, because it may have to load lots of interface files to
1103 check their versions.
1104
1105 \begin{code}
1106 type RecompileRequired = Bool
1107 upToDate, outOfDate :: Bool
1108 upToDate  = False       -- Recompile not required
1109 outOfDate = True        -- Recompile required
1110
1111 -- | Check the safe haskell flags haven't changed
1112 --   (e.g different flag on command line now)
1113 safeHsChanged :: HscEnv -> ModIface -> Bool
1114 safeHsChanged hsc_env iface
1115   = (getSafeMode $ mi_trust iface) /= (safeHaskell $ hsc_dflags hsc_env)
1116
1117 checkVersions :: HscEnv
1118               -> ModSummary
1119               -> ModIface       -- Old interface
1120               -> IfG (RecompileRequired, Maybe ModIface)
1121 checkVersions hsc_env mod_summary iface
1122   = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1123                         ppr (mi_module iface) <> colon)
1124
1125        ; recomp <- checkDependencies hsc_env mod_summary iface
1126        ; if recomp then return (outOfDate, Just iface) else do {
1127        ; if trust_dif then return (outOfDate, Nothing) else do {
1128
1129        -- Source code unchanged and no errors yet... carry on
1130        --
1131        -- First put the dependent-module info, read from the old
1132        -- interface, into the envt, so that when we look for
1133        -- interfaces we look for the right one (.hi or .hi-boot)
1134        --
1135        -- It's just temporary because either the usage check will succeed
1136        -- (in which case we are done with this module) or it'll fail (in which
1137        -- case we'll compile the module from scratch anyhow).
1138        --
1139        -- We do this regardless of compilation mode, although in --make mode
1140        -- all the dependent modules should be in the HPT already, so it's
1141        -- quite redundant
1142        ; updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
1143        ; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1144        ; return (recomp, Just iface)
1145     }}}
1146   where
1147     this_pkg  = thisPackage (hsc_dflags hsc_env)
1148     trust_dif = safeHsChanged hsc_env iface
1149     -- This is a bit of a hack really
1150     mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1151     mod_deps = mkModDeps (dep_mods (mi_deps iface))
1152
1153
1154 -- If the direct imports of this module are resolved to targets that
1155 -- are not among the dependencies of the previous interface file,
1156 -- then we definitely need to recompile.  This catches cases like
1157 --   - an exposed package has been upgraded
1158 --   - we are compiling with different package flags
1159 --   - a home module that was shadowing a package module has been removed
1160 --   - a new home module has been added that shadows a package module
1161 -- See bug #1372.
1162 --
1163 -- Returns True if recompilation is required.
1164 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1165 checkDependencies hsc_env summary iface
1166  = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1167   where
1168    prev_dep_mods = dep_mods (mi_deps iface)
1169    prev_dep_pkgs = dep_pkgs (mi_deps iface)
1170
1171    this_pkg = thisPackage (hsc_dflags hsc_env)
1172
1173    orM = foldr f (return False)
1174     where f m rest = do b <- m; if b then return True else rest
1175
1176    dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _ _)) = do
1177      find_res <- liftIO $ findImportedModule hsc_env mod pkg
1178      case find_res of
1179         Found _ mod
1180           | pkg == this_pkg
1181            -> if moduleName mod `notElem` map fst prev_dep_mods
1182                  then do traceHiDiffs $
1183                            text "imported module " <> quotes (ppr mod) <>
1184                            text " not among previous dependencies"
1185                          return outOfDate
1186                  else
1187                          return upToDate
1188           | otherwise
1189            -> if pkg `notElem` (map fst prev_dep_pkgs)
1190                  then do traceHiDiffs $
1191                            text "imported module " <> quotes (ppr mod) <>
1192                            text " is from package " <> quotes (ppr pkg) <>
1193                            text ", which is not among previous dependencies"
1194                          return outOfDate
1195                  else
1196                          return upToDate
1197            where pkg = modulePackageId mod
1198         _otherwise  -> return outOfDate
1199
1200 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1201               -> IfG RecompileRequired
1202 needInterface mod continue
1203   = do  -- Load the imported interface if possible
1204     let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1205     traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1206
1207     mb_iface <- loadInterface doc_str mod ImportBySystem
1208         -- Load the interface, but don't complain on failure;
1209         -- Instead, get an Either back which we can test
1210
1211     case mb_iface of
1212       Failed _ ->  (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1213                                       ppr mod]))
1214                   -- Couldn't find or parse a module mentioned in the
1215                   -- old interface file.  Don't complain: it might
1216                   -- just be that the current module doesn't need that
1217                   -- import and it's been deleted
1218       Succeeded iface -> continue iface
1219
1220
1221 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1222 -- Given the usage information extracted from the old
1223 -- M.hi file for the module being compiled, figure out
1224 -- whether M needs to be recompiled.
1225
1226 checkModUsage _this_pkg UsagePackageModule{
1227                                 usg_mod = mod,
1228                                 usg_mod_hash = old_mod_hash }
1229   = needInterface mod $ \iface -> do
1230     checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1231         -- We only track the ABI hash of package modules, rather than
1232         -- individual entity usages, so if the ABI hash changes we must
1233         -- recompile.  This is safe but may entail more recompilation when
1234         -- a dependent package has changed.
1235
1236 checkModUsage this_pkg UsageHomeModule{ 
1237                                 usg_mod_name = mod_name, 
1238                                 usg_mod_hash = old_mod_hash,
1239                                 usg_exports = maybe_old_export_hash,
1240                                 usg_entities = old_decl_hash }
1241   = do
1242     let mod = mkModule this_pkg mod_name
1243     needInterface mod $ \iface -> do
1244
1245     let
1246         new_mod_hash    = mi_mod_hash    iface
1247         new_decl_hash   = mi_hash_fn     iface
1248         new_export_hash = mi_exp_hash    iface
1249
1250         -- CHECK MODULE
1251     recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1252     if not recompile then return upToDate else do
1253                                  
1254         -- CHECK EXPORT LIST
1255     checkMaybeHash maybe_old_export_hash new_export_hash
1256         (ptext (sLit "  Export list changed")) $ do
1257
1258         -- CHECK ITEMS ONE BY ONE
1259     recompile <- checkList [ checkEntityUsage new_decl_hash u 
1260                            | u <- old_decl_hash]
1261     if recompile 
1262       then return outOfDate     -- This one failed, so just bail out now
1263       else up_to_date (ptext (sLit "  Great!  The bits I use are up to date"))
1264
1265 ------------------------
1266 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1267 checkModuleFingerprint old_mod_hash new_mod_hash
1268   | new_mod_hash == old_mod_hash
1269   = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1270
1271   | otherwise
1272   = out_of_date_hash (ptext (sLit "  Module fingerprint has changed"))
1273                      old_mod_hash new_mod_hash
1274
1275 ------------------------
1276 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1277                -> IfG RecompileRequired -> IfG RecompileRequired
1278 checkMaybeHash maybe_old_hash new_hash doc continue
1279   | Just hash <- maybe_old_hash, hash /= new_hash
1280   = out_of_date_hash doc hash new_hash
1281   | otherwise
1282   = continue
1283
1284 ------------------------
1285 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1286                  -> (OccName, Fingerprint)
1287                  -> IfG Bool
1288 checkEntityUsage new_hash (name,old_hash)
1289   = case new_hash name of
1290
1291         Nothing       ->        -- We used it before, but it ain't there now
1292                           out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1293
1294         Just (_, new_hash)      -- It's there, but is it up to date?
1295           | new_hash == old_hash -> do traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_hash))
1296                                        return upToDate
1297           | otherwise            -> out_of_date_hash (ptext (sLit "  Out of date:") <+> ppr name)
1298                                                      old_hash new_hash
1299
1300 up_to_date, out_of_date :: SDoc -> IfG Bool
1301 up_to_date  msg = traceHiDiffs msg >> return upToDate
1302 out_of_date msg = traceHiDiffs msg >> return outOfDate
1303
1304 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1305 out_of_date_hash msg old_hash new_hash 
1306   = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1307
1308 ----------------------
1309 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1310 -- This helper is used in two places
1311 checkList []             = return upToDate
1312 checkList (check:checks) = do recompile <- check
1313                               if recompile
1314                                 then return outOfDate
1315                                 else checkList checks
1316 \end{code}
1317
1318 %************************************************************************
1319 %*                                                                      *
1320                 Converting things to their Iface equivalents
1321 %*                                                                      *
1322 %************************************************************************
1323
1324 \begin{code}
1325 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1326 -- Assumption: the thing is already tidied, so that locally-bound names
1327 --             (lambdas, for-alls) already have non-clashing OccNames
1328 -- Reason: Iface stuff uses OccNames, and the conversion here does
1329 --         not do tidying on the way
1330 tyThingToIfaceDecl (AnId id)
1331   = IfaceId { ifName      = getOccName id,
1332               ifType      = toIfaceType (idType id),
1333               ifIdDetails = toIfaceIdDetails (idDetails id),
1334               ifIdInfo    = toIfaceIdInfo (idInfo id) }
1335
1336 tyThingToIfaceDecl (AClass clas)
1337   = IfaceClass { ifCtxt   = toIfaceContext sc_theta,
1338                  ifName   = getOccName clas,
1339                  ifTyVars = toIfaceTvBndrs clas_tyvars,
1340                  ifFDs    = map toIfaceFD clas_fds,
1341                  ifATs    = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1342                  ifSigs   = map toIfaceClassOp op_stuff,
1343                  ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
1344   where
1345     (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff) 
1346       = classExtraBigSig clas
1347     tycon = classTyCon clas
1348
1349     toIfaceClassOp (sel_id, def_meth)
1350         = ASSERT(sel_tyvars == clas_tyvars)
1351           IfaceClassOp (getOccName sel_id) (toDmSpec def_meth) (toIfaceType op_ty)
1352         where
1353                 -- Be careful when splitting the type, because of things
1354                 -- like         class Foo a where
1355                 --                op :: (?x :: String) => a -> a
1356                 -- and          class Baz a where
1357                 --                op :: (Ord a) => a -> a
1358           (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1359           op_ty                = funResultTy rho_ty
1360
1361     toDmSpec NoDefMeth      = NoDM
1362     toDmSpec (GenDefMeth _) = GenericDM
1363     toDmSpec (DefMeth _)    = VanillaDM
1364
1365     toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1366
1367 tyThingToIfaceDecl (ATyCon tycon)
1368   | isSynTyCon tycon
1369   = IfaceSyn {  ifName    = getOccName tycon,
1370                 ifTyVars  = toIfaceTvBndrs tyvars,
1371                 ifSynRhs  = syn_rhs,
1372                 ifSynKind = syn_ki,
1373                 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1374              }
1375
1376   | isAlgTyCon tycon
1377   = IfaceData { ifName    = getOccName tycon,
1378                 ifTyVars  = toIfaceTvBndrs tyvars,
1379                 ifCtxt    = toIfaceContext (tyConStupidTheta tycon),
1380                 ifCons    = ifaceConDecls (algTyConRhs tycon),
1381                 ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
1382                 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1383                 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1384
1385   | isForeignTyCon tycon
1386   = IfaceForeign { ifName    = getOccName tycon,
1387                    ifExtName = tyConExtName tycon }
1388
1389   | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1390   where
1391     tyvars = tyConTyVars tycon
1392     (syn_rhs, syn_ki) 
1393        = case synTyConRhs tycon of
1394             SynFamilyTyCon  -> (Nothing,               toIfaceType (synTyConResKind tycon))
1395             SynonymTyCon ty -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1396
1397     ifaceConDecls (NewTyCon { data_con = con })     = 
1398       IfNewTyCon  (ifaceConDecl con)
1399     ifaceConDecls (DataTyCon { data_cons = cons })  = 
1400       IfDataTyCon (map ifaceConDecl cons)
1401     ifaceConDecls DataFamilyTyCon {}                = IfOpenDataTyCon
1402     ifaceConDecls AbstractTyCon                     = IfAbstractTyCon
1403         -- The last case happens when a TyCon has been trimmed during tidying
1404         -- Furthermore, tyThingToIfaceDecl is also used
1405         -- in TcRnDriver for GHCi, when browsing a module, in which case the
1406         -- AbstractTyCon case is perfectly sensible.
1407
1408     ifaceConDecl data_con 
1409         = IfCon   { ifConOcc     = getOccName (dataConName data_con),
1410                     ifConInfix   = dataConIsInfix data_con,
1411                     ifConWrapper = isJust (dataConWrapId_maybe data_con),
1412                     ifConUnivTvs = toIfaceTvBndrs univ_tvs,
1413                     ifConExTvs   = toIfaceTvBndrs ex_tvs,
1414                     ifConEqSpec  = to_eq_spec eq_spec,
1415                     ifConCtxt    = toIfaceContext theta,
1416                     ifConArgTys  = map toIfaceType arg_tys,
1417                     ifConFields  = map getOccName 
1418                                        (dataConFieldLabels data_con),
1419                     ifConStricts = dataConStrictMarks data_con }
1420         where
1421           (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _) = dataConFullSig data_con
1422
1423     to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1424
1425     famInstToIface Nothing                    = Nothing
1426     famInstToIface (Just (famTyCon, instTys)) = 
1427       Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1428
1429 tyThingToIfaceDecl c@(ACoAxiom _) = pprPanic "tyThingToIfaceDecl (ACoCon _)" (ppr c)
1430
1431 tyThingToIfaceDecl (ADataCon dc)
1432  = pprPanic "toIfaceDecl" (ppr dc)      -- Should be trimmed out earlier
1433
1434
1435 getFS :: NamedThing a => a -> FastString
1436 getFS x = occNameFS (getOccName x)
1437
1438 --------------------------
1439 instanceToIfaceInst :: Instance -> IfaceInst
1440 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1441                                 is_cls = cls_name, is_tcs = mb_tcs })
1442   = ASSERT( cls_name == className cls )
1443     IfaceInst { ifDFun    = dfun_name,
1444                 ifOFlag   = oflag,
1445                 ifInstCls = cls_name,
1446                 ifInstTys = map do_rough mb_tcs,
1447                 ifInstOrph = orph }
1448   where
1449     do_rough Nothing  = Nothing
1450     do_rough (Just n) = Just (toIfaceTyCon_name n)
1451
1452     dfun_name = idName dfun_id
1453     mod       = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1454     is_local name = nameIsLocalOrFrom mod name
1455
1456         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
1457     (_, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
1458                 -- Slightly awkward: we need the Class to get the fundeps
1459     (tvs, fds) = classTvsFds cls
1460     arg_names = [filterNameSet is_local (orphNamesOfType ty) | ty <- tys]
1461     orph | is_local cls_name = Just (nameOccName cls_name)
1462          | all isJust mb_ns  = ASSERT( not (null mb_ns) ) head mb_ns
1463          | otherwise         = Nothing
1464     
1465     mb_ns :: [Maybe OccName]    -- One for each fundep; a locally-defined name
1466                                 -- that is not in the "determined" arguments
1467     mb_ns | null fds   = [choose_one arg_names]
1468           | otherwise  = map do_one fds
1469     do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1470                                           , not (tv `elem` rtvs)]
1471
1472     choose_one :: [NameSet] -> Maybe OccName
1473     choose_one nss = case nameSetToList (unionManyNameSets nss) of
1474                         []      -> Nothing
1475                         (n : _) -> Just (nameOccName n)
1476
1477 --------------------------
1478 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1479 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1480                                  fi_fam = fam,
1481                                  fi_tcs = mb_tcs })
1482   = IfaceFamInst { ifFamInstTyCon  = toIfaceTyCon tycon
1483                  , ifFamInstFam    = fam
1484                  , ifFamInstTys    = map do_rough mb_tcs }
1485   where
1486     do_rough Nothing  = Nothing
1487     do_rough (Just n) = Just (toIfaceTyCon_name n)
1488
1489 --------------------------
1490 toIfaceLetBndr :: Id -> IfaceLetBndr
1491 toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
1492                                (toIfaceType (idType id)) 
1493                                (toIfaceIdInfo (idInfo id))
1494   -- Put into the interface file any IdInfo that CoreTidy.tidyLetBndr 
1495   -- has left on the Id.  See Note [IdInfo on nested let-bindings] in IfaceSyn
1496
1497 --------------------------
1498 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
1499 toIfaceIdDetails VanillaId                      = IfVanillaId
1500 toIfaceIdDetails (DFunId {})                    = IfDFunId 
1501 toIfaceIdDetails (RecSelId { sel_naughty = n
1502                            , sel_tycon = tc })  = IfRecSelId (toIfaceTyCon tc) n
1503 toIfaceIdDetails other                          = pprTrace "toIfaceIdDetails" (ppr other) 
1504                                                   IfVanillaId   -- Unexpected
1505
1506 toIfaceIdInfo :: IdInfo -> IfaceIdInfo
1507 toIfaceIdInfo id_info
1508   = case catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, 
1509                     inline_hsinfo,  unfold_hsinfo] of
1510        []    -> NoInfo
1511        infos -> HasInfo infos
1512                -- NB: strictness must appear in the list before unfolding
1513                -- See TcIface.tcUnfolding
1514   where
1515     ------------  Arity  --------------
1516     arity_info = arityInfo id_info
1517     arity_hsinfo | arity_info == 0 = Nothing
1518                  | otherwise       = Just (HsArity arity_info)
1519
1520     ------------ Caf Info --------------
1521     caf_info   = cafInfo id_info
1522     caf_hsinfo = case caf_info of
1523                    NoCafRefs -> Just HsNoCafRefs
1524                    _other    -> Nothing
1525
1526     ------------  Strictness  --------------
1527         -- No point in explicitly exporting TopSig
1528     strict_hsinfo = case strictnessInfo id_info of
1529                         Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1530                         _other                        -> Nothing
1531
1532     ------------  Unfolding  --------------
1533     unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info) 
1534     loop_breaker  = isNonRuleLoopBreaker (occInfo id_info)
1535                                         
1536     ------------  Inline prag  --------------
1537     inline_prag = inlinePragInfo id_info
1538     inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1539                   | otherwise = Just (HsInline inline_prag)
1540
1541 --------------------------
1542 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
1543 toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
1544                                 , uf_src = src, uf_guidance = guidance })
1545   = Just $ HsUnfold lb $
1546     case src of
1547         InlineStable
1548           -> case guidance of
1549                UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok if_rhs
1550                _other                     -> IfCoreUnfold True if_rhs
1551         InlineWrapper w | isExternalName n -> IfExtWrapper arity n
1552                         | otherwise        -> IfLclWrapper arity (getFS n)
1553                         where
1554                           n = idName w
1555         InlineCompulsory -> IfCompulsory if_rhs
1556         InlineRhs        -> IfCoreUnfold False if_rhs
1557         -- Yes, even if guidance is UnfNever, expose the unfolding
1558         -- If we didn't want to expose the unfolding, TidyPgm would
1559         -- have stuck in NoUnfolding.  For supercompilation we want 
1560         -- to see that unfolding!
1561   where
1562     if_rhs = toIfaceExpr rhs
1563
1564 toIfUnfolding lb (DFunUnfolding _ar _con ops)
1565   = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
1566       -- No need to serialise the data constructor; 
1567       -- we can recover it from the type of the dfun
1568
1569 toIfUnfolding _ _
1570   = Nothing
1571
1572 --------------------------
1573 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1574 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1575   = pprTrace "toHsRule: builtin" (ppr fn) $
1576     bogusIfaceRule fn
1577
1578 coreRuleToIfaceRule mod rule@(Rule { ru_name = name, ru_fn = fn, 
1579                                      ru_act = act, ru_bndrs = bndrs,
1580                                      ru_args = args, ru_rhs = rhs, 
1581                                      ru_auto = auto })
1582   = IfaceRule { ifRuleName  = name, ifActivation = act, 
1583                 ifRuleBndrs = map toIfaceBndr bndrs,
1584                 ifRuleHead  = fn, 
1585                 ifRuleArgs  = map do_arg args,
1586                 ifRuleRhs   = toIfaceExpr rhs,
1587                 ifRuleAuto  = auto,
1588                 ifRuleOrph  = orph }
1589   where
1590         -- For type args we must remove synonyms from the outermost
1591         -- level.  Reason: so that when we read it back in we'll
1592         -- construct the same ru_rough field as we have right now;
1593         -- see tcIfaceRule
1594     do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1595     do_arg (Coercion co) = IfaceType (coToIfaceType co)
1596                            
1597     do_arg arg       = toIfaceExpr arg
1598
1599         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
1600         -- A rule is an orphan only if none of the variables
1601         -- mentioned on its left-hand side are locally defined
1602     lhs_names = nameSetToList (ruleLhsOrphNames rule)
1603
1604     orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1605                         (n : _) -> Just (nameOccName n)
1606                         []      -> Nothing
1607
1608 bogusIfaceRule :: Name -> IfaceRule
1609 bogusIfaceRule id_name
1610   = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,  
1611         ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [], 
1612         ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing, ifRuleAuto = True }
1613
1614 ---------------------
1615 toIfaceExpr :: CoreExpr -> IfaceExpr
1616 toIfaceExpr (Var v)         = toIfaceVar v
1617 toIfaceExpr (Lit l)         = IfaceLit l
1618 toIfaceExpr (Type ty)       = IfaceType (toIfaceType ty)
1619 toIfaceExpr (Coercion co)   = IfaceCo   (coToIfaceType co)
1620 toIfaceExpr (Lam x b)       = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1621 toIfaceExpr (App f a)       = toIfaceApp f [a]
1622 toIfaceExpr (Case s x _ as) = IfaceCase (toIfaceExpr s) (getFS x) (map toIfaceAlt as)
1623 toIfaceExpr (Let b e)       = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1624 toIfaceExpr (Cast e co)     = IfaceCast (toIfaceExpr e) (coToIfaceType co)
1625 toIfaceExpr (Note n e)      = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1626
1627 ---------------------
1628 toIfaceNote :: Note -> IfaceNote
1629 toIfaceNote (SCC cc)      = IfaceSCC cc
1630 toIfaceNote (CoreNote s)  = IfaceCoreNote s
1631
1632 ---------------------
1633 toIfaceBind :: Bind Id -> IfaceBinding
1634 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1635 toIfaceBind (Rec prs)    = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1636
1637 ---------------------
1638 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1639            -> (IfaceConAlt, [FastString], IfaceExpr)
1640 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1641
1642 ---------------------
1643 toIfaceCon :: AltCon -> IfaceConAlt
1644 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1645                         | otherwise       = IfaceDataAlt (getName dc)
1646                         where
1647                           tc = dataConTyCon dc
1648            
1649 toIfaceCon (LitAlt l) = IfaceLitAlt l
1650 toIfaceCon DEFAULT    = IfaceDefault
1651
1652 ---------------------
1653 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1654 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1655 toIfaceApp (Var v) as
1656   = case isDataConWorkId_maybe v of
1657         -- We convert the *worker* for tuples into IfaceTuples
1658         Just dc |  isTupleTyCon tc && saturated 
1659                 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1660           where
1661             val_args  = dropWhile isTypeArg as
1662             saturated = val_args `lengthIs` idArity v
1663             tup_args  = map toIfaceExpr val_args
1664             tc        = dataConTyCon dc
1665
1666         _ -> mkIfaceApps (toIfaceVar v) as
1667
1668 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1669
1670 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1671 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1672
1673 ---------------------
1674 toIfaceVar :: Id -> IfaceExpr
1675 toIfaceVar v 
1676   | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1677           -- Foreign calls have special syntax
1678   | isExternalName name             = IfaceExt name
1679   | Just (TickBox m ix) <- isTickBoxOp_maybe v
1680                                     = IfaceTick m ix
1681   | otherwise                       = IfaceLcl (getFS name)
1682   where
1683     name = idName v
1684 \end{code}