MkIface.hs 76.6 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 12
module MkIface (
        mkIface,        -- Build a ModIface from a ModGuts,
13
                        -- including computing version information
14

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

17
        writeIfaceFile, -- Write the interface file
18

19 20
        checkOldIface,  -- See if recompilation is required, by
                        -- comparing version information
21
        RecompileRequired(..), recompileRequired,
Edward Z. Yang's avatar
Edward Z. Yang committed
22
        mkIfaceExports,
23 24

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

Austin Seipp's avatar
Austin Seipp committed
27
{-
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://ghc.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.
50 51 52 53
    Also record any dependent files added with
      * addDependentFile
      * #include
      * -optP-include
54 55

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

#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
61
import IfaceSyn
62
import BinFingerprint
Simon Marlow's avatar
Simon Marlow committed
63
import LoadIface
Ben Gamari's avatar
Ben Gamari committed
64
import ToIface
65 66
import FlagChecker

67
import DsUsage ( mkUsageInfo, mkUsedNames, mkDependencies )
Simon Marlow's avatar
Simon Marlow committed
68
import Id
69
import Annotations
70
import CoreSyn
Simon Marlow's avatar
Simon Marlow committed
71 72
import Class
import TyCon
73
import CoAxiom
cactus's avatar
cactus committed
74
import ConLike
Simon Marlow's avatar
Simon Marlow committed
75 76 77 78 79
import DataCon
import Type
import TcType
import InstEnv
import FamInstEnv
80
import TcRnMonad
81
import HsSyn
Simon Marlow's avatar
Simon Marlow committed
82
import HscTypes
83
import Finder
Simon Marlow's avatar
Simon Marlow committed
84
import DynFlags
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
85
import VarEnv
86
import VarSet
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
87
import Var
Simon Marlow's avatar
Simon Marlow committed
88
import Name
89
import Avail
Ian Lynagh's avatar
Ian Lynagh committed
90
import RdrName
91 92
import NameEnv
import NameSet
Simon Marlow's avatar
Simon Marlow committed
93
import Module
Simon Marlow's avatar
Simon Marlow committed
94 95 96 97
import BinIface
import ErrUtils
import Digraph
import SrcLoc
98 99
import Outputable
import BasicTypes       hiding ( SuccessFlag(..) )
100
import Unique
101
import Util             hiding ( eqListBy )
102
import FastString
Simon Marlow's avatar
Simon Marlow committed
103
import Maybes
104 105
import Binary
import Fingerprint
106
import Exception
David Feuer's avatar
David Feuer committed
107
import UniqSet
108
import UniqDFM
109
import Packages
110

Simon Marlow's avatar
Simon Marlow committed
111
import Control.Monad
Ian Lynagh's avatar
Ian Lynagh committed
112
import Data.Function
Simon Marlow's avatar
Simon Marlow committed
113
import Data.List
114
import qualified Data.Map as Map
Ian Lynagh's avatar
Ian Lynagh committed
115
import Data.Ord
Simon Marlow's avatar
Simon Marlow committed
116
import Data.IORef
117
import System.Directory
Ian Lynagh's avatar
Ian Lynagh committed
118
import System.FilePath
119

Austin Seipp's avatar
Austin Seipp committed
120 121 122
{-
************************************************************************
*                                                                      *
123
\subsection{Completing an interface}
Austin Seipp's avatar
Austin Seipp committed
124 125 126
*                                                                      *
************************************************************************
-}
127 128

mkIface :: HscEnv
129 130 131
        -> Maybe Fingerprint    -- The old fingerprint, if we have it
        -> ModDetails           -- The trimmed, tidied interface
        -> ModGuts              -- Usages, deprecations, etc
132 133 134 135
        -> IO (ModIface, -- The new one
               Bool)     -- True <=> there was an old Iface, and the
                         --          new one is identical, so no need
                         --          to write it
136

137
mkIface hsc_env maybe_old_fingerprint mod_details
138
         ModGuts{     mg_module       = this_mod,
139
                      mg_hsc_src      = hsc_src,
140
                      mg_usages       = usages,
141 142 143 144 145 146 147
                      mg_used_th      = used_th,
                      mg_deps         = deps,
                      mg_rdr_env      = rdr_env,
                      mg_fix_env      = fix_env,
                      mg_warns        = warns,
                      mg_hpc_info     = hpc_info,
                      mg_safe_haskell = safe_mode,
148
                      mg_trust_pkg    = self_trust
GregWeber's avatar
GregWeber committed
149
                    }
150
        = mkIface_ hsc_env maybe_old_fingerprint
151 152 153
                   this_mod hsc_src used_th deps rdr_env fix_env
                   warns hpc_info self_trust
                   safe_mode usages mod_details
Thomas Schilling's avatar
Thomas Schilling committed
154

Simon Marlow's avatar
Simon Marlow committed
155 156 157 158
-- | 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
159
          -> Maybe Fingerprint  -- The old fingerprint, if we have it
160
          -> SafeHaskellMode    -- The safe haskell mode
dterei's avatar
dterei committed
161 162
          -> ModDetails         -- gotten from mkBootModDetails, probably
          -> TcGblEnv           -- Usages, deprecations, etc
163
          -> IO (ModIface, Bool)
164
mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
Simon Marlow's avatar
Simon Marlow committed
165 166 167 168 169
  tc_result@TcGblEnv{ tcg_mod = this_mod,
                      tcg_src = hsc_src,
                      tcg_imports = imports,
                      tcg_rdr_env = rdr_env,
                      tcg_fix_env = fix_env,
Edward Z. Yang's avatar
Edward Z. Yang committed
170
                      tcg_merged = merged,
Ian Lynagh's avatar
Ian Lynagh committed
171
                      tcg_warns = warns,
172
                      tcg_hpc = other_hpc_info,
GregWeber's avatar
GregWeber committed
173 174
                      tcg_th_splice_used = tc_splice_used,
                      tcg_dependent_files = dependent_files
Simon Marlow's avatar
Simon Marlow committed
175 176
                    }
  = do
177
          let used_names = mkUsedNames tc_result
Simon Marlow's avatar
Simon Marlow committed
178 179
          deps <- mkDependencies tc_result
          let hpc_info = emptyHpcInfo other_hpc_info
180
          used_th <- readIORef tc_splice_used
GregWeber's avatar
GregWeber committed
181
          dep_files <- (readIORef dependent_files)
182 183 184 185 186 187 188 189
          -- Do NOT use semantic module here; this_mod in mkUsageInfo
          -- is used solely to decide if we should record a dependency
          -- or not.  When we instantiate a signature, the semantic
          -- module is something we want to record dependencies for,
          -- but if you pass that in here, we'll decide it's the local
          -- module and does not need to be recorded as a dependency.
          -- See Note [Identity versus semantic module]
          usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names dep_files merged
190
          mkIface_ hsc_env maybe_old_fingerprint
191
                   this_mod hsc_src
192
                   used_th deps rdr_env
193 194
                   fix_env warns hpc_info
                   (imp_trust_own_pkg imports) safe_mode usages mod_details
195

Simon Marlow's avatar
Simon Marlow committed
196

197
mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> HscSource
198
         -> Bool -> Dependencies -> GlobalRdrEnv
Ian Lynagh's avatar
Ian Lynagh committed
199
         -> NameEnv FixItem -> Warnings -> HpcInfo
200
         -> Bool
201
         -> SafeHaskellMode
202
         -> [Usage]
Ian Lynagh's avatar
Ian Lynagh committed
203
         -> ModDetails
204
         -> IO (ModIface, Bool)
205
mkIface_ hsc_env maybe_old_fingerprint
206 207
         this_mod hsc_src used_th deps rdr_env fix_env src_warns
         hpc_info pkg_trust_req safe_mode usages
208
         ModDetails{  md_insts     = insts,
dterei's avatar
dterei committed
209 210 211
                      md_fam_insts = fam_insts,
                      md_rules     = rules,
                      md_anns      = anns,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
212
                      md_vect_info = vect_info,
dterei's avatar
dterei committed
213
                      md_types     = type_env,
214 215
                      md_exports   = exports,
                      md_complete_sigs = complete_sigs }
dterei's avatar
dterei committed
216 217 218 219 220
-- 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

221
  = do
Edward Z. Yang's avatar
Edward Z. Yang committed
222 223
    let semantic_mod = canonicalizeHomeModule (hsc_dflags hsc_env) (moduleName this_mod)
        entities = typeEnvElts type_env
224 225 226 227 228 229 230
        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
Edward Z. Yang's avatar
Edward Z. Yang committed
231
                   nameIsLocalOrFrom semantic_mod name  ]
232
                      -- Sigh: see Note [Root-main Id] in TcRnDriver
Edward Z. Yang's avatar
Edward Z. Yang committed
233 234 235 236
                      -- NB: ABSOLUTELY need to check against semantic_mod,
                      -- because all of the names in an hsig p[H=<H>]:H
                      -- are going to be for <H>, not the former id!
                      -- See Note [Identity versus semantic module]
237

238 239 240 241 242
        fixities    = sortBy (comparing fst)
          [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
          -- The order of fixities returned from nameEnvElts is not
          -- deterministic, so we sort by OccName to canonicalize it.
          -- See Note [Deterministic UniqFM] in UniqDFM for more details.
243
        warns       = src_warns
244
        iface_rules = map coreRuleToIfaceRule rules
245
        iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode insts
246 247 248
        iface_fam_insts = map famInstToIfaceFamInst fam_insts
        iface_vect_info = flattenVectInfo vect_info
        trust_info  = setSafeMode safe_mode
249
        annotations = map mkIfaceAnnotation anns
250
        icomplete_sigs = map mkIfaceCompleteSig complete_sigs
251 252 253

        intermediate_iface = ModIface {
              mi_module      = this_mod,
Edward Z. Yang's avatar
Edward Z. Yang committed
254 255 256 257 258
              -- Need to record this because it depends on the -instantiated-with flag
              -- which could change
              mi_sig_of      = if semantic_mod == this_mod
                                then Nothing
                                else Just semantic_mod,
259
              mi_hsc_src     = hsc_src,
260 261 262 263 264 265 266 267 268 269 270 271 272 273
              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,
274
              mi_anns        = annotations,
275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294
              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,
295 296
              mi_fix_fn      = mkIfaceFixCache fixities,
              mi_complete_sigs = icomplete_sigs }
297 298 299 300 301 302

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

303 304 305 306 307 308 309 310 311 312 313
    -- 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 (final_iface, no_change_at_all)
314
  where
315 316 317 318 319
     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)
320

321
     dflags = hsc_dflags hsc_env
322

323 324 325 326 327
     -- 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
328
     -- scope available. (#5534)
329 330 331 332 333
     maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
     maybeGlobalRdrEnv rdr_env
         | targetRetainsAllBindings (hscTarget dflags) = Just rdr_env
         | otherwise                                   = Nothing

334
     deliberatelyOmitted :: String -> a
335
     deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
336

337 338
     ifFamInstTcName = ifFamInstFam

339 340 341 342
     flattenVectInfo (VectInfo { vectInfoVar            = vVar
                               , vectInfoTyCon          = vTyCon
                               , vectInfoParallelVars     = vParallelVars
                               , vectInfoParallelTyCons = vParallelTyCons
343
                               }) =
344
       IfaceVectInfo
niteria's avatar
niteria committed
345
       { ifaceVectInfoVar            = [Var.varName v | (v, _  ) <- dVarEnvElts vVar]
346 347
       , ifaceVectInfoTyCon          = [tyConName t   | (t, t_v) <- nameEnvElts vTyCon, t /= t_v]
       , ifaceVectInfoTyConReuse     = [tyConName t   | (t, t_v) <- nameEnvElts vTyCon, t == t_v]
niteria's avatar
niteria committed
348
       , ifaceVectInfoParallelVars   = [Var.varName v | v <- dVarSetElems vParallelVars]
349
       , ifaceVectInfoParallelTyCons = nameSetElemsStable vParallelTyCons
350
       }
351

352
-----------------------------
353 354
writeIfaceFile :: DynFlags -> FilePath -> ModIface -> IO ()
writeIfaceFile dflags hi_file_path new_iface
355
    = do createDirectoryIfMissing True (takeDirectory hi_file_path)
356
         writeBinIface dflags hi_file_path new_iface
357 358


359 360
-- -----------------------------------------------------------------------------
-- Look up parents and versions of Names
361

362 363
-- 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
364
-- the parent and version info.
365

366
mkHashFun
367 368
        :: HscEnv                       -- needed to look up versions
        -> ExternalPackageState         -- ditto
Edward Z. Yang's avatar
Edward Z. Yang committed
369 370 371 372 373 374
        -> (Name -> IO Fingerprint)
mkHashFun hsc_env eps name
  | isHoleModule orig_mod
  = lookup (mkModule (thisPackage dflags) (moduleName orig_mod))
  | otherwise
  = lookup orig_mod
375
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
376
      dflags = hsc_dflags hsc_env
Edward Z. Yang's avatar
Edward Z. Yang committed
377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394
      hpt = hsc_HPT hsc_env
      pit = eps_PIT eps
      occ = nameOccName name
      orig_mod = nameModule name
      lookup mod = do
        MASSERT2( isExternalName name, ppr name )
        iface <- case lookupIfaceByModule dflags hpt pit mod of
                  Just iface -> return iface
                  Nothing -> do
                      -- This can occur when we're writing out ifaces for
                      -- requirements; we didn't do any /real/ typechecking
                      -- so there's no guarantee everything is loaded.
                      -- Kind of a heinous hack.
                      iface <- initIfaceLoad hsc_env . withException
                            $ loadInterface (text "lookupVers2") mod ImportBySystem
                      return iface
        return $ snd (mi_hash_fn iface occ `orElse`
                  pprPanic "lookupVers1" (ppr mod <+> ppr occ))
395

396 397 398
-- ---------------------------------------------------------------------------
-- Compute fingerprints for the interface

399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424
{-
Note [Fingerprinting IfaceDecls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

The general idea here is that we first examine the 'IfaceDecl's and determine
the recursive groups of them. We then walk these groups in dependency order,
serializing each contained 'IfaceDecl' to a "Binary" buffer which we then
hash using MD5 to produce a fingerprint for the group.

However, the serialization that we use is a bit funny: we override the @putName@
operation with our own which serializes the hash of a 'Name' instead of the
'Name' itself. This ensures that the fingerprint of a decl changes if anything
in its transitive closure changes. This trick is why we must be careful about
traversing in dependency order: we need to ensure that we have hashes for
everything referenced by the decl which we are fingerprinting.

Moreover, we need to be careful to distinguish between serialization of binding
Names (e.g. the ifName field of a IfaceDecl) and non-binding (e.g. the ifInstCls
field of a IfaceClsInst): only in the non-binding case should we include the
fingerprint; in the binding case we shouldn't since it is merely the name of the
thing that we are currently fingerprinting.
-}

-- | Add fingerprints for top-level declarations to a 'ModIface'.
--
-- See Note [Fingerprinting IfaceDecls]
425 426 427
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
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
        -- visible about the declaration that a client can depend on.
        -- see IfaceDeclABI below.
441
       declABI :: IfaceDecl -> IfaceDeclABI
Edward Z. Yang's avatar
Edward Z. Yang committed
442 443
       -- TODO: I'm not sure if this should be semantic_mod or this_mod.
       -- See also Note [Identity versus semantic module]
444
       declABI decl = (this_mod, decl, extras)
445
        where extras = declExtras fix_fn ann_fn non_orph_rules non_orph_insts
446
                                  non_orph_fis decl
447

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

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
455
       name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
456 457
       localOccs =
         map (getUnique . getParent . getOccName)
Edward Z. Yang's avatar
Edward Z. Yang committed
458 459 460 461
                        -- NB: names always use semantic module, so
                        -- filtering must be on the semantic module!
                        -- See Note [Identity versus semantic module]
                        . filter ((== semantic_mod) . name_module)
David Feuer's avatar
David Feuer committed
462
                        . nonDetEltsUniqSet
niteria's avatar
niteria committed
463 464 465 466 467
                   -- It's OK to use nonDetEltsUFM as localOccs is only
                   -- used to construct the edges and
                   -- stronglyConnCompFromEdgedVertices is deterministic
                   -- even with non-deterministic order of edges as
                   -- explained in Note [Deterministic SCC] in Digraph.
468 469
          where getParent :: OccName -> OccName
                getParent occ = lookupOccEnv parent_map occ `orElse` occ
470 471 472 473 474

        -- 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
475 476
       parent_map = foldl' extend emptyOccEnv new_decls
          where extend env d =
477
                  extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ]
478
                  where n = getOccName d
479 480

        -- strongly-connected groups of declarations, in dependency order
481 482 483
       groups :: [SCC IfaceDeclABI]
       groups =
           stronglyConnCompFromEdgedVerticesUniq edges
484 485 486

       global_hash_fn = mkHashFun hsc_env eps

487
        -- How to output Names when generating the data to fingerprint.
488 489 490 491 492
        -- 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.
493
       mk_put_name :: OccEnv (OccName,Fingerprint)
494 495
                   -> BinHandle -> Name -> IO  ()
       mk_put_name local_env bh name
496
          | isWiredInName name  =  putNameLiterally bh name
497 498
           -- wired-in names don't have fingerprints
          | otherwise
499
          = ASSERT2( isExternalName name, ppr name )
Edward Z. Yang's avatar
Edward Z. Yang committed
500 501 502 503 504 505 506 507
            let hash | nameModule name /= semantic_mod =  global_hash_fn name
                     -- Get it from the REAL interface!!
                     -- This will trigger when we compile an hsig file
                     -- and we know a backing impl for it.
                     -- See Note [Identity versus semantic module]
                     | semantic_mod /= this_mod
                     , not (isHoleModule semantic_mod) = global_hash_fn name
                     | otherwise = return (snd (lookupOccEnv local_env (getOccName name)
508
                           `orElse` pprPanic "urk! lookup local fingerprint"
509
                                       (ppr name $$ ppr local_env)))
510 511 512 513 514 515 516
                -- 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.
Edward Z. Yang's avatar
Edward Z. Yang committed
517
            in hash >>= put_ bh
518 519 520 521

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

522
       fingerprint_group :: (OccEnv (OccName,Fingerprint),
523 524
                             [(Fingerprint,IfaceDecl)])
                         -> SCC IfaceDeclABI
525
                         -> IO (OccEnv (OccName,Fingerprint),
526 527 528 529 530
                                [(Fingerprint,IfaceDecl)])

       fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
          = do let hash_fn = mk_put_name local_env
                   decl = abiDecl abi
Matthew Pickering's avatar
Matthew Pickering committed
531
               --pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
532
               hash <- computeFingerprint hash_fn abi
533 534
               env' <- extend_hash_env local_env (hash,decl)
               return (env', (hash,decl) : decls_w_hashes)
535 536 537

       fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
          = do let decls = map abiDecl abis
538
               local_env1 <- foldM extend_hash_env local_env
539
                                   (zip (repeat fingerprint0) decls)
540
               let hash_fn = mk_put_name local_env1
541 542 543
               -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
               let stable_abis = sortBy cmp_abiNames abis
                -- put the cycle in a canonical order
544
               hash <- computeFingerprint hash_fn stable_abis
545
               let pairs = zip (repeat hash) decls
546 547 548 549 550 551 552 553 554 555 556
               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
557 558
          return (foldr (\(b,fp) env -> extendOccEnv env b (b,fp)) env0
                 (ifaceDeclFingerprints hash d))
559

560
   --
561
   (local_env, decls_w_hashes) <-
562 563
       foldM fingerprint_group (emptyOccEnv, []) groups

564 565 566 567 568
   -- 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)

569
   -- The export hash of a module depends on the orphan hashes of the
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
570
   -- orphan modules below us in the dependency tree.  This is the way
571
   -- that changes in orphans get propagated all the way up the
572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593
   -- dependency tree.
   --
   -- Note [A bad dep_orphs optimization]
   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   -- In a previous version of this code, we filtered out orphan modules which
   -- were not from the home package, justifying it by saying that "we'd
   -- pick up the ABI hashes of the external module instead".  This is wrong.
   -- Suppose that we have:
   --
   --       module External where
   --           instance Show (a -> b)
   --
   --       module Home1 where
   --           import External
   --
   --       module Home2 where
   --           import Home1
   --
   -- The export hash of Home1 needs to reflect the orphan instances of
   -- External. It's true that Home1 will get rebuilt if the orphans
   -- of External, but we also need to make sure Home2 gets rebuilt
   -- as well.  See #12733 for more details.
594 595 596
   let orph_mods
        = filter (/= this_mod) -- Note [Do not update EPS with your own hi-boot]
        $ dep_orphs sorted_deps
597 598
   dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods

599 600 601 602 603 604 605 606 607
   -- Note [Do not update EPS with your own hi-boot]
   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   -- (See also Trac #10182).  When your hs-boot file includes an orphan
   -- instance declaration, you may find that the dep_orphs of a module you
   -- import contains reference to yourself.  DO NOT actually load this module
   -- or add it to the orphan hashes: you're going to provide the orphan
   -- instances yourself, no need to consult hs-boot; if you do load the
   -- interface into EPS, you will see a duplicate orphan instance.

608
   orphan_hash <- computeFingerprint (mk_put_name local_env)
609
                                     (map ifDFun orph_insts, orph_rules, orph_fis)
610 611 612

   -- the export list hash doesn't depend on the fingerprints of
   -- the Names it mentions, only the Names themselves, hence putNameLiterally.
613
   export_hash <- computeFingerprint putNameLiterally
614 615 616
                      (mi_exports iface0,
                       orphan_hash,
                       dep_orphan_hashes,
617
                       dep_pkgs (mi_deps iface0),
618 619
                       -- See Note [Export hash depends on non-orphan family instances]
                       dep_finsts (mi_deps iface0),
620 621
                        -- dep_pkgs: see "Package Version Changes" on
                        -- wiki/Commentary/Compiler/RecompilationAvoidance
622
                       mi_trust iface0)
623
                        -- Make sure change of Safe Haskell mode causes recomp.
624

625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652
   -- Note [Export hash depends on non-orphan family instances]
   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   --
   -- Suppose we have:
   --
   --   module A where
   --       type instance F Int = Bool
   --
   --   module B where
   --       import A
   --
   --   module C where
   --       import B
   --
   -- The family instance consistency check for C depends on the dep_finsts of
   -- B.  If we rename module A to A2, when the dep_finsts of B changes, we need
   -- to make sure that C gets rebuilt. Effectively, the dep_finsts are part of
   -- the exports of B, because C always considers them when checking
   -- consistency.
   --
   -- A full discussion is in #12723.
   --
   -- We do NOT need to hash dep_orphs, because this is implied by
   -- dep_orphan_hashes, and we do not need to hash ordinary class instances,
   -- because there is no eager consistency check as there is with type families
   -- (also we didn't store it anywhere!)
   --

653
   -- put the declarations in a canonical order, sorted by OccName
654
   let sorted_decls = Map.elems $ Map.fromList $
655
                          [(getOccName d, e) | e@(_, d) <- decls_w_hashes]
656

657 658 659 660
   -- the flag hash depends on:
   --   - (some of) dflags
   -- it returns two hashes, one that shouldn't change
   -- the abi hash and one that should
661
   flag_hash <- fingerprintDynFlags dflags this_mod putNameLiterally
662 663 664 665 666 667

   -- the ABI hash depends on:
   --   - decls
   --   - export list
   --   - orphans
   --   - deprecations
668
   --   - vect info
669
   --   - flag abi hash
670
   mod_hash <- computeFingerprint putNameLiterally
671
                      (map fst sorted_decls,
672
                       export_hash,  -- includes orphan_hash
673 674
                       mi_warns iface0,
                       mi_vect_info iface0)
675 676

   -- The interface hash depends on:
677
   --   - the ABI hash, plus
678
   --   - the module level annotations,
679
   --   - usages
680
   --   - deps (home and external packages, dependent files)
681
   --   - hpc
682
   iface_hash <- computeFingerprint putNameLiterally
683
                      (mod_hash,
684
                       ann_fn (mkVarOcc "module"),  -- See mkIfaceAnnCache
685
                       mi_usages iface0,
686
                       sorted_deps,
687 688 689 690 691 692 693 694 695 696
                       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,
697
                mi_flag_hash   = flag_hash,
698 699
                mi_orphan      = not (   all ifRuleAuto orph_rules
                                           -- See Note [Orphans and auto-generated rules]
700 701
                                      && null orph_insts
                                      && null orph_fis
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
702
                                      && isNoIfaceVectInfo (mi_vect_info iface0)),
703 704 705 706
                mi_finsts      = not . null $ mi_fam_insts iface0,
                mi_decls       = sorted_decls,
                mi_hash_fn     = lookupOccEnv local_env }
   --
707
   return (final_iface, no_change_at_all)
708

709 710
  where
    this_mod = mi_module iface0
Edward Z. Yang's avatar
Edward Z. Yang committed
711
    semantic_mod = mi_semantic_module iface0
712
    dflags = hsc_dflags hsc_env
713 714 715
    (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)
716
    fix_fn = mi_fix_fn iface0
717
    ann_fn = mkIfaceAnnCache (mi_anns iface0)
718

719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748
-- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules
-- (in particular, the orphan modules which are transitively imported by the
-- current module).
--
-- Q: Why do we need the hash at all, doesn't the list of transitively
-- imported orphan modules suffice?
--
-- A: If one of our transitive imports adds a new orphan instance, our
-- export hash must change so that modules which import us rebuild.  If we just
-- hashed the [Module], the hash would not change even when a new instance was
-- added to a module that already had an orphan instance.
--
-- Q: Why don't we just hash the orphan hashes of our direct dependencies?
-- Why the full transitive closure?
--
-- A: Suppose we have these modules:
--
--      module A where
--          instance Show (a -> b) where
--      module B where
--          import A -- **
--      module C where
--          import A
--          import B
--
-- Whether or not we add or remove the import to A in B affects the
-- orphan hash of B.  But it shouldn't really affect the orphan hash
-- of C.  If we hashed only direct dependencies, there would be no
-- way to tell that the net effect was a wash, and we'd be forced
-- to recompile C and everything else.
749 750 751
getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
getOrphanHashes hsc_env mods = do
  eps <- hscEPS hsc_env
752
  let
753 754 755
    hpt        = hsc_HPT hsc_env
    pit        = eps_PIT eps
    dflags     = hsc_dflags hsc_env
756
    get_orph_hash mod =
757
          case lookupIfaceByModule dflags hpt pit mod of
758 759 760 761 762 763
            Just iface -> return (mi_orphan_hash iface)
            Nothing    -> do -- similar to 'mkHashFun'
                iface <- initIfaceLoad hsc_env . withException
                            $ loadInterface (text "getOrphanHashes") mod ImportBySystem
                return (mi_orphan_hash iface)

764
  --
765
  mapM get_orph_hash mods
766 767


768 769 770
sortDependencies :: Dependencies -> Dependencies
sortDependencies d
 = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
771
          dep_pkgs   = sortBy (compare `on` fst) (dep_pkgs d),
772 773
          dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
          dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
774

775 776 777 778 779 780 781 782 783 784 785 786 787 788
-- | 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
789 790 791
{-
************************************************************************
*                                                                      *
792
          The ABI of an IfaceDecl
Austin Seipp's avatar
Austin Seipp committed
793 794
*                                                                      *
************************************************************************
795 796 797 798 799 800 801 802

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

804 805
   (b) the declaration itself, as exposed to clients.  That is, the
       definition of an Id is included in the fingerprint only if
806
       it is made available as an unfolding in the interface.
807

808
   (c) the fixity of the identifier (if it exists)
809 810 811 812 813 814
   (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
815 816
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
817
-}
818

819 820
type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)

821
data IfaceDeclExtras
822
  = IfaceIdExtras IfaceIdExtras
823

824
  | IfaceDataExtras
825
       (Maybe Fixity)           -- Fixity of the tycon itself (if it exists)
826
       [IfaceInstABI]           -- Local class and family instances of this tycon
827
                                -- See Note [Orphans] in InstEnv
828 829
       [AnnPayload]             -- Annotations of the type itself
       [IfaceIdExtras]          -- For each constructor: fixity, RULES and annotations
830

831
  | IfaceClassExtras
832
       (Maybe Fixity)           -- Fixity of the class itself (if it exists)
dterei's avatar
dterei committed
833 834
       [IfaceInstABI]           -- Local instances of this class *or*
                                --   of its associated data types
835
                                -- See Note [Orphans] in InstEnv
836 837
       [AnnPayload]             -- Annotations of the type itself
       [IfaceIdExtras]          -- For each class method: fixity, RULES and annotations
838

839
  | IfaceSynonymExtras (Maybe Fixity) [AnnPayload]
840

841
  | IfaceFamilyExtras   (Maybe Fixity) [IfaceInstABI] [AnnPayload]
842

843 844
  | IfaceOtherDeclExtras

845 846
data IfaceIdExtras
  = IdExtras
847
       (Maybe Fixity)           -- Fixity of the Id (if it exists)
848 849 850
       [IfaceRule]              -- Rules for the Id
       [AnnPayload]             -- Annotations for the Id

851 852
-- When hashing a class or family instance, we hash only the
-- DFunId or CoAxiom, because that depends on all the
853 854 855 856
-- information about the instance.
--
type IfaceInstABI = IfExtName   -- Name of DFunId or CoAxiom that is evidence for the instance

857 858 859 860
abiDecl :: IfaceDeclABI -> IfaceDecl
abiDecl (_, decl, _) = decl

cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
861 862
cmp_abiNames abi1 abi2 = getOccName (abiDecl abi1) `compare`
                         getOccName (abiDecl abi2)
863 864 865

freeNamesDeclABI :: IfaceDeclABI -> NameSet
freeNamesDeclABI (_mod, decl, extras) =
866
  freeNamesIfDecl decl `unionNameSet` freeNamesDeclExtras extras
867 868

freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
869 870
freeNamesDeclExtras (IfaceIdExtras id_extras)
  = freeNamesIdExtras id_extras
871
freeNamesDeclExtras (IfaceDataExtras  _ insts _ subs)
872
  = unionNameSets (mkNameSet insts : map freeNamesIdExtras subs)
873
freeNamesDeclExtras (IfaceClassExtras _ insts _ subs)
874
  = unionNameSets (mkNameSet insts : map freeNamesIdExtras subs)
875 876 877
freeNamesDeclExtras (IfaceSynonymExtras _ _)
  = emptyNameSet
freeNamesDeclExtras (IfaceFamilyExtras _ insts _)
878
  = mkNameSet insts
879 880 881
freeNamesDeclExtras IfaceOtherDeclExtras
  = emptyNameSet

882
freeNamesIdExtras :: IfaceIdExtras -> NameSet
883
freeNamesIdExtras (IdExtras _ rules _) = unionNameSets (map freeNamesIfRule rules)
884

885
instance Outputable IfaceDeclExtras where
886
  ppr IfaceOtherDeclExtras       = Outputable.empty
887
  ppr (IfaceIdExtras  extras)    = ppr_id_extras extras
888 889
  ppr (IfaceSynonymExtras fix anns) = vcat [ppr fix, ppr anns]
  ppr (IfaceFamilyExtras fix finsts anns) = vcat [ppr fix, ppr finsts, ppr anns]
890
  ppr (IfaceDataExtras fix insts anns stuff) = vcat [ppr fix, ppr_insts insts, ppr anns,
891
                                                ppr_id_extras_s stuff]
892
  ppr (IfaceClassExtras fix insts anns stuff) = vcat [ppr fix, ppr_insts insts, ppr anns,
893 894 895
                                                 ppr_id_extras_s stuff]

ppr_insts :: [IfaceInstABI] -> SDoc
896
ppr_insts _ = text "<insts>"
897

898 899
ppr_id_extras_s :: [IfaceIdExtras] -> SDoc
ppr_id_extras_s stuff = vcat (map ppr_id_extras stuff)
900

901 902
ppr_id_extras :: IfaceIdExtras -> SDoc
ppr_id_extras (IdExtras fix rules anns) = ppr fix $$ vcat (map ppr rules) $$ vcat (map ppr anns)
903

904
-- This instance is used only to compute fingerprints
905 906
instance Binary IfaceDeclExtras where
  get _bh = panic "no get for IfaceDeclExtras"
907 908
  put_ bh (IfaceIdExtras extras) = do
   putByte bh 1; put_ bh extras
909 910 911 912
  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
913 914 915 916 917
  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
918 919 920 921

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 }
922

923
declExtras :: (OccName -> Maybe Fixity)
924
           -> (OccName -> [AnnPayload])
925
           -> OccEnv [IfaceRule]
926 927
           -> OccEnv [IfaceClsInst]
           -> OccEnv [IfaceFamInst]
928 929 930
           -> IfaceDecl
           -> IfaceDeclExtras

931
declExtras fix_fn ann_fn rule_env inst_env fi_env decl
932
  = case decl of