MkIface.lhs 71.7 KB
Newer Older
1
%
2
% (c) The University of Glasgow 2006-2008
3
4
5
6
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%

\begin{code}
dterei's avatar
dterei committed
7
8
9
-- | Module for constructing @ModIface@ values (interface files),
-- writing them to disk and comparing two versions to see if
-- recompilation is required.
10
module MkIface ( 
Simon Marlow's avatar
Simon Marlow committed
11
12
        mkUsedNames,
        mkDependencies,
13
14
        mkIface,        -- Build a ModIface from a ModGuts, 
                        -- including computing version information
15

Simon Marlow's avatar
Simon Marlow committed
16
17
        mkIfaceTc,

18
        writeIfaceFile, -- Write the interface file
19

20
21
        checkOldIface,  -- See if recompilation is required, by
                        -- comparing version information
22
23

        tyThingToIfaceDecl -- Converting things to their Iface equivalents
24
25
26
 ) where
\end{code}

27
28
29
  -----------------------------------------------
          Recompilation checking
  -----------------------------------------------
30

31
32
A complete description of how recompilation checking works can be
found in the wiki commentary:
33

34
 http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
35

36
37
Please read the above page for a top-down description of how this all
works.  Notes below cover specific issues related to the implementation.
38
39

Basic idea: 
40

41
  * In the mi_usages information in an interface, we record the 
42
    fingerprint of each free variable of the module
43

44
45
46
47
48
  * In mkIface, we compute the fingerprint of each exported thing A.f.
    For each external thing that A.f refers to, we include the fingerprint
    of the external reference when computing the fingerprint of A.f.  So
    if anything that A.f depends on changes, then A.f's fingerprint will
    change.
GregWeber's avatar
GregWeber committed
49
50
    Also record any dependent files added with addDependentFile.
    In the future record any #include usages.
51
52

  * In checkOldIface we compare the mi_usages for the module with
53
    the actual fingerprint for all each thing recorded in mi_usages
54
55
56
57

\begin{code}
#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
58
59
60
61
import IfaceSyn
import LoadIface
import Id
import IdInfo
62
import Demand
63
import Annotations
64
import CoreSyn
65
import CoreFVs
Simon Marlow's avatar
Simon Marlow committed
66
import Class
67
import Kind
Simon Marlow's avatar
Simon Marlow committed
68
69
70
71
72
73
import TyCon
import DataCon
import Type
import TcType
import InstEnv
import FamInstEnv
74
import TcRnMonad
75
import HsSyn
Simon Marlow's avatar
Simon Marlow committed
76
import HscTypes
77
import Finder
Simon Marlow's avatar
Simon Marlow committed
78
import DynFlags
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
79
import VarEnv
80
import VarSet
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
81
import Var
Simon Marlow's avatar
Simon Marlow committed
82
import Name
83
import Avail
Ian Lynagh's avatar
Ian Lynagh committed
84
import RdrName
85
86
import NameEnv
import NameSet
Simon Marlow's avatar
Simon Marlow committed
87
import Module
Simon Marlow's avatar
Simon Marlow committed
88
89
90
91
import BinIface
import ErrUtils
import Digraph
import SrcLoc
92
93
import Outputable
import BasicTypes       hiding ( SuccessFlag(..) )
94
import UniqFM
95
import Unique
96
import Util             hiding ( eqListBy )
97
import FastString
Simon Marlow's avatar
Simon Marlow committed
98
import Maybes
Simon Marlow's avatar
Simon Marlow committed
99
import ListSetOps
100
101
import Binary
import Fingerprint
102
import Bag
103

Simon Marlow's avatar
Simon Marlow committed
104
105
import Control.Monad
import Data.List
106
107
import Data.Map (Map)
import qualified Data.Map as Map
Simon Marlow's avatar
Simon Marlow committed
108
import Data.IORef
Ian Lynagh's avatar
Ian Lynagh committed
109
import System.FilePath
GregWeber's avatar
GregWeber committed
110
import System.Directory (getModificationTime)
111
112
113
114
115
\end{code}



%************************************************************************
116
%*                                                                      *
117
\subsection{Completing an interface}
118
%*                                                                      *
119
120
121
122
%************************************************************************

\begin{code}
mkIface :: HscEnv
123
124
125
126
        -> Maybe Fingerprint    -- The old fingerprint, if we have it
        -> ModDetails           -- The trimmed, tidied interface
        -> ModGuts              -- Usages, deprecations, etc
        -> IO (Messages,
Thomas Schilling's avatar
Thomas Schilling committed
127
               Maybe (ModIface, -- The new one
128
                      Bool))    -- True <=> there was an old Iface, and the
129
130
                                --          new one is identical, so no need
                                --          to write it
131

132
mkIface hsc_env maybe_old_fingerprint mod_details
133
134
135
         ModGuts{     mg_module     = this_mod,
                      mg_boot       = is_boot,
                      mg_used_names = used_names,
136
                      mg_used_th    = used_th,
137
138
139
140
141
142
                      mg_deps       = deps,
                      mg_dir_imps   = dir_imp_mods,
                      mg_rdr_env    = rdr_env,
                      mg_fix_env    = fix_env,
                      mg_warns      = warns,
                      mg_hpc_info   = hpc_info,
GregWeber's avatar
GregWeber committed
143
144
145
                      mg_trust_pkg  = self_trust,
                      mg_dependent_files = dependent_files
                    }
146
        = mkIface_ hsc_env maybe_old_fingerprint
147
                   this_mod is_boot used_names used_th deps rdr_env fix_env
GregWeber's avatar
GregWeber committed
148
                   warns hpc_info dir_imp_mods self_trust dependent_files mod_details
Thomas Schilling's avatar
Thomas Schilling committed
149

Simon Marlow's avatar
Simon Marlow committed
150
151
152
153
-- | make an interface from the results of typechecking only.  Useful
-- for non-optimising compilation, or where we aren't generating any
-- object code at all ('HscNothing').
mkIfaceTc :: HscEnv
dterei's avatar
dterei committed
154
155
156
157
          -> Maybe Fingerprint  -- The old fingerprint, if we have it
          -> ModDetails         -- gotten from mkBootModDetails, probably
          -> TcGblEnv           -- Usages, deprecations, etc
          -> IO (Messages, Maybe (ModIface, Bool))
158
mkIfaceTc hsc_env maybe_old_fingerprint mod_details
Simon Marlow's avatar
Simon Marlow committed
159
160
161
162
163
  tc_result@TcGblEnv{ tcg_mod = this_mod,
                      tcg_src = hsc_src,
                      tcg_imports = imports,
                      tcg_rdr_env = rdr_env,
                      tcg_fix_env = fix_env,
Ian Lynagh's avatar
Ian Lynagh committed
164
                      tcg_warns = warns,
165
                      tcg_hpc = other_hpc_info,
GregWeber's avatar
GregWeber committed
166
167
                      tcg_th_splice_used = tc_splice_used,
                      tcg_dependent_files = dependent_files
Simon Marlow's avatar
Simon Marlow committed
168
169
                    }
  = do
170
          let used_names = mkUsedNames tc_result
Simon Marlow's avatar
Simon Marlow committed
171
172
          deps <- mkDependencies tc_result
          let hpc_info = emptyHpcInfo other_hpc_info
173
          used_th <- readIORef tc_splice_used
GregWeber's avatar
GregWeber committed
174
          dep_files <- (readIORef dependent_files)
175
          mkIface_ hsc_env maybe_old_fingerprint
176
                   this_mod (isHsBoot hsc_src) used_names used_th deps rdr_env
177
                   fix_env warns hpc_info (imp_mods imports)
GregWeber's avatar
GregWeber committed
178
                   (imp_trust_own_pkg imports) dep_files mod_details
Simon Marlow's avatar
Simon Marlow committed
179
180
        

181
182
mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
Simon Marlow's avatar
Simon Marlow committed
183
        
184
185
-- | Extract information from the rename and typecheck phases to produce
-- a dependencies information for the module being compiled.
Simon Marlow's avatar
Simon Marlow committed
186
187
188
189
190
191
192
mkDependencies :: TcGblEnv -> IO Dependencies
mkDependencies
          TcGblEnv{ tcg_mod = mod,
                    tcg_imports = imports,
                    tcg_th_used = th_var
                  }
 = do 
dterei's avatar
dterei committed
193
194
195
      -- Template Haskell used?
      th_used <- readIORef th_var
      let dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
Simon Marlow's avatar
Simon Marlow committed
196
197
198
199
200
201
202
                -- M.hi-boot can be in the imp_dep_mods, but we must remove
                -- it before recording the modules on which this one depends!
                -- (We want to retain M.hi-boot in imp_dep_mods so that 
                --  loadHiBootInterface can see if M's direct imports depend 
                --  on M.hi-boot, and hence that we should do the hi-boot consistency 
                --  check.)

203
204
          pkgs | th_used   = insertList thPackageId (imp_dep_pkgs imports)
               | otherwise = imp_dep_pkgs imports
Simon Marlow's avatar
Simon Marlow committed
205

206
207
208
209
210
          -- Set the packages required to be Safe according to Safe Haskell.
          -- See Note [RnNames . Tracking Trust Transitively]
          sorted_pkgs = sortBy stablePackageIdCmp pkgs
          trust_pkgs  = imp_trust_pkgs imports
          dep_pkgs'   = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
211

212
      return Deps { dep_mods   = sortBy (stableModuleNameCmp `on` fst) dep_mods,
213
                    dep_pkgs   = dep_pkgs',
214
215
                    dep_orphs  = sortBy stableModuleCmp (imp_orphs  imports),
                    dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
216
217
                    -- sort to get into canonical order
                    -- NB. remember to use lexicographic ordering
Simon Marlow's avatar
Simon Marlow committed
218

219
mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
220
         -> NameSet -> Bool -> Dependencies -> GlobalRdrEnv
Ian Lynagh's avatar
Ian Lynagh committed
221
         -> NameEnv FixItem -> Warnings -> HpcInfo
222
         -> ImportedMods -> Bool
GregWeber's avatar
GregWeber committed
223
         -> [FilePath]
Ian Lynagh's avatar
Ian Lynagh committed
224
         -> ModDetails
225
         -> IO (Messages, Maybe (ModIface, Bool))
226
mkIface_ hsc_env maybe_old_fingerprint 
227
         this_mod is_boot used_names used_th deps rdr_env fix_env src_warns
GregWeber's avatar
GregWeber committed
228
         hpc_info dir_imp_mods pkg_trust_req dependent_files
dterei's avatar
dterei committed
229
230
231
232
         ModDetails{  md_insts     = insts, 
                      md_fam_insts = fam_insts,
                      md_rules     = rules,
                      md_anns      = anns,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
233
                      md_vect_info = vect_info,
dterei's avatar
dterei committed
234
235
236
237
238
239
240
241
                      md_types     = type_env,
                      md_exports   = exports }
-- NB:  notice that mkIface does not look at the bindings
--      only at the TypeEnv.  The previous Tidy phase has
--      put exactly the info into the TypeEnv that we want
--      to expose in the interface

  = do  { usages  <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files
242
        ; safeInf <- hscGetSafeInf hsc_env
Simon Marlow's avatar
Simon Marlow committed
243

dterei's avatar
dterei committed
244
        ; let   { entities = typeEnvElts type_env ;
245
                  decls  = [ tyThingToIfaceDecl entity
dterei's avatar
dterei committed
246
247
                           | entity <- entities,
                             let name = getName entity,
248
                             not (isImplicitTyThing entity),
dterei's avatar
dterei committed
249
250
251
252
253
254
255
256
257
258
259
                                -- No implicit Ids and class tycons in the interface file
                             not (isWiredInName name),
                                -- Nor wired-in things; the compiler knows about them anyhow
                             nameIsLocalOrFrom this_mod name  ]
                                -- Sigh: see Note [Root-main Id] in TcRnDriver

                ; fixities    = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
                ; warns       = src_warns
                ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
                ; iface_insts = map instanceToIfaceInst insts
                ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
260
                ; iface_vect_info = flattenVectInfo vect_info
dterei's avatar
dterei committed
261
262
                -- Check if we are in Safe Inference mode but we failed to pass
                -- the muster
263
264
265
266
                ; safeMode    = if safeInferOn dflags  && not safeInf
                                    then Sf_None
                                    else safeHaskell dflags
                ; trust_info  = setSafeMode safeMode
267

dterei's avatar
dterei committed
268
269
270
271
272
273
274
275
276
277
278
279
                ; intermediate_iface = ModIface { 
                        mi_module      = this_mod,
                        mi_boot        = is_boot,
                        mi_deps        = deps,
                        mi_usages      = usages,
                        mi_exports     = mkIfaceExports exports,
        
                        -- Sort these lexicographically, so that
                        -- the result is stable across compilations
                        mi_insts       = sortLe le_inst iface_insts,
                        mi_fam_insts   = sortLe le_fam_inst iface_fam_insts,
                        mi_rules       = sortLe le_rule iface_rules,
280

dterei's avatar
dterei committed
281
                        mi_vect_info   = iface_vect_info,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
282

dterei's avatar
dterei committed
283
284
285
286
                        mi_fixities    = fixities,
                        mi_warns       = warns,
                        mi_anns        = mkIfaceAnnotations anns,
                        mi_globals     = Just rdr_env,
287

dterei's avatar
dterei committed
288
289
290
291
                        -- Left out deliberately: filled in by addVersionInfo
                        mi_iface_hash  = fingerprint0,
                        mi_mod_hash    = fingerprint0,
                        mi_exp_hash    = fingerprint0,
dterei's avatar
dterei committed
292
                        mi_used_th     = used_th,
293
                        mi_orphan_hash = fingerprint0,
dterei's avatar
dterei committed
294
295
                        mi_orphan      = False, -- Always set by addVersionInfo, but
                                                -- it's a strict field, so we can't omit it.
dterei's avatar
dterei committed
296
                        mi_finsts      = False, -- Ditto
dterei's avatar
dterei committed
297
298
299
300
301
                        mi_decls       = deliberatelyOmitted "decls",
                        mi_hash_fn     = deliberatelyOmitted "hash_fn",
                        mi_hpc         = isHpcUsed hpc_info,
                        mi_trust       = trust_info,
                        mi_trust_pkg   = pkg_trust_req,
302

dterei's avatar
dterei committed
303
304
305
306
                        -- And build the cached values
                        mi_warn_fn     = mkIfaceWarnCache warns,
                        mi_fix_fn      = mkIfaceFixCache fixities }
                }
307

308
        ; (new_iface, no_change_at_all) 
dterei's avatar
dterei committed
309
310
                <- {-# SCC "versioninfo" #-}
                         addFingerprints hsc_env maybe_old_fingerprint
311
                                         intermediate_iface decls
312

dterei's avatar
dterei committed
313
314
                -- Warn about orphans
        ; let warn_orphs      = wopt Opt_WarnOrphans dflags
315
              warn_auto_orphs = wopt Opt_WarnAutoOrphans dflags
316
              orph_warnings   --- Laziness means no work done unless -fwarn-orphans
dterei's avatar
dterei committed
317
318
319
320
321
322
323
324
325
326
                | warn_orphs || warn_auto_orphs = rule_warns `unionBags` inst_warns
                | otherwise                     = emptyBag
              errs_and_warns = (orph_warnings, emptyBag)
              unqual = mkPrintUnqualified dflags rdr_env
              inst_warns = listToBag [ instOrphWarn unqual d 
                                     | (d,i) <- insts `zip` iface_insts
                                     , isNothing (ifInstOrph i) ]
              rule_warns = listToBag [ ruleOrphWarn unqual this_mod r 
                                     | r <- iface_rules
                                     , isNothing (ifRuleOrph r)
327
328
                                     , if ifRuleAuto r then warn_auto_orphs
                                                       else warn_orphs ]
329

dterei's avatar
dterei committed
330
        ; if errorsFound dflags errs_and_warns
Thomas Schilling's avatar
Thomas Schilling committed
331
332
            then return ( errs_and_warns, Nothing )
            else do {
333

dterei's avatar
dterei committed
334
335
336
                -- Debug printing
        ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE" 
                        (pprModIface new_iface)
337

338
339
340
341
342
343
                -- bug #1617: on reload we weren't updating the PrintUnqualified
                -- correctly.  This stems from the fact that the interface had
                -- not changed, so addVersionInfo returns the old ModIface
                -- with the old GlobalRdrEnv (mi_globals).
        ; let final_iface = new_iface{ mi_globals = Just rdr_env }

dterei's avatar
dterei committed
344
        ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
345
  where
346
347
348
349
350
     r1 `le_rule`     r2 = ifRuleName      r1    <=    ifRuleName      r2
     i1 `le_inst`     i2 = ifDFun          i1 `le_occ` ifDFun          i2  
     i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2

     le_occ :: Name -> Name -> Bool
dterei's avatar
dterei committed
351
352
        -- Compare lexicographically by OccName, *not* by unique, because 
        -- the latter is not stable across compilations
353
     le_occ n1 n2 = nameOccName n1 <= nameOccName n2
354

355
     dflags = hsc_dflags hsc_env
356
357

     deliberatelyOmitted :: String -> a
358
     deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
359

360
     ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
361

362
363
364
365
     flattenVectInfo (VectInfo { vectInfoVar          = vVar
                               , vectInfoTyCon        = vTyCon
                               , vectInfoScalarVars   = vScalarVars
                               , vectInfoScalarTyCons = vScalarTyCons
366
                               }) = 
367
368
369
370
371
372
       IfaceVectInfo
       { ifaceVectInfoVar          = [Var.varName v | (v, _  ) <- varEnvElts  vVar]
       , ifaceVectInfoTyCon        = [tyConName t   | (t, t_v) <- nameEnvElts vTyCon, t /= t_v]
       , ifaceVectInfoTyConReuse   = [tyConName t   | (t, t_v) <- nameEnvElts vTyCon, t == t_v]
       , ifaceVectInfoScalarVars   = [Var.varName v | v <- varSetElems vScalarVars]
       , ifaceVectInfoScalarTyCons = nameSetToList vScalarTyCons
373
       } 
374

375
-----------------------------
376
377
writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
writeIfaceFile dflags location new_iface
Ian Lynagh's avatar
Ian Lynagh committed
378
    = do createDirectoryHierarchy (takeDirectory hi_file_path)
379
         writeBinIface dflags hi_file_path new_iface
380
    where hi_file_path = ml_hi_file location
381
382


383
384
-- -----------------------------------------------------------------------------
-- Look up parents and versions of Names
385

386
387
-- This is like a global version of the mi_hash_fn field in each ModIface.
-- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
388
-- the parent and version info.
389

390
mkHashFun
391
392
        :: HscEnv                       -- needed to look up versions
        -> ExternalPackageState         -- ditto
393
394
        -> (Name -> Fingerprint)
mkHashFun hsc_env eps
395
396
  = \name -> 
      let 
397
        mod = ASSERT2( isExternalName name, ppr name ) nameModule name
398
399
400
401
        occ = nameOccName name
        iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse` 
                   pprPanic "lookupVers2" (ppr mod <+> ppr occ)
      in  
402
403
        snd (mi_hash_fn iface occ `orElse` 
                  pprPanic "lookupVers1" (ppr mod <+> ppr occ))
404
  where
405
406
      hpt = hsc_HPT hsc_env
      pit = eps_PIT eps
407

408
409
410
411
412
413
-- ---------------------------------------------------------------------------
-- Compute fingerprints for the interface

addFingerprints
        :: HscEnv
        -> Maybe Fingerprint -- the old fingerprint, if any
dterei's avatar
dterei committed
414
        -> ModIface          -- The new interface (lacking decls)
415
416
        -> [IfaceDecl]       -- The new decls
        -> IO (ModIface,     -- Updated interface
dterei's avatar
dterei committed
417
               Bool)         -- True <=> no changes at all; 
418
419
420
421
422
423
                             -- no need to write Iface

addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
 = do
   eps <- hscEPS hsc_env
   let
424
        -- The ABI of a declaration represents everything that is made
425
426
427
428
429
430
431
432
        -- visible about the declaration that a client can depend on.
        -- see IfaceDeclABI below.
       declABI :: IfaceDecl -> IfaceDeclABI 
       declABI decl = (this_mod, decl, extras)
        where extras = declExtras fix_fn non_orph_rules non_orph_insts decl

       edges :: [(IfaceDeclABI, Unique, [Unique])]
       edges = [ (abi, getUnique (ifName decl), out)
dterei's avatar
dterei committed
433
               | decl <- new_decls
434
               , let abi = declABI decl
dterei's avatar
dterei committed
435
               , let out = localOccs $ freeNamesDeclABI abi
436
437
               ]

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
438
       name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
439
       localOccs = map (getUnique . getParent . getOccName) 
440
                        . filter ((== this_mod) . name_module)
441
442
443
444
445
446
447
448
449
450
451
452
453
                        . nameSetToList
          where getParent occ = lookupOccEnv parent_map occ `orElse` occ

        -- maps OccNames to their parents in the current module.
        -- e.g. a reference to a constructor must be turned into a reference
        -- to the TyCon for the purposes of calculating dependencies.
       parent_map :: OccEnv OccName
       parent_map = foldr extend emptyOccEnv new_decls
          where extend d env = 
                  extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
                  where n = ifName d

        -- strongly-connected groups of declarations, in dependency order
454
       groups = stronglyConnCompFromEdgedVertices edges
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469

       global_hash_fn = mkHashFun hsc_env eps

        -- how to output Names when generating the data to fingerprint.
        -- Here we want to output the fingerprint for each top-level
        -- Name, whether it comes from the current module or another
        -- module.  In this way, the fingerprint for a declaration will
        -- change if the fingerprint for anything it refers to (transitively)
        -- changes.
       mk_put_name :: (OccEnv (OccName,Fingerprint))
                   -> BinHandle -> Name -> IO  ()
       mk_put_name local_env bh name
          | isWiredInName name  =  putNameLiterally bh name 
           -- wired-in names don't have fingerprints
          | otherwise
470
          = ASSERT2( isExternalName name, ppr name )
dterei's avatar
dterei committed
471
            let hash | nameModule name /= this_mod =  global_hash_fn name
472
473
474
475
                     | otherwise = 
                        snd (lookupOccEnv local_env (getOccName name)
                           `orElse` pprPanic "urk! lookup local fingerprint" 
                                       (ppr name)) -- (undefined,fingerprint0))
476
477
478
479
480
481
482
                -- This panic indicates that we got the dependency
                -- analysis wrong, because we needed a fingerprint for
                -- an entity that wasn't in the environment.  To debug
                -- it, turn the panic into a trace, uncomment the
                -- pprTraces below, run the compile again, and inspect
                -- the output and the generated .hi file with
                -- --show-iface.
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
            in 
            put_ bh hash

        -- take a strongly-connected group of declarations and compute
        -- its fingerprint.

       fingerprint_group :: (OccEnv (OccName,Fingerprint), 
                             [(Fingerprint,IfaceDecl)])
                         -> SCC IfaceDeclABI
                         -> IO (OccEnv (OccName,Fingerprint), 
                                [(Fingerprint,IfaceDecl)])

       fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
          = do let hash_fn = mk_put_name local_env
                   decl = abiDecl abi
               -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
499
               hash <- computeFingerprint hash_fn abi
500
501
502
503
504
505
506
507
508
509
510
               return (extend_hash_env (hash,decl) local_env,
                       (hash,decl) : decls_w_hashes)

       fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
          = do let decls = map abiDecl abis
                   local_env' = foldr extend_hash_env local_env 
                                   (zip (repeat fingerprint0) decls)
                   hash_fn = mk_put_name local_env'
               -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
               let stable_abis = sortBy cmp_abiNames abis
                -- put the cycle in a canonical order
511
               hash <- computeFingerprint hash_fn stable_abis
512
513
514
515
516
517
518
519
               let pairs = zip (repeat hash) decls
               return (foldr extend_hash_env local_env pairs,
                       pairs ++ decls_w_hashes)

       extend_hash_env :: (Fingerprint,IfaceDecl)
                       -> OccEnv (OccName,Fingerprint)
                       -> OccEnv (OccName,Fingerprint)
       extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
520
        where
521
522
523
524
525
526
527
528
529
          decl_name = ifName d
          item = (decl_name, hash)
          env1 = extendOccEnv env0 decl_name item
          add_imp bndr env = extendOccEnv env bndr item
            
   --
   (local_env, decls_w_hashes) <- 
       foldM fingerprint_group (emptyOccEnv, []) groups

530
531
532
533
534
   -- when calculating fingerprints, we always need to use canonical
   -- ordering for lists of things.  In particular, the mi_deps has various
   -- lists of modules and suchlike, so put these all in canonical order:
   let sorted_deps = sortDependencies (mi_deps iface0)

535
   -- the export hash of a module depends on the orphan hashes of the
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
536
   -- orphan modules below us in the dependency tree.  This is the way
537
538
539
540
   -- that changes in orphans get propagated all the way up the
   -- dependency tree.  We only care about orphan modules in the current
   -- package, because changes to orphans outside this package will be
   -- tracked by the usage on the ABI hash of package modules that we import.
541
542
   let orph_mods = filter ((== this_pkg) . modulePackageId)
                   $ dep_orphs sorted_deps
543
544
   dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods

545
   orphan_hash <- computeFingerprint (mk_put_name local_env)
546
                      (map ifDFun orph_insts, orph_rules, fam_insts)
547
548
549

   -- the export list hash doesn't depend on the fingerprints of
   -- the Names it mentions, only the Names themselves, hence putNameLiterally.
550
   export_hash <- computeFingerprint putNameLiterally
551
552
553
                      (mi_exports iface0,
                       orphan_hash,
                       dep_orphan_hashes,
554
                       dep_pkgs (mi_deps iface0),
555
556
                        -- dep_pkgs: see "Package Version Changes" on
                        -- wiki/Commentary/Compiler/RecompilationAvoidance
557
                       mi_trust iface0)
558
                        -- Make sure change of Safe Haskell mode causes recomp.
559
560

   -- put the declarations in a canonical order, sorted by OccName
561
   let sorted_decls = Map.elems $ Map.fromList $
562
563
564
565
566
567
568
                          [(ifName d, e) | e@(_, d) <- decls_w_hashes]

   -- the ABI hash depends on:
   --   - decls
   --   - export list
   --   - orphans
   --   - deprecations
569
   --   - vect info
570
   mod_hash <- computeFingerprint putNameLiterally
571
572
573
                      (map fst sorted_decls,
                       export_hash,
                       orphan_hash,
574
575
                       mi_warns iface0,
                       mi_vect_info iface0)
576
577
578
579
580
581

   -- The interface hash depends on:
   --    - the ABI hash, plus
   --    - usages
   --    - deps
   --    - hpc
582
   iface_hash <- computeFingerprint putNameLiterally
583
584
                      (mod_hash, 
                       mi_usages iface0,
585
                       sorted_deps,
586
587
588
589
590
591
592
593
594
595
                       mi_hpc iface0)

   let
    no_change_at_all = Just iface_hash == mb_old_fingerprint

    final_iface = iface0 {
                mi_mod_hash    = mod_hash,
                mi_iface_hash  = iface_hash,
                mi_exp_hash    = export_hash,
                mi_orphan_hash = orphan_hash,
596
597
                mi_orphan      = not (null orph_rules && null orph_insts
                                      && null (ifaceVectInfoVar (mi_vect_info iface0))),
598
599
600
601
                mi_finsts      = not . null $ mi_fam_insts iface0,
                mi_decls       = sorted_decls,
                mi_hash_fn     = lookupOccEnv local_env }
   --
602
   return (final_iface, no_change_at_all)
603

604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
  where
    this_mod = mi_module iface0
    dflags = hsc_dflags hsc_env
    this_pkg = thisPackage dflags
    (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
    (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
        -- ToDo: shouldn't we be splitting fam_insts into orphans and
        -- non-orphans?
    fam_insts = mi_fam_insts iface0
    fix_fn = mi_fix_fn iface0


getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
getOrphanHashes hsc_env mods = do
  eps <- hscEPS hsc_env
  let 
    hpt        = hsc_HPT hsc_env
    pit        = eps_PIT eps
    dflags     = hsc_dflags hsc_env
    get_orph_hash mod = 
          case lookupIfaceByModule dflags hpt pit mod of
            Nothing    -> pprPanic "moduleOrphanHash" (ppr mod)
            Just iface -> mi_orphan_hash iface
  --
  return (map get_orph_hash mods)


631
632
633
sortDependencies :: Dependencies -> Dependencies
sortDependencies d
 = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
634
          dep_pkgs   = sortBy (stablePackageIdCmp `on` fst) (dep_pkgs d),
635
636
          dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
          dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
637
638
639
640
\end{code}


%************************************************************************
dterei's avatar
dterei committed
641
642
643
%*                                                                      *
          The ABI of an IfaceDecl                                                                               
%*                                                                      *
644
645
646
647
648
649
650
651
652
%************************************************************************

Note [The ABI of an IfaceDecl]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The ABI of a declaration consists of:

   (a) the full name of the identifier (inc. module and package,
       because these are used to construct the symbol name by which
       the identifier is known externally).
653

654
655
656
657
658
659
660
661
662
663
664
   (b) the declaration itself, as exposed to clients.  That is, the
       definition of an Id is included in the fingerprint only if
       it is made available as as unfolding in the interface.

   (c) the fixity of the identifier
   (d) for Ids: rules
   (e) for classes: instances, fixity & rules for methods
   (f) for datatypes: instances, fixity & rules for constrs

Items (c)-(f) are not stored in the IfaceDecl, but instead appear
elsewhere in the interface file.  But they are *fingerprinted* with
665
666
the declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
and fingerprinting that as part of the declaration.
667
668

\begin{code}
669
670
type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)

671
672
data IfaceDeclExtras 
  = IfaceIdExtras    Fixity [IfaceRule]
673
674

  | IfaceDataExtras  
dterei's avatar
dterei committed
675
676
677
678
       Fixity                   -- Fixity of the tycon itself
       [IfaceInstABI]           -- Local instances of this tycon
                                -- See Note [Orphans] in IfaceSyn
       [(Fixity,[IfaceRule])]   -- For each construcotr, fixity and RULES
679
680

  | IfaceClassExtras 
dterei's avatar
dterei committed
681
682
683
684
685
       Fixity                   -- Fixity of the class itself
       [IfaceInstABI]           -- Local instances of this class *or*
                                --   of its associated data types
                                -- See Note [Orphans] in IfaceSyn
       [(Fixity,[IfaceRule])]   -- For each class method, fixity and RULES
686

687
  | IfaceSynExtras   Fixity
688

689
690
  | IfaceOtherDeclExtras

691
692
693
694
695
696
697
698
699
700
701
702
703
704
abiDecl :: IfaceDeclABI -> IfaceDecl
abiDecl (_, decl, _) = decl

cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare` 
                         ifName (abiDecl abi2)

freeNamesDeclABI :: IfaceDeclABI -> NameSet
freeNamesDeclABI (_mod, decl, extras) =
  freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras

freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
freeNamesDeclExtras (IfaceIdExtras    _ rules)
  = unionManyNameSets (map freeNamesIfRule rules)
705
706
707
708
freeNamesDeclExtras (IfaceDataExtras  _ insts subs)
  = unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
freeNamesDeclExtras (IfaceClassExtras _ insts subs)
  = unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
709
710
freeNamesDeclExtras (IfaceSynExtras _)
  = emptyNameSet
711
712
713
714
715
716
freeNamesDeclExtras IfaceOtherDeclExtras
  = emptyNameSet

freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)

717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
instance Outputable IfaceDeclExtras where
  ppr IfaceOtherDeclExtras       = empty
  ppr (IfaceIdExtras  fix rules) = ppr_id_extras fix rules
  ppr (IfaceSynExtras fix)       = ppr fix
  ppr (IfaceDataExtras fix insts stuff)  = vcat [ppr fix, ppr_insts insts,
                                                 ppr_id_extras_s stuff]
  ppr (IfaceClassExtras fix insts stuff) = vcat [ppr fix, ppr_insts insts,
                                                 ppr_id_extras_s stuff]

ppr_insts :: [IfaceInstABI] -> SDoc
ppr_insts _ = ptext (sLit "<insts>")

ppr_id_extras_s :: [(Fixity, [IfaceRule])] -> SDoc
ppr_id_extras_s stuff = vcat [ppr_id_extras f r | (f,r)<- stuff]

ppr_id_extras :: Fixity -> [IfaceRule] -> SDoc
ppr_id_extras fix rules = ppr fix $$ vcat (map ppr rules)

735
-- This instance is used only to compute fingerprints
736
737
738
739
740
741
instance Binary IfaceDeclExtras where
  get _bh = panic "no get for IfaceDeclExtras"
  put_ bh (IfaceIdExtras fix rules) = do
   putByte bh 1; put_ bh fix; put_ bh rules
  put_ bh (IfaceDataExtras fix insts cons) = do
   putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
742
743
744
745
  put_ bh (IfaceClassExtras fix insts methods) = do
   putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
  put_ bh (IfaceSynExtras fix) = do
   putByte bh 4; put_ bh fix
746
  put_ bh IfaceOtherDeclExtras = do
747
   putByte bh 5
748
749
750
751
752
753
754
755
756
757
758
759
760

declExtras :: (OccName -> Fixity)
           -> OccEnv [IfaceRule]
           -> OccEnv [IfaceInst]
           -> IfaceDecl
           -> IfaceDeclExtras

declExtras fix_fn rule_env inst_env decl
  = case decl of
      IfaceId{} -> IfaceIdExtras (fix_fn n) 
                        (lookupOccEnvL rule_env n)
      IfaceData{ifCons=cons} -> 
                     IfaceDataExtras (fix_fn n)
761
                        (map ifDFun $ lookupOccEnvL inst_env n)
762
                        (map (id_extras . ifConOcc) (visibleIfConDecls cons))
763
      IfaceClass{ifSigs=sigs, ifATs=ats} -> 
764
                     IfaceClassExtras (fix_fn n)
765
                        (map ifDFun $ (concatMap at_extras ats)
766
                                    ++ lookupOccEnvL inst_env n)
dterei's avatar
dterei committed
767
768
                           -- Include instances of the associated types
                           -- as well as instances of the class (Trac #5147)
769
                        [id_extras op | IfaceClassOp op _ _ <- sigs]
770
      IfaceSyn{} -> IfaceSynExtras (fix_fn n)
771
772
773
774
      _other -> IfaceOtherDeclExtras
  where
        n = ifName decl
        id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
775
        at_extras (IfaceAT decl _) = lookupOccEnvL inst_env (ifName decl)
776

777
--
778
779
-- When hashing an instance, we hash only the DFunId, because that
-- depends on all the information about the instance.
780
--
781
type IfaceInstABI = IfExtName
782
783
784
785
786
787
788

lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
lookupOccEnvL env k = lookupOccEnv env k `orElse` []

-- used when we want to fingerprint a structure without depending on the
-- fingerprints of external Names that it refers to.
putNameLiterally :: BinHandle -> Name -> IO ()
789
790
791
putNameLiterally bh name = ASSERT( isExternalName name ) 
  do { put_ bh $! nameModule name
     ; put_ bh $! nameOccName name }
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811

{-
-- for testing: use the md5sum command to generate fingerprints and
-- compare the results against our built-in version.
  fp' <- oldMD5 dflags bh
  if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
               else return fp

oldMD5 dflags bh = do
  tmp <- newTempName dflags "bin"
  writeBinMem bh tmp
  tmp2 <- newTempName dflags "md5"
  let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
  r <- system cmd
  case r of
    ExitFailure _ -> ghcError (PhaseFailed cmd r)
    ExitSuccess -> do
        hash_str <- readFile tmp2
        return $! readHexFingerprint hash_str
-}
812

813
814
815
816
817
818
819
820
821
822
instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
instOrphWarn unqual inst
  = mkWarnMsg (getSrcSpan inst) unqual $
    hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)

ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
ruleOrphWarn unqual mod rule
  = mkWarnMsg silly_loc unqual $
    ptext (sLit "Orphan rule:") <+> ppr rule
  where
823
    silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
824
825
    -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
    -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
826
827

----------------------
828
-- mkOrphMap partitions instance decls or rules into
dterei's avatar
dterei committed
829
830
831
832
833
834
835
836
837
--      (a) an OccEnv for ones that are not orphans, 
--          mapping the local OccName to a list of its decls
--      (b) a list of orphan decls
mkOrphMap :: (decl -> Maybe OccName)    -- (Just occ) for a non-orphan decl, keyed by occ
                                        -- Nothing for an orphan decl
          -> [decl]                     -- Sorted into canonical order
          -> (OccEnv [decl],            -- Non-orphan decls associated with their key;
                                        --      each sublist in canonical order
              [decl])                   -- Orphan decls; in canonical order
838
mkOrphMap get_key decls
839
840
841
  = foldl go (emptyOccEnv, []) decls
  where
    go (non_orphs, orphs) d
dterei's avatar
dterei committed
842
843
844
        | Just occ <- get_key d
        = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
        | otherwise = (non_orphs, d:orphs)
845
846
847
\end{code}


848
%************************************************************************
dterei's avatar
dterei committed
849
%*                                                                      *
850
       Keeping track of what we've slurped, and fingerprints
dterei's avatar
dterei committed
851
%*                                                                      *
852
%************************************************************************
853
854

\begin{code}
GregWeber's avatar
GregWeber committed
855
856
mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] -> IO [Usage]
mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files
dterei's avatar
dterei committed
857
  = do  { eps <- hscEPS hsc_env
GregWeber's avatar
GregWeber committed
858
    ; mtimes <- mapM getModificationTime dependent_files
dterei's avatar
dterei committed
859
860
861
862
863
864
865
        ; let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
                                     dir_imp_mods used_names
        ; let usages = mod_usages ++ map to_file_usage (zip dependent_files mtimes)
        ; usages `seqList`  return usages }
         -- seq the list of Usages returned: occasionally these
         -- don't get evaluated for a while and we can end up hanging on to
         -- the entire collection of Ifaces.
GregWeber's avatar
GregWeber committed
866
867
   where
     to_file_usage (f, mtime) = UsageFile { usg_file_path = f, usg_mtime = mtime }
868

GregWeber's avatar
GregWeber committed
869
mk_mod_usage_info :: PackageIfaceTable
870
              -> HscEnv
871
872
              -> Module
              -> ImportedMods
873
874
              -> NameSet
              -> [Usage]
GregWeber's avatar
GregWeber committed
875
mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
876
  = mapCatMaybes mkUsage usage_mods
877
  where
878
    hpt = hsc_HPT hsc_env
Simon Marlow's avatar
Simon Marlow committed
879
    dflags = hsc_dflags hsc_env
880
881
882
    this_pkg = thisPackage dflags

    used_mods    = moduleEnvKeys ent_map
883
    dir_imp_mods = moduleEnvKeys direct_imports
884
885
886
887
    all_mods     = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
    usage_mods   = sortBy stableModuleCmp all_mods
                        -- canonical order is imported, to avoid interface-file
                        -- wobblage.
888

889
    -- ent_map groups together all the things imported and used
890
    -- from a particular module
891
892
    ent_map :: ModuleEnv [OccName]
    ent_map  = foldNameSet add_mv emptyModuleEnv used_names
893
894
     where
      add_mv name mv_map
895
896
897
        | isWiredInName name = mv_map  -- ignore wired-in names
        | otherwise
        = case nameModule_maybe name of
898
             Nothing  -> ASSERT2( isSystemName name, ppr name ) mv_map
dterei's avatar
dterei committed
899
                -- See Note [Internal used_names]
900

901
902
             Just mod -> -- This lambda function is really just a
                         -- specialised (++); originally came about to
903
                         -- avoid quadratic behaviour (trac #2680)
904
                         extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod [occ]
dterei's avatar
dterei committed
905
                where occ = nameOccName name
906
907
    
    -- We want to create a Usage for a home module if 
dterei's avatar
dterei committed
908
909
910
    --  a) we used something from it; has something in used_names
    --  b) we imported it, even if we used nothing from it
    --     (need to recompile if its export list changes: export_fprint)
911
912
    mkUsage :: Module -> Maybe Usage
    mkUsage mod
dterei's avatar
dterei committed
913
914
      | isNothing maybe_iface           -- We can't depend on it if we didn't
                                        -- load its interface.
915
916
917
918
919
920
      || mod == this_mod                -- We don't care about usages of
                                        -- things in *this* module
      = Nothing

      | modulePackageId mod /= this_pkg
      = Just UsagePackageModule{ usg_mod      = mod,
921
922
                                 usg_mod_hash = mod_hash,
                                 usg_safe     = imp_safe }
923
924
925
        -- for package modules, we record the module hash only

      | (null used_occs
dterei's avatar
dterei committed
926
          && isNothing export_hash
927
          && not is_direct_import
dterei's avatar
dterei committed
928
929
          && not finsts_mod)
      = Nothing                 -- Record no usage info
930
931
932
        -- for directly-imported modules, we always want to record a usage
        -- on the orphan hash.  This is what triggers a recompilation if
        -- an orphan is added or removed somewhere below us in the future.
933
    
dterei's avatar
dterei committed
934
      | otherwise       
935
936
      = Just UsageHomeModule { 
                      usg_mod_name = moduleName mod,
937
938
939
940
                      usg_mod_hash = mod_hash,
                      usg_exports  = export_hash,
                      usg_entities = Map.toList ent_hashs,
                      usg_safe     = imp_safe }
941
      where
942
943
944
        maybe_iface  = lookupIfaceByModule dflags hpt pit mod
                -- In one-shot mode, the interfaces for home-package
                -- modules accumulate in the PIT not HPT.  Sigh.
Simon Marlow's avatar
Simon Marlow committed
945

946
        Just iface   = maybe_iface
dterei's avatar
dterei committed
947
        finsts_mod   = mi_finsts    iface
948
949
        hash_env     = mi_hash_fn   iface
        mod_hash     = mi_mod_hash  iface
dterei's avatar
dterei committed
950
        export_hash | depend_on_exports = Just (mi_exp_hash iface)
951
952
953
954
                    | otherwise         = Nothing

        (is_direct_import, imp_safe)
            = case lookupModuleEnv direct_imports mod of
955
956
                Just ((_,_,_,safe):_xs) -> (True, safe)
                Just _                  -> pprPanic "mkUsage: empty direct import" empty
957
                Nothing                 -> (False, safeImplicitImpsReq dflags)
958
                -- Nothing case is for implicit imports like 'System.IO' when 'putStrLn'
959
                -- is used in the source code. We require them to be safe in Safe Haskell
960
961
    
        used_occs = lookupModuleEnv ent_map mod `orElse` []
962

dterei's avatar
dterei committed
963
        -- Making a Map here ensures that (a) we remove duplicates
964
965
        -- when we have usages on several subordinates of a single parent,
        -- and (b) that the usages emerge in a canonical order, which
966
        -- is why we use Map rather than OccEnv: Map works
967
        -- using Ord on the OccNames, which is a lexicographic ordering.
dterei's avatar
dterei committed
968
        ent_hashs :: Map OccName Fingerprint
969
        ent_hashs = Map.fromList (map lookup_occ used_occs)
970
971
        
        lookup_occ occ = 
972
973
974
975
            case hash_env occ of
                Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
                Just r  -> r

dterei's avatar
dterei committed
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
        depend_on_exports = is_direct_import
        {- True
              Even if we used 'import M ()', we have to register a
              usage on the export list because we are sensitive to
              changes in orphan instances/rules.
           False
              In GHC 6.8.x we always returned true, and in
              fact it recorded a dependency on *all* the
              modules underneath in the dependency tree.  This
              happens to make orphans work right, but is too
              expensive: it'll read too many interface files.
              The 'isNothing maybe_iface' check above saved us
              from generating many of these usages (at least in
              one-shot mode), but that's even more bogus!
        -}
991
992
\end{code}

993
994
995
996
997
998
999
1000
1001
1002
1003
\begin{code}
mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
mkIfaceAnnotations = map mkIfaceAnnotation

mkIfaceAnnotation :: Annotation -> IfaceAnnotation
mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation { 
        ifAnnotatedTarget = fmap nameOccName target,
        ifAnnotatedValue = serialized
    }
\end{code}

1004
\begin{code}
1005
mkIfaceExports :: [AvailInfo] -> [IfaceExport]  -- Sort to make canonical
1006
mkIfaceExports exports
1007
  = sortBy stableAvailCmp (map sort_subs exports)
1008
  where
1009
1010
1011
1012
1013
1014
1015
    sort_subs :: AvailInfo -> AvailInfo
    sort_subs (Avail n) = Avail n
    sort_subs (AvailTC n []) = AvailTC n []
    sort_subs (AvailTC n (m:ms)) 
       | n==m      = AvailTC n (m:sortBy stableNameCmp ms)
       | otherwise = AvailTC n (sortBy stableNameCmp (m:ms))
       -- Maintain the AvailTC Invariant
1016
1017
\end{code}

1018
1019
1020
Note [Orignal module]
~~~~~~~~~~~~~~~~~~~~~
Consider this:
dterei's avatar
dterei committed
1021
1022
        module X where { data family T }
        module Y( T(..) ) where { import X; data instance T Int = MkT Int }
1023
The exported Avail from Y will look like
dterei's avatar
dterei committed
1024
        X.T{X.T, Y.MkT}
1025
1026
1027
1028
1029
1030
1031
1032
That is, in Y, 
  - only MkT is brought into scope by the data instance;
  - but the parent (used for grouping and naming in T(..) exports) is X.T
  - and in this case we export X.T too

In the result of MkIfaceExports, the names are grouped by defining module,
so we may need to split up a single Avail into multiple ones.

1033
1034
1035
Note [Internal used_names]
~~~~~~~~~~~~~~~~~~~~~~~~~~
Most of the used_names are External Names, but we can have Internal
1036
1037
Names too: see Note [Binders in Template Haskell] in Convert, and
Trac #5362 for an example.  Such Names are always
1038
1039
1040
1041
  - Such Names are always for locally-defined things, for which we
    don't gather usage info, so we can just ignore them in ent_map
  - They are always System Names, hence the assert, just as a double check.

1042

1043
%************************************************************************
dterei's avatar
dterei committed
1044
1045
1046
1047
1048
%*                                                                      *
        Load the old interface file for this module (unless
        we have it aleady), and check whether it is up to date
        
%*                                                                      *
1049
1050
1051
1052
%************************************************************************

\begin{code}
checkOldIface :: HscEnv
dterei's avatar
dterei committed
1053
              -> ModSummary
1054
              -> SourceModified
dterei's avatar
dterei committed
1055
1056
              -> Maybe ModIface         -- Old interface from compilation manager, if any
              -> IO (RecompileRequired, Maybe ModIface)
1057

1058
checkOldIface hsc_env mod_summary source_modified maybe_iface
1059
1060
1061
  = do  showPass (hsc_dflags hsc_env) $
            "Checking old interface for " ++ (showSDoc $ ppr $ ms_mod mod_summary)
        initIfaceCheck hsc_env $
1062
            check_old_iface hsc_env mod_summary source_modified maybe_iface
1063

1064
check_old_iface :: HscEnv -> ModSummary -> SourceModified -> Maybe ModIface
Ian Lynagh's avatar
Ian Lynagh committed
1065
                -> IfG (Bool, Maybe ModIface)
1066
1067
check_old_iface hsc_env mod_summary src_modified maybe_iface
  = let dflags = hsc_dflags hsc_env
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
        getIface =
             case maybe_iface of
                 Just _  -> do
                     traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
                     return maybe_iface
                 Nothing -> do
                     let iface_path = msHiFilePath mod_summary
                     read_result <- readIface (ms_mod mod_summary) iface_path False
                     case read_result of
                         Failed err -> do
                             traceIf (text "FYI: cannont read old interface file:" $$ nest 4 err)
                             return Nothing
                         Succeeded iface -> do
                             traceIf (text "Read the interface file" <+> text iface_path)
                             return $ Just iface

    in do
1085
1086
1087
1088
1089
1090
         let src_changed
              | dopt Opt_ForceRecomp (hsc_dflags hsc_env) = True
              | SourceModified <- src_modified = True
              | otherwise = False

         when src_changed
1091
1092
             (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))

1093
1094
1095
1096
         -- If the source has changed and we're in interactive mode,
         -- avoid reading an interface; just return the one we might
         -- have been supplied with.
         if not (isObjectTarget $ hscTarget dflags) && src_changed
1097
1098
1099
1100
1101
            then return (outOfDate, maybe_iface)
            else do
                -- Try and read the old interface for the current module
                -- from the .hi file left from the last time we compiled it
                maybe_iface' <- getIface
1102
1103
1104
                if src_changed
                   then return (outOfDate, maybe_iface')
                   else do
1105
1106
                case maybe_iface' of
                    Nothing -> return (outOfDate, maybe_iface')
1107
1108
1109
1110
1111
1112
                    Just iface ->
                      -- We have got the old iface; check its versions
                      -- even in the SourceUnmodifiedAndStable case we
                      -- should check versions because some packages
                      -- might have changed or gone away.
                      checkVersions hsc_env mod_summary iface
1113
1114
1115
1116
1117
1118
1119
1120
1121
\end{code}

@recompileRequired@ is called from the HscMain.   It checks whether
a recompilation is required.  It needs access to the persistent state,
finder, etc, because it may have to load lots of interface files to
check their versions.

\begin{code}
type RecompileRequired = Bool
Ian Lynagh's avatar
Ian Lynagh committed
1122
upToDate, outOfDate :: Bool
dterei's avatar
dterei committed
1123
1124
upToDate  = False       -- Recompile not required
outOfDate = True        -- Recompile required
1125

1126
1127
-- | Check the safe haskell flags haven't changed
--   (e.g different flag on command line now)
1128
1129
safeHsChanged :: HscEnv -> ModIface -> Bool
safeHsChanged hsc_env iface
1130
1131
  = (getSafeMode $ mi_trust iface) /= (safeHaskell $ hsc_dflags hsc_env)

Simon Marlow's avatar
Simon Marlow committed
1132
checkVersions :: HscEnv
1133
              -> ModSummary
dterei's avatar
dterei committed
1134
1135
              -> ModIface       -- Old interface
              -> IfG (RecompileRequired, Maybe ModIface)
1136
checkVersions hsc_env mod_summary iface
1137
  = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1138
                        ppr (mi_module iface) <> colon)
1139

1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
       ; recomp <- checkDependencies hsc_env mod_summary iface
       ; if recomp then return (outOfDate, Just iface) else do {
       ; if trust_dif then return (outOfDate, Nothing) else do {

       -- Source code unchanged and no errors yet... carry on
       --
       -- First put the dependent-module info, read from the old
       -- interface, into the envt, so that when we look for
       -- interfaces we look for the right one (.hi or .hi-boot)
       --
       -- It's just temporary because either the usage check will succeed
       -- (in which case we are done with this module) or it'll fail (in which
       -- case we'll compile the module from scratch anyhow).
       --
       -- We do this regardless of compilation mode, although in --make mode
       -- all the dependent modules should be in the HPT already, so it's
       -- quite redundant
       ; updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
       ; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
       ; return (recomp, Just iface)
1160
    }}}
1161
  where
1162
1163
    this_pkg  = thisPackage (hsc_dflags hsc_env)
    trust_dif = safeHsChanged hsc_env iface
1164
    -- This is a bit of a hack really
Simon Marlow's avatar
Simon Marlow committed
1165
    mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1166
1167
    mod_deps = mkModDeps (dep_mods (mi_deps iface))

1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190

-- If the direct imports of this module are resolved to targets that