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