MkIface.lhs 76.8 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
        RecompileRequired(..), recompileRequired,
23
24

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

28
29
30
  -----------------------------------------------
          Recompilation checking
  -----------------------------------------------
31

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

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

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

Basic idea: 
41

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

45
46
47
48
49
  * 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
50
51
    Also record any dependent files added with addDependentFile.
    In the future record any #include usages.
52
53

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

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

Simon Marlow's avatar
Simon Marlow committed
59
60
import IfaceSyn
import LoadIface
61
62
import FlagChecker

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

Simon Marlow's avatar
Simon Marlow committed
109
110
import Control.Monad
import Data.List
111
112
import Data.Map (Map)
import qualified Data.Map as Map
Simon Marlow's avatar
Simon Marlow committed
113
import Data.IORef
114
import System.Directory
Ian Lynagh's avatar
Ian Lynagh committed
115
import System.FilePath
116
117
118
119
120
\end{code}



%************************************************************************
121
%*                                                                      *
122
\subsection{Completing an interface}
123
%*                                                                      *
124
125
126
127
%************************************************************************

\begin{code}
mkIface :: HscEnv
128
129
130
131
        -> 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
132
               Maybe (ModIface, -- The new one
133
                      Bool))    -- True <=> there was an old Iface, and the
134
135
                                --          new one is identical, so no need
                                --          to write it
136

137
mkIface hsc_env maybe_old_fingerprint mod_details
138
139
140
141
142
143
144
145
146
147
148
149
         ModGuts{     mg_module       = this_mod,
                      mg_boot         = is_boot,
                      mg_used_names   = used_names,
                      mg_used_th      = used_th,
                      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,
                      mg_safe_haskell = safe_mode,
                      mg_trust_pkg    = self_trust,
GregWeber's avatar
GregWeber committed
150
151
                      mg_dependent_files = dependent_files
                    }
152
        = mkIface_ hsc_env maybe_old_fingerprint
153
                   this_mod is_boot used_names used_th deps rdr_env fix_env
154
155
                   warns hpc_info dir_imp_mods self_trust dependent_files
                   safe_mode mod_details
Thomas Schilling's avatar
Thomas Schilling committed
156

Simon Marlow's avatar
Simon Marlow committed
157
158
159
160
-- | 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
161
          -> Maybe Fingerprint  -- The old fingerprint, if we have it
162
          -> SafeHaskellMode    -- The safe haskell mode
dterei's avatar
dterei committed
163
164
165
          -> ModDetails         -- gotten from mkBootModDetails, probably
          -> TcGblEnv           -- Usages, deprecations, etc
          -> IO (Messages, Maybe (ModIface, Bool))
166
mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
Simon Marlow's avatar
Simon Marlow committed
167
168
169
170
171
  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
172
                      tcg_warns = warns,
173
                      tcg_hpc = other_hpc_info,
GregWeber's avatar
GregWeber committed
174
175
                      tcg_th_splice_used = tc_splice_used,
                      tcg_dependent_files = dependent_files
Simon Marlow's avatar
Simon Marlow committed
176
177
                    }
  = do
178
          let used_names = mkUsedNames tc_result
Simon Marlow's avatar
Simon Marlow committed
179
180
          deps <- mkDependencies tc_result
          let hpc_info = emptyHpcInfo other_hpc_info
181
          used_th <- readIORef tc_splice_used
GregWeber's avatar
GregWeber committed
182
          dep_files <- (readIORef dependent_files)
183
          mkIface_ hsc_env maybe_old_fingerprint
184
                   this_mod (isHsBoot hsc_src) used_names used_th deps rdr_env
185
                   fix_env warns hpc_info (imp_mods imports)
186
                   (imp_trust_own_pkg imports) dep_files safe_mode mod_details
Simon Marlow's avatar
Simon Marlow committed
187
188
        

189
190
mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
Simon Marlow's avatar
Simon Marlow committed
191
        
192
193
-- | 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
194
195
196
197
198
199
200
mkDependencies :: TcGblEnv -> IO Dependencies
mkDependencies
          TcGblEnv{ tcg_mod = mod,
                    tcg_imports = imports,
                    tcg_th_used = th_var
                  }
 = do 
dterei's avatar
dterei committed
201
202
203
      -- 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
204
205
206
207
208
209
210
                -- 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.)

211
212
          pkgs | th_used   = insertList thPackageId (imp_dep_pkgs imports)
               | otherwise = imp_dep_pkgs imports
Simon Marlow's avatar
Simon Marlow committed
213

214
215
216
217
218
          -- 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
219

220
      return Deps { dep_mods   = sortBy (stableModuleNameCmp `on` fst) dep_mods,
221
                    dep_pkgs   = dep_pkgs',
222
223
                    dep_orphs  = sortBy stableModuleCmp (imp_orphs  imports),
                    dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
224
225
                    -- sort to get into canonical order
                    -- NB. remember to use lexicographic ordering
Simon Marlow's avatar
Simon Marlow committed
226

227
mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
228
         -> NameSet -> Bool -> Dependencies -> GlobalRdrEnv
Ian Lynagh's avatar
Ian Lynagh committed
229
         -> NameEnv FixItem -> Warnings -> HpcInfo
230
         -> ImportedMods -> Bool
GregWeber's avatar
GregWeber committed
231
         -> [FilePath]
232
         -> SafeHaskellMode
Ian Lynagh's avatar
Ian Lynagh committed
233
         -> ModDetails
234
         -> IO (Messages, Maybe (ModIface, Bool))
235
mkIface_ hsc_env maybe_old_fingerprint 
236
         this_mod is_boot used_names used_th deps rdr_env fix_env src_warns
237
         hpc_info dir_imp_mods pkg_trust_req dependent_files safe_mode
dterei's avatar
dterei committed
238
239
240
241
         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
242
                      md_vect_info = vect_info,
dterei's avatar
dterei committed
243
244
245
246
247
248
249
250
                      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
Simon Marlow's avatar
Simon Marlow committed
251

dterei's avatar
dterei committed
252
        ; let   { entities = typeEnvElts type_env ;
253
                  decls  = [ tyThingToIfaceDecl entity
dterei's avatar
dterei committed
254
255
                           | entity <- entities,
                             let name = getName entity,
256
                             not (isImplicitTyThing entity),
dterei's avatar
dterei committed
257
258
259
260
261
262
263
264
265
266
267
                                -- 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
268
                ; iface_vect_info = flattenVectInfo vect_info
269
                ; trust_info  = setSafeMode safe_mode
270

dterei's avatar
dterei committed
271
272
273
274
275
276
277
278
279
280
281
282
                ; 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,
283

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

dterei's avatar
dterei committed
286
287
288
                        mi_fixities    = fixities,
                        mi_warns       = warns,
                        mi_anns        = mkIfaceAnnotations anns,
289
                        mi_globals     = maybeGlobalRdrEnv rdr_env,
290

291
                        -- Left out deliberately: filled in by addFingerprints
dterei's avatar
dterei committed
292
293
                        mi_iface_hash  = fingerprint0,
                        mi_mod_hash    = fingerprint0,
294
                        mi_flag_hash   = fingerprint0,
dterei's avatar
dterei committed
295
                        mi_exp_hash    = fingerprint0,
dterei's avatar
dterei committed
296
                        mi_used_th     = used_th,
297
                        mi_orphan_hash = fingerprint0,
298
                        mi_orphan      = False, -- Always set by addFingerprints, but
dterei's avatar
dterei committed
299
                                                -- it's a strict field, so we can't omit it.
dterei's avatar
dterei committed
300
                        mi_finsts      = False, -- Ditto
dterei's avatar
dterei committed
301
302
303
304
305
                        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,
306

dterei's avatar
dterei committed
307
308
309
310
                        -- And build the cached values
                        mi_warn_fn     = mkIfaceWarnCache warns,
                        mi_fix_fn      = mkIfaceFixCache fixities }
                }
311

312
        ; (new_iface, no_change_at_all) 
dterei's avatar
dterei committed
313
314
                <- {-# SCC "versioninfo" #-}
                         addFingerprints hsc_env maybe_old_fingerprint
315
                                         intermediate_iface decls
316

dterei's avatar
dterei committed
317
318
                -- Warn about orphans
        ; let warn_orphs      = wopt Opt_WarnOrphans dflags
319
              warn_auto_orphs = wopt Opt_WarnAutoOrphans dflags
320
              orph_warnings   --- Laziness means no work done unless -fwarn-orphans
dterei's avatar
dterei committed
321
322
323
324
325
326
327
328
329
330
                | 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)
331
332
                                     , if ifRuleAuto r then warn_auto_orphs
                                                       else warn_orphs ]
333

dterei's avatar
dterei committed
334
        ; if errorsFound dflags errs_and_warns
Thomas Schilling's avatar
Thomas Schilling committed
335
336
            then return ( errs_and_warns, Nothing )
            else do {
337

dterei's avatar
dterei committed
338
339
340
                -- Debug printing
        ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE" 
                        (pprModIface new_iface)
341

342
343
                -- bug #1617: on reload we weren't updating the PrintUnqualified
                -- correctly.  This stems from the fact that the interface had
344
                -- not changed, so addFingerprints returns the old ModIface
345
                -- with the old GlobalRdrEnv (mi_globals).
346
        ; let final_iface = new_iface{ mi_globals = maybeGlobalRdrEnv rdr_env }
347

dterei's avatar
dterei committed
348
        ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
349
  where
350
351
352
353
354
     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
355
356
        -- Compare lexicographically by OccName, *not* by unique, because 
        -- the latter is not stable across compilations
357
     le_occ n1 n2 = nameOccName n1 <= nameOccName n2
358

359
     dflags = hsc_dflags hsc_env
360

361
362
363
364
365
     -- We only fill in mi_globals if the module was compiled to byte
     -- code.  Otherwise, the compiler may not have retained all the
     -- top-level bindings and they won't be in the TypeEnv (see
     -- Desugar.addExportFlagsAndRules).  The mi_globals field is used
     -- by GHCi to decide whether the module has its full top-level
Simon Marlow's avatar
Simon Marlow committed
366
     -- scope available. (#5534)
367
368
369
370
371
     maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
     maybeGlobalRdrEnv rdr_env
         | targetRetainsAllBindings (hscTarget dflags) = Just rdr_env
         | otherwise                                   = Nothing

372
     deliberatelyOmitted :: String -> a
373
     deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
374

375
     ifFamInstTcName = ifFamInstFam
376

377
378
379
380
     flattenVectInfo (VectInfo { vectInfoVar          = vVar
                               , vectInfoTyCon        = vTyCon
                               , vectInfoScalarVars   = vScalarVars
                               , vectInfoScalarTyCons = vScalarTyCons
381
                               }) = 
382
383
384
385
386
387
       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
388
       } 
389

390
-----------------------------
391
392
writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
writeIfaceFile dflags location new_iface
393
    = do createDirectoryIfMissing True (takeDirectory hi_file_path)
394
         writeBinIface dflags hi_file_path new_iface
395
    where hi_file_path = ml_hi_file location
396
397


398
399
-- -----------------------------------------------------------------------------
-- Look up parents and versions of Names
400

401
402
-- 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
403
-- the parent and version info.
404

405
mkHashFun
406
407
        :: HscEnv                       -- needed to look up versions
        -> ExternalPackageState         -- ditto
408
409
        -> (Name -> Fingerprint)
mkHashFun hsc_env eps
410
411
  = \name -> 
      let 
412
        mod = ASSERT2( isExternalName name, ppr name ) nameModule name
413
414
415
416
        occ = nameOccName name
        iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse` 
                   pprPanic "lookupVers2" (ppr mod <+> ppr occ)
      in  
417
418
        snd (mi_hash_fn iface occ `orElse` 
                  pprPanic "lookupVers1" (ppr mod <+> ppr occ))
419
  where
420
421
      hpt = hsc_HPT hsc_env
      pit = eps_PIT eps
422

423
424
425
426
427
428
-- ---------------------------------------------------------------------------
-- Compute fingerprints for the interface

addFingerprints
        :: HscEnv
        -> Maybe Fingerprint -- the old fingerprint, if any
dterei's avatar
dterei committed
429
        -> ModIface          -- The new interface (lacking decls)
430
431
        -> [IfaceDecl]       -- The new decls
        -> IO (ModIface,     -- Updated interface
dterei's avatar
dterei committed
432
               Bool)         -- True <=> no changes at all; 
433
434
435
436
437
438
                             -- no need to write Iface

addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
 = do
   eps <- hscEPS hsc_env
   let
439
        -- The ABI of a declaration represents everything that is made
440
441
442
443
        -- visible about the declaration that a client can depend on.
        -- see IfaceDeclABI below.
       declABI :: IfaceDecl -> IfaceDeclABI 
       declABI decl = (this_mod, decl, extras)
444
445
        where extras = declExtras fix_fn non_orph_rules non_orph_insts
                                  non_orph_fis decl
446
447
448

       edges :: [(IfaceDeclABI, Unique, [Unique])]
       edges = [ (abi, getUnique (ifName decl), out)
dterei's avatar
dterei committed
449
               | decl <- new_decls
450
               , let abi = declABI decl
dterei's avatar
dterei committed
451
               , let out = localOccs $ freeNamesDeclABI abi
452
453
               ]

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
454
       name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
455
       localOccs = map (getUnique . getParent . getOccName) 
456
                        . filter ((== this_mod) . name_module)
457
458
459
460
461
462
463
464
465
                        . 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 = 
466
                  extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ]
467
468
469
                  where n = ifName d

        -- strongly-connected groups of declarations, in dependency order
470
       groups = stronglyConnCompFromEdgedVertices edges
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485

       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
486
          = ASSERT2( isExternalName name, ppr name )
dterei's avatar
dterei committed
487
            let hash | nameModule name /= this_mod =  global_hash_fn name
488
                     | otherwise = snd (lookupOccEnv local_env (getOccName name)
489
490
                           `orElse` pprPanic "urk! lookup local fingerprint" 
                                       (ppr name)) -- (undefined,fingerprint0))
491
492
493
494
495
496
497
                -- 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.
498
            in put_ bh hash
499
500
501
502
503
504
505
506
507
508
509
510
511
512

        -- 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
513
               hash <- computeFingerprint hash_fn abi
514
515
               env' <- extend_hash_env local_env (hash,decl)
               return (env', (hash,decl) : decls_w_hashes)
516
517
518

       fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
          = do let decls = map abiDecl abis
519
               local_env1 <- foldM extend_hash_env local_env
520
                                   (zip (repeat fingerprint0) decls)
521
               let hash_fn = mk_put_name local_env1
522
523
524
               -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
               let stable_abis = sortBy cmp_abiNames abis
                -- put the cycle in a canonical order
525
               hash <- computeFingerprint hash_fn stable_abis
526
               let pairs = zip (repeat hash) decls
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
               local_env2 <- foldM extend_hash_env local_env pairs
               return (local_env2, pairs ++ decls_w_hashes)

       -- we have fingerprinted the whole declaration, but we now need
       -- to assign fingerprints to all the OccNames that it binds, to
       -- use when referencing those OccNames in later declarations.
       --
       -- We better give each name bound by the declaration a
       -- different fingerprint!  So we calculate the fingerprint of
       -- each binder by combining the fingerprint of the whole
       -- declaration with the name of the binder. (#5614)
       extend_hash_env :: OccEnv (OccName,Fingerprint)
                       -> (Fingerprint,IfaceDecl)
                       -> IO (OccEnv (OccName,Fingerprint))
       extend_hash_env env0 (hash,d) = do
          let
543
            sub_bndrs = ifaceDeclImplicitBndrs d
544
545
546
547
548
            fp_sub_bndr occ = computeFingerprint putNameLiterally (hash,occ)
          --
          sub_fps <- mapM fp_sub_bndr sub_bndrs
          return (foldr (\(b,fp) env -> extendOccEnv env b (b,fp)) env1
                        (zip sub_bndrs sub_fps))
549
        where
550
551
552
          decl_name = ifName d
          item = (decl_name, hash)
          env1 = extendOccEnv env0 decl_name item
553

554
555
556
557
   --
   (local_env, decls_w_hashes) <- 
       foldM fingerprint_group (emptyOccEnv, []) groups

558
559
560
561
562
   -- 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)

563
   -- the export hash of a module depends on the orphan hashes of the
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
564
   -- orphan modules below us in the dependency tree.  This is the way
565
566
567
568
   -- 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.
569
570
   let orph_mods = filter ((== this_pkg) . modulePackageId)
                   $ dep_orphs sorted_deps
571
572
   dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods

573
   orphan_hash <- computeFingerprint (mk_put_name local_env)
574
                      (map ifDFun orph_insts, orph_rules, orph_fis)
575
576
577

   -- the export list hash doesn't depend on the fingerprints of
   -- the Names it mentions, only the Names themselves, hence putNameLiterally.
578
   export_hash <- computeFingerprint putNameLiterally
579
580
581
                      (mi_exports iface0,
                       orphan_hash,
                       dep_orphan_hashes,
582
                       dep_pkgs (mi_deps iface0),
583
584
                        -- dep_pkgs: see "Package Version Changes" on
                        -- wiki/Commentary/Compiler/RecompilationAvoidance
585
                       mi_trust iface0)
586
                        -- Make sure change of Safe Haskell mode causes recomp.
587
588

   -- put the declarations in a canonical order, sorted by OccName
589
   let sorted_decls = Map.elems $ Map.fromList $
590
                          [(ifName d, e) | e@(_, d) <- decls_w_hashes]
591
592
593
594
595
   
   -- the flag hash depends on:
   --   - (some of) dflags
   -- it returns two hashes, one that shouldn't change
   -- the abi hash and one that should
596
   flag_hash <- fingerprintDynFlags dflags this_mod putNameLiterally
597
598
599
600
601
602

   -- the ABI hash depends on:
   --   - decls
   --   - export list
   --   - orphans
   --   - deprecations
603
   --   - vect info
604
   --   - flag abi hash
605
   mod_hash <- computeFingerprint putNameLiterally
606
                      (map fst sorted_decls,
607
                       export_hash,  -- includes orphan_hash
608
609
                       mi_warns iface0,
                       mi_vect_info iface0)
610
611

   -- The interface hash depends on:
612
613
614
615
   --   - the ABI hash, plus
   --   - usages
   --   - deps
   --   - hpc
616
   iface_hash <- computeFingerprint putNameLiterally
617
618
                      (mod_hash, 
                       mi_usages iface0,
619
                       sorted_deps,
620
621
622
623
624
625
626
627
628
629
                       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,
630
                mi_flag_hash   = flag_hash,
631
632
633
                mi_orphan      = not (   null orph_rules
                                      && null orph_insts
                                      && null orph_fis
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
634
                                      && isNoIfaceVectInfo (mi_vect_info iface0)),
635
636
637
638
                mi_finsts      = not . null $ mi_fam_insts iface0,
                mi_decls       = sorted_decls,
                mi_hash_fn     = lookupOccEnv local_env }
   --
639
   return (final_iface, no_change_at_all)
640

641
642
643
644
  where
    this_mod = mi_module iface0
    dflags = hsc_dflags hsc_env
    this_pkg = thisPackage dflags
645
646
647
    (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph    (mi_insts iface0)
    (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph    (mi_rules iface0)
    (non_orph_fis,   orph_fis)   = mkOrphMap ifFamInstOrph (mi_fam_insts iface0)
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
    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)


666
667
668
sortDependencies :: Dependencies -> Dependencies
sortDependencies d
 = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
669
          dep_pkgs   = sortBy (stablePackageIdCmp `on` fst) (dep_pkgs d),
670
671
          dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
          dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
672
673
674
675
\end{code}


%************************************************************************
dterei's avatar
dterei committed
676
677
678
%*                                                                      *
          The ABI of an IfaceDecl                                                                               
%*                                                                      *
679
680
681
682
683
684
685
686
687
%************************************************************************

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).
688

689
690
691
692
693
694
695
696
697
698
699
   (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
700
701
the declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
and fingerprinting that as part of the declaration.
702
703

\begin{code}
704
705
type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)

706
707
data IfaceDeclExtras 
  = IfaceIdExtras    Fixity [IfaceRule]
708
709

  | IfaceDataExtras  
dterei's avatar
dterei committed
710
       Fixity                   -- Fixity of the tycon itself
711
       [IfaceInstABI]           -- Local class and family instances of this tycon
dterei's avatar
dterei committed
712
713
                                -- See Note [Orphans] in IfaceSyn
       [(Fixity,[IfaceRule])]   -- For each construcotr, fixity and RULES
714
715

  | IfaceClassExtras 
dterei's avatar
dterei committed
716
717
718
719
720
       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
721

722
  | IfaceSynExtras   Fixity [IfaceInstABI]
723

724
725
  | IfaceOtherDeclExtras

726
727
728
729
730
731
-- When hashing a class or family instance, we hash only the 
-- DFunId or CoAxiom, because that depends on all the 
-- information about the instance.
--
type IfaceInstABI = IfExtName   -- Name of DFunId or CoAxiom that is evidence for the instance

732
733
734
735
736
737
738
739
740
741
742
743
744
745
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)
746
747
748
749
freeNamesDeclExtras (IfaceDataExtras  _ insts subs)
  = unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
freeNamesDeclExtras (IfaceClassExtras _ insts subs)
  = unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
750
751
freeNamesDeclExtras (IfaceSynExtras _ insts)
  = mkNameSet insts
752
753
754
755
756
757
freeNamesDeclExtras IfaceOtherDeclExtras
  = emptyNameSet

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

758
759
760
instance Outputable IfaceDeclExtras where
  ppr IfaceOtherDeclExtras       = empty
  ppr (IfaceIdExtras  fix rules) = ppr_id_extras fix rules
761
762
763
  ppr (IfaceSynExtras fix finsts) = vcat [ppr fix, ppr finsts]
  ppr (IfaceDataExtras fix insts stuff) = vcat [ppr fix, ppr_insts insts,
                                                ppr_id_extras_s stuff]
764
765
766
767
768
769
770
771
772
773
774
775
  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)

776
-- This instance is used only to compute fingerprints
777
778
779
780
781
782
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
783
784
  put_ bh (IfaceClassExtras fix insts methods) = do
   putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
785
786
  put_ bh (IfaceSynExtras fix finsts) = do
   putByte bh 4; put_ bh fix; put_ bh finsts
787
  put_ bh IfaceOtherDeclExtras = do
788
   putByte bh 5
789
790
791

declExtras :: (OccName -> Fixity)
           -> OccEnv [IfaceRule]
792
793
           -> OccEnv [IfaceClsInst]
           -> OccEnv [IfaceFamInst]
794
795
796
           -> IfaceDecl
           -> IfaceDeclExtras

797
declExtras fix_fn rule_env inst_env fi_env decl
798
799
800
801
802
  = case decl of
      IfaceId{} -> IfaceIdExtras (fix_fn n) 
                        (lookupOccEnvL rule_env n)
      IfaceData{ifCons=cons} -> 
                     IfaceDataExtras (fix_fn n)
803
804
                        (map ifFamInstAxiom (lookupOccEnvL fi_env n) ++
                         map ifDFun         (lookupOccEnvL inst_env n))
805
                        (map (id_extras . ifConOcc) (visibleIfConDecls cons))
806
      IfaceClass{ifSigs=sigs, ifATs=ats} -> 
807
                     IfaceClassExtras (fix_fn n)
808
                        (map ifDFun $ (concatMap at_extras ats)
809
                                    ++ lookupOccEnvL inst_env n)
dterei's avatar
dterei committed
810
811
                           -- Include instances of the associated types
                           -- as well as instances of the class (Trac #5147)
812
                        [id_extras op | IfaceClassOp op _ _ <- sigs]
813
814
      IfaceSyn{} -> IfaceSynExtras (fix_fn n) 
                        (map ifFamInstAxiom (lookupOccEnvL fi_env n))
815
816
817
818
      _other -> IfaceOtherDeclExtras
  where
        n = ifName decl
        id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
819
        at_extras (IfaceAT decl _) = lookupOccEnvL inst_env (ifName decl)
820
821
822
823
824
825
826
827


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 ()
828
829
830
putNameLiterally bh name = ASSERT( isExternalName name ) 
  do { put_ bh $! nameModule name
     ; put_ bh $! nameOccName name }
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850

{-
-- 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
-}
851

852
instOrphWarn :: PrintUnqualified -> ClsInst -> WarnMsg
853
854
instOrphWarn unqual inst
  = mkWarnMsg (getSrcSpan inst) unqual $
855
    hang (ptext (sLit "Orphan instance:")) 2 (pprInstanceHdr inst)
856
857
858
859
860
861

ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
ruleOrphWarn unqual mod rule
  = mkWarnMsg silly_loc unqual $
    ptext (sLit "Orphan rule:") <+> ppr rule
  where
862
    silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
863
864
    -- 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
865
866

----------------------
867
-- mkOrphMap partitions instance decls or rules into
dterei's avatar
dterei committed
868
869
870
871
872
873
874
875
876
--      (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
877
mkOrphMap get_key decls
878
879
880
  = foldl go (emptyOccEnv, []) decls
  where
    go (non_orphs, orphs) d
dterei's avatar
dterei committed
881
882
883
        | Just occ <- get_key d
        = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
        | otherwise = (non_orphs, d:orphs)
884
885
886
\end{code}


887
%************************************************************************
dterei's avatar
dterei committed
888
%*                                                                      *
889
       Keeping track of what we've slurped, and fingerprints
dterei's avatar
dterei committed
890
%*                                                                      *
891
%************************************************************************
892
893

\begin{code}
GregWeber's avatar
GregWeber committed
894
895
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
896
  = do  { eps <- hscEPS hsc_env
897
    ; mtimes <- mapM getModificationUTCTime dependent_files
dterei's avatar
dterei committed
898
899
900
901
902
903
904
        ; 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
905
906
   where
     to_file_usage (f, mtime) = UsageFile { usg_file_path = f, usg_mtime = mtime }
907

GregWeber's avatar
GregWeber committed
908
mk_mod_usage_info :: PackageIfaceTable
909
              -> HscEnv
910
911
              -> Module
              -> ImportedMods
912
913
              -> NameSet
              -> [Usage]
GregWeber's avatar
GregWeber committed
914
mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
915
  = mapCatMaybes mkUsage usage_mods
916
  where
917
    hpt = hsc_HPT hsc_env
Simon Marlow's avatar
Simon Marlow committed
918
    dflags = hsc_dflags hsc_env
919
920
921
    this_pkg = thisPackage dflags

    used_mods    = moduleEnvKeys ent_map
922
    dir_imp_mods = moduleEnvKeys direct_imports
923
924
925
926
    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.
927

928
    -- ent_map groups together all the things imported and used
929
    -- from a particular module
930
931
    ent_map :: ModuleEnv [OccName]
    ent_map  = foldNameSet add_mv emptyModuleEnv used_names
932
933
     where
      add_mv name mv_map
934
935
936
        | isWiredInName name = mv_map  -- ignore wired-in names
        | otherwise
        = case nameModule_maybe name of
937
             Nothing  -> ASSERT2( isSystemName name, ppr name ) mv_map
dterei's avatar
dterei committed
938
                -- See Note [Internal used_names]
939

940
941
             Just mod -> -- This lambda function is really just a
                         -- specialised (++); originally came about to
942
                         -- avoid quadratic behaviour (trac #2680)
943
                         extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod [occ]
dterei's avatar
dterei committed
944
                where occ = nameOccName name
945
946
    
    -- We want to create a Usage for a home module if 
dterei's avatar
dterei committed
947
948
949
    --  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)
950
951
    mkUsage :: Module -> Maybe Usage
    mkUsage mod
dterei's avatar
dterei committed
952
953
      | isNothing maybe_iface           -- We can't depend on it if we didn't
                                        -- load its interface.
954
955
956
957
958
959
      || mod == this_mod                -- We don't care about usages of
                                        -- things in *this* module
      = Nothing

      | modulePackageId mod /= this_pkg
      = Just UsagePackageModule{ usg_mod      = mod,
960
961
                                 usg_mod_hash = mod_hash,
                                 usg_safe     = imp_safe }
962
963
964
        -- for package modules, we record the module hash only

      | (null used_occs
dterei's avatar
dterei committed
965
          && isNothing export_hash
966
          && not is_direct_import
dterei's avatar
dterei committed
967
968
          && not finsts_mod)
      = Nothing                 -- Record no usage info
969
970
971
        -- 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.
972
    
dterei's avatar
dterei committed
973
      | otherwise       
974
975
      = Just UsageHomeModule { 
                      usg_mod_name = moduleName mod,
976
977
978
979
                      usg_mod_hash = mod_hash,
                      usg_exports  = export_hash,
                      usg_entities = Map.toList ent_hashs,
                      usg_safe     = imp_safe }
980
      where
981
982
983
        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
984

985
        Just iface   = maybe_iface
dterei's avatar
dterei committed
986
        finsts_mod   = mi_finsts    iface
987
988
        hash_env     = mi_hash_fn   iface
        mod_hash     = mi_mod_hash  iface
dterei's avatar
dterei committed
989
        export_hash | depend_on_exports = Just (mi_exp_hash iface)
990
991
992
993
                    | otherwise         = Nothing

        (is_direct_import, imp_safe)
            = case lookupModuleEnv direct_imports mod of
994
995
                Just ((_,_,_,safe):_xs) -> (True, safe)
                Just _                  -> pprPanic "mkUsage: empty direct import" empty
996
                Nothing                 -> (False, safeImplicitImpsReq dflags)
997
                -- Nothing case is for implicit imports like 'System.IO' when 'putStrLn'
998
                -- is used in the source code. We require them to be safe in Safe Haskell
999
1000
    
        used_occs = lookupModuleEnv ent_map mod `orElse` []
1001

dterei's avatar
dterei committed
1002
        -- Making a Map here ensures that (a) we remove duplicates
1003
1004
        -- when we have usages on several subordinates of a single parent,
        -- and (b) that the usages emerge in a canonical order, which
1005
        -- is why we use Map rather than OccEnv: Map works
1006
        -- using Ord on the OccNames, which is a lexicographic ordering.
dterei's avatar
dterei committed
1007
        ent_hashs :: Map OccName Fingerprint
1008
        ent_hashs = Map.fromList (map lookup_occ used_occs)
1009
1010
        
        lookup_occ occ = 
1011
1012
1013
1014
            case hash_env occ of
                Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
                Just r  -> r

dterei's avatar
dterei committed
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
        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!
        -}
1030
1031
\end{code}

1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
\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}

1043
\begin{code}
1044
mkIfaceExports :: [AvailInfo] -> [IfaceExport]  -- Sort to make canonical
1045
mkIfaceExports exports
1046
  = sortBy stableAvailCmp (map sort_subs exports)
1047
  where
1048
1049
1050
1051
1052
1053
1054
    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
1055
1056
\end{code}

1057
1058
1059
Note [Orignal module]
~~~~~~~~~~~~~~~~~~~~~
Consider this:
dterei's avatar
dterei committed
1060
1061
        module X where { data family T }
        module Y( T(..) ) where { import X; data instance T Int = MkT Int }
1062
The exported Avail from Y will look like
dterei's avatar
dterei committed
1063
        X.T{X.T, Y.MkT}
1064
1065
1066
1067
1068
1069
1070
1071
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.

1072
1073
1074
Note [Internal used_names]
~~~~~~~~~~~~~~~~~~~~~~~~~~
Most of the used_names are External Names, but we can have Internal
1075
1076
Names too: see Note [Binders in Template Haskell] in Convert, and
Trac #5362 for an example.  Such Names are always
1077
1078
1079
1080
  - 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.

1081

1082
%************************************************************************
dterei's avatar
dterei committed
1083
1084
%*                                                                      *
        Load the old interface file for this module (unless
1085
        we have it already), and check whether it is up to date
dterei's avatar
dterei committed
1086
%*                                                                      *
1087
1088
1089
%************************************************************************

\begin{code}
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
data RecompileRequired
  = UpToDate
       -- ^ everything is up to date, recompilation is not required
  | MustCompile
       -- ^ The .hs file has been touched, or the .o/.hi file does not exist
  | RecompBecause String
       -- ^ The .o/.hi files are up to date, but something else has changed
       -- to force recompilation; the String says what (one-line summary)
  | RecompForcedByTH
       -- ^ recompile is forced due to use of TH by the module
   deriving Eq

recompileRequired :: RecompileRequired -> Bool
recompileRequired UpToDate = False
recompileRequired _ = True