MkIface.hs 85.3 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006-2008
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-}
5

6 7
{-# LANGUAGE CPP, NondecreasingIndentation #-}

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

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

19
        writeIfaceFile, -- Write the interface file
20

21 22
        checkOldIface,  -- See if recompilation is required, by
                        -- comparing version information
23
        RecompileRequired(..), recompileRequired,
24 25

        tyThingToIfaceDecl -- Converting things to their Iface equivalents
26 27
 ) where

Austin Seipp's avatar
Austin Seipp committed
28
{-
29 30 31
  -----------------------------------------------
          Recompilation checking
  -----------------------------------------------
32

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

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

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

41
Basic idea:
42

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

46 47 48 49 50
  * 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.
51 52 53 54
    Also record any dependent files added with
      * addDependentFile
      * #include
      * -optP-include
55 56

  * In checkOldIface we compare the mi_usages for the module with
57
    the actual fingerprint for all each thing recorded in mi_usages
Austin Seipp's avatar
Austin Seipp committed
58
-}
59 60 61

#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
62 63
import IfaceSyn
import LoadIface
64 65
import FlagChecker

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

Simon Marlow's avatar
Simon Marlow committed
116
import Control.Monad
Ian Lynagh's avatar
Ian Lynagh committed
117
import Data.Function
Simon Marlow's avatar
Simon Marlow committed
118
import Data.List
119 120
import Data.Map (Map)
import qualified Data.Map as Map
Ian Lynagh's avatar
Ian Lynagh committed
121
import Data.Ord
Simon Marlow's avatar
Simon Marlow committed
122
import Data.IORef
123
import System.Directory
Ian Lynagh's avatar
Ian Lynagh committed
124
import System.FilePath
125

Austin Seipp's avatar
Austin Seipp committed
126 127 128
{-
************************************************************************
*                                                                      *
129
\subsection{Completing an interface}
Austin Seipp's avatar
Austin Seipp committed
130 131 132
*                                                                      *
************************************************************************
-}
133 134

mkIface :: HscEnv
135 136 137 138
        -> 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
139
               Maybe (ModIface, -- The new one
140
                      Bool))    -- True <=> there was an old Iface, and the
141 142
                                --          new one is identical, so no need
                                --          to write it
143

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

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

Simon Marlow's avatar
Simon Marlow committed
196

197 198
mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
199

200 201
-- | 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
202 203 204 205 206 207
mkDependencies :: TcGblEnv -> IO Dependencies
mkDependencies
          TcGblEnv{ tcg_mod = mod,
                    tcg_imports = imports,
                    tcg_th_used = th_var
                  }
208
 = do
dterei's avatar
dterei committed
209 210 211
      -- 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
212 213
                -- M.hi-boot can be in the imp_dep_mods, but we must remove
                -- it before recording the modules on which this one depends!
214 215 216
                -- (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
Simon Marlow's avatar
Simon Marlow committed
217 218
                --  check.)

219
          pkgs | th_used   = insertList thPackageKey (imp_dep_pkgs imports)
220
               | otherwise = imp_dep_pkgs imports
Simon Marlow's avatar
Simon Marlow committed
221

222 223
          -- Set the packages required to be Safe according to Safe Haskell.
          -- See Note [RnNames . Tracking Trust Transitively]
224
          sorted_pkgs = sortBy stablePackageKeyCmp pkgs
225 226
          trust_pkgs  = imp_trust_pkgs imports
          dep_pkgs'   = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
227

228
      return Deps { dep_mods   = sortBy (stableModuleNameCmp `on` fst) dep_mods,
229
                    dep_pkgs   = dep_pkgs',
230 231
                    dep_orphs  = sortBy stableModuleCmp (imp_orphs  imports),
                    dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
232 233
                    -- sort to get into canonical order
                    -- NB. remember to use lexicographic ordering
Simon Marlow's avatar
Simon Marlow committed
234

235
mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
236
         -> NameSet -> Bool -> Dependencies -> GlobalRdrEnv
Ian Lynagh's avatar
Ian Lynagh committed
237
         -> NameEnv FixItem -> Warnings -> HpcInfo
238
         -> ImportedMods -> Bool
GregWeber's avatar
GregWeber committed
239
         -> [FilePath]
240
         -> SafeHaskellMode
Ian Lynagh's avatar
Ian Lynagh committed
241
         -> ModDetails
242
         -> IO (Messages, Maybe (ModIface, Bool))
243
mkIface_ hsc_env maybe_old_fingerprint
244
         this_mod is_boot used_names used_th deps rdr_env fix_env src_warns
245
         hpc_info dir_imp_mods pkg_trust_req dependent_files safe_mode
246
         ModDetails{  md_insts     = insts,
dterei's avatar
dterei committed
247 248 249
                      md_fam_insts = fam_insts,
                      md_rules     = rules,
                      md_anns      = anns,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
250
                      md_vect_info = vect_info,
dterei's avatar
dterei committed
251 252 253 254 255 256 257
                      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

258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278
  = do
    usages  <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files

    let entities = typeEnvElts type_env
        decls  = [ tyThingToIfaceDecl entity
                 | entity <- entities,
                   let name = getName entity,
                   not (isImplicitTyThing entity),
                      -- 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
        iface_vect_info = flattenVectInfo vect_info
        trust_info  = setSafeMode safe_mode
279
        annotations = map mkIfaceAnnotation anns
280
        sig_of = getSigOf dflags (moduleName this_mod)
281 282 283

        intermediate_iface = ModIface {
              mi_module      = this_mod,
284
              mi_sig_of      = sig_of,
285 286 287 288 289 290 291 292 293 294 295 296 297 298 299
              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       = sortBy cmp_inst     iface_insts,
              mi_fam_insts   = sortBy cmp_fam_inst iface_fam_insts,
              mi_rules       = sortBy cmp_rule     iface_rules,

              mi_vect_info   = iface_vect_info,

              mi_fixities    = fixities,
              mi_warns       = warns,
300
              mi_anns        = annotations,
301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320
              mi_globals     = maybeGlobalRdrEnv rdr_env,

              -- Left out deliberately: filled in by addFingerprints
              mi_iface_hash  = fingerprint0,
              mi_mod_hash    = fingerprint0,
              mi_flag_hash   = fingerprint0,
              mi_exp_hash    = fingerprint0,
              mi_used_th     = used_th,
              mi_orphan_hash = fingerprint0,
              mi_orphan      = False, -- Always set by addFingerprints, but
                                      -- it's a strict field, so we can't omit it.
              mi_finsts      = False, -- Ditto
              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,

              -- And build the cached values
              mi_warn_fn     = mkIfaceWarnCache warns,
321
              mi_fix_fn      = mkIfaceFixCache fixities }
322 323 324 325 326 327 328

    (new_iface, no_change_at_all)
          <- {-# SCC "versioninfo" #-}
                   addFingerprints hsc_env maybe_old_fingerprint
                                   intermediate_iface decls

    -- Warn about orphans
329
    -- See Note [Orphans and auto-generated rules]
330 331 332 333 334 335 336 337 338
    let warn_orphs      = wopt Opt_WarnOrphans dflags
        warn_auto_orphs = wopt Opt_WarnAutoOrphans dflags
        orph_warnings   --- Laziness means no work done unless -fwarn-orphans
          | 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 dflags unqual d
                               | (d,i) <- insts `zip` iface_insts
339
                               , isOrphan (ifInstOrph i) ]
340 341
        rule_warns = listToBag [ ruleOrphWarn dflags unqual this_mod r
                               | r <- iface_rules
342
                               , isOrphan (ifRuleOrph r)
343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359
                               , if ifRuleAuto r then warn_auto_orphs
                                                 else warn_orphs ]

    if errorsFound dflags errs_and_warns
      then return ( errs_and_warns, Nothing )
      else do
        -- Debug printing
        dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
                      (pprModIface new_iface)

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

        return (errs_and_warns, Just (final_iface, no_change_at_all))
360
  where
Ian Lynagh's avatar
Ian Lynagh committed
361 362 363 364 365
     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)
366

367
     dflags = hsc_dflags hsc_env
368

369 370 371 372 373
     -- 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
374
     -- scope available. (#5534)
375 376 377 378 379
     maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
     maybeGlobalRdrEnv rdr_env
         | targetRetainsAllBindings (hscTarget dflags) = Just rdr_env
         | otherwise                                   = Nothing

380
     deliberatelyOmitted :: String -> a
381
     deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
382

383
     ifFamInstTcName = ifFamInstFam
384

385 386 387 388
     flattenVectInfo (VectInfo { vectInfoVar            = vVar
                               , vectInfoTyCon          = vTyCon
                               , vectInfoParallelVars     = vParallelVars
                               , vectInfoParallelTyCons = vParallelTyCons
389
                               }) =
390
       IfaceVectInfo
391 392 393 394
       { 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]
       , ifaceVectInfoParallelVars   = [Var.varName v | v <- varSetElems vParallelVars]
395
       , ifaceVectInfoParallelTyCons = nameSetElems vParallelTyCons
396
       }
397

398
-----------------------------
399 400
writeIfaceFile :: DynFlags -> FilePath -> ModIface -> IO ()
writeIfaceFile dflags hi_file_path new_iface
401
    = do createDirectoryIfMissing True (takeDirectory hi_file_path)
402
         writeBinIface dflags hi_file_path new_iface
403 404


405 406
-- -----------------------------------------------------------------------------
-- Look up parents and versions of Names
407

408 409
-- 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
410
-- the parent and version info.
411

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

430 431 432 433 434 435
-- ---------------------------------------------------------------------------
-- Compute fingerprints for the interface

addFingerprints
        :: HscEnv
        -> Maybe Fingerprint -- the old fingerprint, if any
dterei's avatar
dterei committed
436
        -> ModIface          -- The new interface (lacking decls)
437 438
        -> [IfaceDecl]       -- The new decls
        -> IO (ModIface,     -- Updated interface
439
               Bool)         -- True <=> no changes at all;
440 441 442 443 444 445
                             -- no need to write Iface

addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
 = do
   eps <- hscEPS hsc_env
   let
446
        -- The ABI of a declaration represents everything that is made
447 448
        -- visible about the declaration that a client can depend on.
        -- see IfaceDeclABI below.
449
       declABI :: IfaceDecl -> IfaceDeclABI
450
       declABI decl = (this_mod, decl, extras)
451
        where extras = declExtras fix_fn ann_fn non_orph_rules non_orph_insts
452
                                  non_orph_fis decl
453 454 455

       edges :: [(IfaceDeclABI, Unique, [Unique])]
       edges = [ (abi, getUnique (ifName decl), out)
dterei's avatar
dterei committed
456
               | decl <- new_decls
457
               , let abi = declABI decl
dterei's avatar
dterei committed
458
               , let out = localOccs $ freeNamesDeclABI abi
459 460
               ]

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
461
       name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
462
       localOccs = map (getUnique . getParent . getOccName)
463
                        . filter ((== this_mod) . name_module)
464
                        . nameSetElems
465 466 467 468 469 470 471
          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
472
          where extend d env =
473
                  extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ]
474 475 476
                  where n = ifName d

        -- strongly-connected groups of declarations, in dependency order
477
       groups = stronglyConnCompFromEdgedVertices edges
478 479 480 481 482 483 484 485 486 487 488 489

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

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

510
       fingerprint_group :: (OccEnv (OccName,Fingerprint),
511 512
                             [(Fingerprint,IfaceDecl)])
                         -> SCC IfaceDeclABI
513
                         -> IO (OccEnv (OccName,Fingerprint),
514 515 516 517 518 519
                                [(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
520
               hash <- computeFingerprint hash_fn abi
521 522
               env' <- extend_hash_env local_env (hash,decl)
               return (env', (hash,decl) : decls_w_hashes)
523 524 525

       fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
          = do let decls = map abiDecl abis
526
               local_env1 <- foldM extend_hash_env local_env
527
                                   (zip (repeat fingerprint0) decls)
528
               let hash_fn = mk_put_name local_env1
529 530 531
               -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
               let stable_abis = sortBy cmp_abiNames abis
                -- put the cycle in a canonical order
532
               hash <- computeFingerprint hash_fn stable_abis
533
               let pairs = zip (repeat hash) decls
534 535 536 537 538 539 540 541 542 543 544
               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.
       --
       extend_hash_env :: OccEnv (OccName,Fingerprint)
                       -> (Fingerprint,IfaceDecl)
                       -> IO (OccEnv (OccName,Fingerprint))
       extend_hash_env env0 (hash,d) = do
545 546
          return (foldr (\(b,fp) env -> extendOccEnv env b (b,fp)) env0
                 (ifaceDeclFingerprints hash d))
547

548
   --
549
   (local_env, decls_w_hashes) <-
550 551
       foldM fingerprint_group (emptyOccEnv, []) groups

552 553 554 555 556
   -- 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)

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

567
   orphan_hash <- computeFingerprint (mk_put_name local_env)
568
                      (map ifDFun orph_insts, orph_rules, orph_fis)
569 570 571

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

   -- put the declarations in a canonical order, sorted by OccName
583
   let sorted_decls = Map.elems $ Map.fromList $
584
                          [(ifName d, e) | e@(_, d) <- decls_w_hashes]
585

586 587 588 589
   -- the flag hash depends on:
   --   - (some of) dflags
   -- it returns two hashes, one that shouldn't change
   -- the abi hash and one that should
590
   flag_hash <- fingerprintDynFlags dflags this_mod putNameLiterally
591 592 593 594 595 596

   -- the ABI hash depends on:
   --   - decls
   --   - export list
   --   - orphans
   --   - deprecations
597
   --   - vect info
598
   --   - flag abi hash
599
   mod_hash <- computeFingerprint putNameLiterally
600
                      (map fst sorted_decls,
601
                       export_hash,  -- includes orphan_hash
602 603
                       mi_warns iface0,
                       mi_vect_info iface0)
604 605

   -- The interface hash depends on:
606
   --   - the ABI hash, plus
607
   --   - the module level annotations,
608
   --   - usages
609
   --   - deps (home and external packages, dependent files)
610
   --   - hpc
611
   iface_hash <- computeFingerprint putNameLiterally
612
                      (mod_hash,
613
                       ann_fn (mkVarOcc "module"),  -- See mkIfaceAnnCache
614
                       mi_usages iface0,
615
                       sorted_deps,
616 617 618 619 620 621 622 623 624 625
                       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,
626
                mi_flag_hash   = flag_hash,
627 628
                mi_orphan      = not (   all ifRuleAuto orph_rules
                                           -- See Note [Orphans and auto-generated rules]
629 630
                                      && null orph_insts
                                      && null orph_fis
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
631
                                      && isNoIfaceVectInfo (mi_vect_info iface0)),
632 633 634 635
                mi_finsts      = not . null $ mi_fam_insts iface0,
                mi_decls       = sorted_decls,
                mi_hash_fn     = lookupOccEnv local_env }
   --
636
   return (final_iface, no_change_at_all)
637

638 639 640 641
  where
    this_mod = mi_module iface0
    dflags = hsc_dflags hsc_env
    this_pkg = thisPackage dflags
642 643 644
    (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)
645
    fix_fn = mi_fix_fn iface0
646
    ann_fn = mkIfaceAnnCache (mi_anns iface0)
647 648 649 650

getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
getOrphanHashes hsc_env mods = do
  eps <- hscEPS hsc_env
651
  let
652 653 654
    hpt        = hsc_HPT hsc_env
    pit        = eps_PIT eps
    dflags     = hsc_dflags hsc_env
655
    get_orph_hash mod =
656 657 658 659 660 661 662
          case lookupIfaceByModule dflags hpt pit mod of
            Nothing    -> pprPanic "moduleOrphanHash" (ppr mod)
            Just iface -> mi_orphan_hash iface
  --
  return (map get_orph_hash mods)


663 664 665
sortDependencies :: Dependencies -> Dependencies
sortDependencies d
 = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
666
          dep_pkgs   = sortBy (stablePackageKeyCmp `on` fst) (dep_pkgs d),
667 668
          dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
          dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
669

670 671 672 673 674 675 676 677 678 679 680 681 682 683
-- | Creates cached lookup for the 'mi_anns' field of ModIface
-- Hackily, we use "module" as the OccName for any module-level annotations
mkIfaceAnnCache :: [IfaceAnnotation] -> OccName -> [AnnPayload]
mkIfaceAnnCache anns
  = \n -> lookupOccEnv env n `orElse` []
  where
    pair (IfaceAnnotation target value) =
      (case target of
          NamedTarget occn -> occn
          ModuleTarget _   -> mkVarOcc "module"
      , [value])
    -- flipping (++), so the first argument is always short
    env = mkOccEnv_C (flip (++)) (map pair anns)

Austin Seipp's avatar
Austin Seipp committed
684
{-
685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703
Note [Orphans and auto-generated rules]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When we specialise an INLINEABLE function, or when we have
-fspecialise-aggressively, we auto-generate RULES that are orphans.
We don't want to warn about these, at least not by default, or we'd
generate a lot of warnings.  Hence -fwarn-auto-orphans.

Indeed, we don't even treat the module as an oprhan module if it has
auto-generated *rule* orphans.  Orphan modules are read every time we
compile, so they are pretty obtrusive and slow down every compilation,
even non-optimised ones.  (Reason: for type class instances it's a
type correctness issue.)  But specialisation rules are strictly for
*optimisation* only so it's fine not to read the interface.

What this means is that a SPEC rules from auto-specialisation in
module M will be used in other modules only if M.hi has been read for
some other reason, which is actually pretty likely.


Austin Seipp's avatar
Austin Seipp committed
704 705
************************************************************************
*                                                                      *
706
          The ABI of an IfaceDecl
Austin Seipp's avatar
Austin Seipp committed
707 708
*                                                                      *
************************************************************************
709 710 711 712 713 714 715 716

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

718 719
   (b) the declaration itself, as exposed to clients.  That is, the
       definition of an Id is included in the fingerprint only if
720
       it is made available as an unfolding in the interface.
721 722 723 724 725 726 727 728

   (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
729 730
the declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
and fingerprinting that as part of the declaration.
Austin Seipp's avatar
Austin Seipp committed
731
-}
732

733 734
type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)

735
data IfaceDeclExtras
736
  = IfaceIdExtras IfaceIdExtras
737

738
  | IfaceDataExtras
dterei's avatar
dterei committed
739
       Fixity                   -- Fixity of the tycon itself
740
       [IfaceInstABI]           -- Local class and family instances of this tycon
741
                                -- See Note [Orphans] in InstEnv
742 743
       [AnnPayload]             -- Annotations of the type itself
       [IfaceIdExtras]          -- For each constructor: fixity, RULES and annotations
744

745
  | IfaceClassExtras
dterei's avatar
dterei committed
746 747 748
       Fixity                   -- Fixity of the class itself
       [IfaceInstABI]           -- Local instances of this class *or*
                                --   of its associated data types
749
                                -- See Note [Orphans] in InstEnv
750 751
       [AnnPayload]             -- Annotations of the type itself
       [IfaceIdExtras]          -- For each class method: fixity, RULES and annotations
752

753 754 755
  | IfaceSynonymExtras Fixity [AnnPayload]

  | IfaceFamilyExtras   Fixity [IfaceInstABI] [AnnPayload]
756

757 758
  | IfaceOtherDeclExtras

759 760 761 762 763 764
data IfaceIdExtras
  = IdExtras
       Fixity                   -- Fixity of the Id
       [IfaceRule]              -- Rules for the Id
       [AnnPayload]             -- Annotations for the Id

765 766
-- When hashing a class or family instance, we hash only the
-- DFunId or CoAxiom, because that depends on all the
767 768 769 770
-- information about the instance.
--
type IfaceInstABI = IfExtName   -- Name of DFunId or CoAxiom that is evidence for the instance

771 772 773 774
abiDecl :: IfaceDeclABI -> IfaceDecl
abiDecl (_, decl, _) = decl

cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
775
cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
776 777 778 779
                         ifName (abiDecl abi2)

freeNamesDeclABI :: IfaceDeclABI -> NameSet
freeNamesDeclABI (_mod, decl, extras) =
780
  freeNamesIfDecl decl `unionNameSet` freeNamesDeclExtras extras
781 782

freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
783 784
freeNamesDeclExtras (IfaceIdExtras id_extras)
  = freeNamesIdExtras id_extras
785
freeNamesDeclExtras (IfaceDataExtras  _ insts _ subs)
786
  = unionNameSets (mkNameSet insts : map freeNamesIdExtras subs)
787
freeNamesDeclExtras (IfaceClassExtras _ insts _ subs)
788
  = unionNameSets (mkNameSet insts : map freeNamesIdExtras subs)
789 790 791
freeNamesDeclExtras (IfaceSynonymExtras _ _)
  = emptyNameSet
freeNamesDeclExtras (IfaceFamilyExtras _ insts _)
792
  = mkNameSet insts
793 794 795
freeNamesDeclExtras IfaceOtherDeclExtras
  = emptyNameSet

796
freeNamesIdExtras :: IfaceIdExtras -> NameSet
797
freeNamesIdExtras (IdExtras _ rules _) = unionNameSets (map freeNamesIfRule rules)
798

799
instance Outputable IfaceDeclExtras where
800
  ppr IfaceOtherDeclExtras       = Outputable.empty
801
  ppr (IfaceIdExtras  extras)    = ppr_id_extras extras
802 803
  ppr (IfaceSynonymExtras fix anns) = vcat [ppr fix, ppr anns]
  ppr (IfaceFamilyExtras fix finsts anns) = vcat [ppr fix, ppr finsts, ppr anns]
804
  ppr (IfaceDataExtras fix insts anns stuff) = vcat [ppr fix, ppr_insts insts, ppr anns,
805
                                                ppr_id_extras_s stuff]
806
  ppr (IfaceClassExtras fix insts anns stuff) = vcat [ppr fix, ppr_insts insts, ppr anns,
807 808 809 810 811
                                                 ppr_id_extras_s stuff]

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

812 813
ppr_id_extras_s :: [IfaceIdExtras] -> SDoc
ppr_id_extras_s stuff = vcat (map ppr_id_extras stuff)
814

815 816
ppr_id_extras :: IfaceIdExtras -> SDoc
ppr_id_extras (IdExtras fix rules anns) = ppr fix $$ vcat (map ppr rules) $$ vcat (map ppr anns)
817

818
-- This instance is used only to compute fingerprints
819 820
instance Binary IfaceDeclExtras where
  get _bh = panic "no get for IfaceDeclExtras"
821 822
  put_ bh (IfaceIdExtras extras) = do
   putByte bh 1; put_ bh extras
823 824 825 826
  put_ bh (IfaceDataExtras fix insts anns cons) = do
   putByte bh 2; put_ bh fix; put_ bh insts; put_ bh anns; put_ bh cons
  put_ bh (IfaceClassExtras fix insts anns methods) = do
   putByte bh 3; put_ bh fix; put_ bh insts; put_ bh anns; put_ bh methods
827 828 829 830 831
  put_ bh (IfaceSynonymExtras fix anns) = do
   putByte bh 4; put_ bh fix; put_ bh anns
  put_ bh (IfaceFamilyExtras fix finsts anns) = do
   putByte bh 5; put_ bh fix; put_ bh finsts; put_ bh anns
  put_ bh IfaceOtherDeclExtras = putByte bh 6
832 833 834 835

instance Binary IfaceIdExtras where
  get _bh = panic "no get for IfaceIdExtras"
  put_ bh (IdExtras fix rules anns)= do { put_ bh fix; put_ bh rules; put_ bh anns }
836 837

declExtras :: (OccName -> Fixity)
838
           -> (OccName -> [AnnPayload])
839
           -> OccEnv [IfaceRule]
840 841
           -> OccEnv [IfaceClsInst]
           -> OccEnv [IfaceFamInst]
842 843 844
           -> IfaceDecl
           -> IfaceDeclExtras

845
declExtras fix_fn ann_fn rule_env inst_env fi_env decl
846
  = case decl of
847
      IfaceId{} -> IfaceIdExtras (id_extras n)
848
      IfaceData{ifCons=cons} ->
849
                     IfaceDataExtras (fix_fn n)
850 851
                        (map ifFamInstAxiom (lookupOccEnvL fi_env n) ++
                         map ifDFun         (lookupOccEnvL inst_env n))