MkIface.lhs 76.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
        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
import Control.Monad
Ian Lynagh's avatar
Ian Lynagh committed
110
import Data.Function
Simon Marlow's avatar
Simon Marlow committed
111
import Data.List
112
113
import Data.Map (Map)
import qualified Data.Map as Map
Ian Lynagh's avatar
Ian Lynagh committed
114
import Data.Ord
Simon Marlow's avatar
Simon Marlow committed
115
import Data.IORef
116
import System.Directory
Ian Lynagh's avatar
Ian Lynagh committed
117
import System.FilePath
118
119
120
121
122
\end{code}



%************************************************************************
123
%*                                                                      *
124
\subsection{Completing an interface}
125
%*                                                                      *
126
127
128
129
%************************************************************************

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

139
mkIface hsc_env maybe_old_fingerprint mod_details
140
141
142
143
144
145
146
147
148
149
150
151
         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
152
153
                      mg_dependent_files = dependent_files
                    }
154
        = mkIface_ hsc_env maybe_old_fingerprint
155
                   this_mod is_boot used_names used_th deps rdr_env fix_env
156
157
                   warns hpc_info dir_imp_mods self_trust dependent_files
                   safe_mode mod_details
Thomas Schilling's avatar
Thomas Schilling committed
158

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

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

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

216
217
218
219
220
          -- 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
221

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

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

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

dterei's avatar
dterei committed
273
274
275
276
277
278
279
280
281
                ; 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
Ian Lynagh's avatar
Ian Lynagh committed
282
283
284
                        mi_insts       = sortBy cmp_inst     iface_insts,
                        mi_fam_insts   = sortBy cmp_fam_inst iface_fam_insts,
                        mi_rules       = sortBy cmp_rule     iface_rules,
285

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

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

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

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

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

dterei's avatar
dterei committed
319
320
                -- Warn about orphans
        ; let warn_orphs      = wopt Opt_WarnOrphans dflags
321
              warn_auto_orphs = wopt Opt_WarnAutoOrphans dflags
322
              orph_warnings   --- Laziness means no work done unless -fwarn-orphans
dterei's avatar
dterei committed
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
Ian Lynagh's avatar
Ian Lynagh committed
327
              inst_warns = listToBag [ instOrphWarn dflags unqual d 
dterei's avatar
dterei committed
328
329
                                     | (d,i) <- insts `zip` iface_insts
                                     , isNothing (ifInstOrph i) ]
Ian Lynagh's avatar
Ian Lynagh committed
330
              rule_warns = listToBag [ ruleOrphWarn dflags unqual this_mod r 
dterei's avatar
dterei committed
331
332
                                     | r <- iface_rules
                                     , isNothing (ifRuleOrph r)
333
334
                                     , if ifRuleAuto r then warn_auto_orphs
                                                       else warn_orphs ]
335

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

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

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

dterei's avatar
dterei committed
350
        ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
351
  where
Ian Lynagh's avatar
Ian Lynagh committed
352
353
354
355
356
     cmp_rule     = comparing ifRuleName
     -- Compare these lexicographically by OccName, *not* by unique,
     -- because the latter is not stable across compilations:
     cmp_inst     = comparing (nameOccName . ifDFun)
     cmp_fam_inst = comparing (nameOccName . ifFamInstTcName)
357

358
     dflags = hsc_dflags hsc_env
359

360
361
362
363
364
     -- 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
365
     -- scope available. (#5534)
366
367
368
369
370
     maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
     maybeGlobalRdrEnv rdr_env
         | targetRetainsAllBindings (hscTarget dflags) = Just rdr_env
         | otherwise                                   = Nothing

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

374
     ifFamInstTcName = ifFamInstFam
375

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

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


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

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

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

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

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

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

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

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

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

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

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

       fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
          = do let decls = map abiDecl abis
518
               local_env1 <- foldM extend_hash_env local_env
519
                                   (zip (repeat fingerprint0) decls)
520
               let hash_fn = mk_put_name local_env1
521
522
523
               -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
               let stable_abis = sortBy cmp_abiNames abis
                -- put the cycle in a canonical order
524
               hash <- computeFingerprint hash_fn stable_abis
525
               let pairs = zip (repeat hash) decls
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
               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
542
            sub_bndrs = ifaceDeclImplicitBndrs d
543
544
545
546
547
            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))
548
        where
549
550
551
          decl_name = ifName d
          item = (decl_name, hash)
          env1 = extendOccEnv env0 decl_name item
552

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

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

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

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

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

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

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

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

640
641
642
643
  where
    this_mod = mi_module iface0
    dflags = hsc_dflags hsc_env
    this_pkg = thisPackage dflags
644
645
646
    (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)
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
    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)


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


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

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

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

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

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

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

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

721
  | IfaceSynExtras   Fixity [IfaceInstABI]
722

723
724
  | IfaceOtherDeclExtras

725
726
727
728
729
730
-- 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

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

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

757
758
759
instance Outputable IfaceDeclExtras where
  ppr IfaceOtherDeclExtras       = empty
  ppr (IfaceIdExtras  fix rules) = ppr_id_extras fix rules
760
761
762
  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]
763
764
765
766
767
768
769
770
771
772
773
774
  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)

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

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

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


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

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

Ian Lynagh's avatar
Ian Lynagh committed
851
852
853
instOrphWarn :: DynFlags -> PrintUnqualified -> ClsInst -> WarnMsg
instOrphWarn dflags unqual inst
  = mkWarnMsg dflags (getSrcSpan inst) unqual $
854
    hang (ptext (sLit "Orphan instance:")) 2 (pprInstanceHdr inst)
855

Ian Lynagh's avatar
Ian Lynagh committed
856
857
858
ruleOrphWarn :: DynFlags -> PrintUnqualified -> Module -> IfaceRule -> WarnMsg
ruleOrphWarn dflags unqual mod rule
  = mkWarnMsg dflags silly_loc unqual $
859
860
    ptext (sLit "Orphan rule:") <+> ppr rule
  where
861
    silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
862
863
    -- 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
864
865

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1080

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