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

\begin{code}
module MkIface ( 
Simon Marlow's avatar
Simon Marlow committed
8 9
        mkUsedNames,
        mkDependencies,
10 11
        mkIface,        -- Build a ModIface from a ModGuts, 
                        -- including computing version information
12

Simon Marlow's avatar
Simon Marlow committed
13 14
        mkIfaceTc,

15
        writeIfaceFile, -- Write the interface file
16

17 18
        checkOldIface,  -- See if recompilation is required, by
                        -- comparing version information
19 20

        tyThingToIfaceDecl -- Converting things to their Iface equivalents
21 22 23
 ) where
\end{code}

24 25 26
  -----------------------------------------------
          Recompilation checking
  -----------------------------------------------
27

28 29
A complete description of how recompilation checking works can be
found in the wiki commentary:
30

31
 http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
32

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

Basic idea: 
37

38
  * In the mi_usages information in an interface, we record the 
39
    fingerprint of each free variable of the module
40

41 42 43 44 45
  * 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.
46 47

  * In checkOldIface we compare the mi_usages for the module with
48
    the actual fingerprint for all each thing recorded in mi_usages
49 50 51 52

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

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

Simon Marlow's avatar
Simon Marlow committed
98 99
import Control.Monad
import Data.List
100 101
import Data.Map (Map)
import qualified Data.Map as Map
Simon Marlow's avatar
Simon Marlow committed
102
import Data.IORef
Ian Lynagh's avatar
Ian Lynagh committed
103
import System.FilePath
104 105 106 107 108
\end{code}



%************************************************************************
109
%*                                                                      *
110
\subsection{Completing an interface}
111
%*                                                                      *
112 113 114 115
%************************************************************************

\begin{code}
mkIface :: HscEnv
116 117 118 119
        -> 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
120
               Maybe (ModIface, -- The new one
121
                      Bool))    -- True <=> there was an old Iface, and the
122 123
                                --          new one is identical, so no need
                                --          to write it
124

125
mkIface hsc_env maybe_old_fingerprint mod_details
126
         ModGuts{     mg_module    = this_mod,
127
		      mg_boot      = is_boot,
Simon Marlow's avatar
Simon Marlow committed
128
		      mg_used_names = used_names,
129
		      mg_deps      = deps,
Simon Marlow's avatar
Simon Marlow committed
130
                      mg_dir_imps  = dir_imp_mods,
131 132
		      mg_rdr_env   = rdr_env,
		      mg_fix_env   = fix_env,
Ian Lynagh's avatar
Ian Lynagh committed
133
		      mg_warns   = warns,
Simon Marlow's avatar
Simon Marlow committed
134
	              mg_hpc_info  = hpc_info }
135
        = mkIface_ hsc_env maybe_old_fingerprint
Simon Marlow's avatar
Simon Marlow committed
136
                   this_mod is_boot used_names deps rdr_env 
Ian Lynagh's avatar
Ian Lynagh committed
137
                   fix_env warns hpc_info dir_imp_mods mod_details
Thomas Schilling's avatar
Thomas Schilling committed
138

Simon Marlow's avatar
Simon Marlow committed
139 140 141 142
-- | 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
143
          -> Maybe Fingerprint	-- The old fingerprint, if we have it
Simon Marlow's avatar
Simon Marlow committed
144 145
          -> ModDetails		-- gotten from mkBootModDetails, probably
          -> TcGblEnv		-- Usages, deprecations, etc
Thomas Schilling's avatar
Thomas Schilling committed
146
	  -> IO (Messages, Maybe (ModIface, Bool))
147
mkIfaceTc hsc_env maybe_old_fingerprint mod_details
Simon Marlow's avatar
Simon Marlow committed
148 149 150 151 152
  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
153
                      tcg_warns = warns,
Simon Marlow's avatar
Simon Marlow committed
154 155 156
                      tcg_hpc = other_hpc_info
                    }
  = do
157
          let used_names = mkUsedNames tc_result
Simon Marlow's avatar
Simon Marlow committed
158 159
          deps <- mkDependencies tc_result
          let hpc_info = emptyHpcInfo other_hpc_info
160
          mkIface_ hsc_env maybe_old_fingerprint
Simon Marlow's avatar
Simon Marlow committed
161
                   this_mod (isHsBoot hsc_src) used_names deps rdr_env 
Ian Lynagh's avatar
Ian Lynagh committed
162
                   fix_env warns hpc_info (imp_mods imports) mod_details
Simon Marlow's avatar
Simon Marlow committed
163 164
        

165 166
mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
Simon Marlow's avatar
Simon Marlow committed
167 168 169 170 171 172 173 174
        
mkDependencies :: TcGblEnv -> IO Dependencies
mkDependencies
          TcGblEnv{ tcg_mod = mod,
                    tcg_imports = imports,
                    tcg_th_used = th_var
                  }
 = do 
175
      th_used   <- readIORef th_var                     -- Whether TH is used
Simon Marlow's avatar
Simon Marlow committed
176 177 178 179 180 181 182 183 184 185 186 187
      let
        dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
                -- 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.)

        pkgs | th_used   = insertList thPackageId (imp_dep_pkgs imports)
             | otherwise = imp_dep_pkgs imports

188 189 190 191 192
        -- add in safe haskell 'package needs to be safe' bool
        sorted_pkgs = sortBy stablePackageIdCmp pkgs
        trust_pkgs  = imp_trust_pkgs imports
        dep_pkgs'   = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs

193
      return Deps { dep_mods   = sortBy (stableModuleNameCmp `on` fst) dep_mods,
194
                    dep_pkgs   = dep_pkgs',
195 196
                    dep_orphs  = sortBy stableModuleCmp (imp_orphs  imports),
                    dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
Simon Marlow's avatar
Simon Marlow committed
197
                -- sort to get into canonical order
198
                -- NB. remember to use lexicographic ordering
Simon Marlow's avatar
Simon Marlow committed
199

200
mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
Ian Lynagh's avatar
Ian Lynagh committed
201
         -> NameSet -> Dependencies -> GlobalRdrEnv
Ian Lynagh's avatar
Ian Lynagh committed
202
         -> NameEnv FixItem -> Warnings -> HpcInfo
203
         -> ImportedMods
Ian Lynagh's avatar
Ian Lynagh committed
204
         -> ModDetails
Thomas Schilling's avatar
Thomas Schilling committed
205
	 -> IO (Messages, Maybe (ModIface, Bool))
206
mkIface_ hsc_env maybe_old_fingerprint 
Ian Lynagh's avatar
Ian Lynagh committed
207
         this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
Simon Marlow's avatar
Simon Marlow committed
208 209
         dir_imp_mods
	 ModDetails{  md_insts 	   = insts, 
210 211
		      md_fam_insts = fam_insts,
		      md_rules 	   = rules,
212
		      md_anns	   = anns,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
213
                      md_vect_info = vect_info,
214
		      md_types 	   = type_env,
Simon Marlow's avatar
Simon Marlow committed
215
		      md_exports   = exports }
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	{ usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
Simon Marlow's avatar
Simon Marlow committed
222

223 224 225
	; let	{ entities = typeEnvElts type_env ;
                  decls  = [ tyThingToIfaceDecl entity
			   | entity <- entities,
226 227 228 229 230 231 232
			     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
233

234
		; fixities    = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
Ian Lynagh's avatar
Ian Lynagh committed
235
		; warns     = src_warns
236
		; iface_rules = map (coreRuleToIfaceRule this_mod) rules
237 238
		; 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
239
                ; iface_vect_info = flattenVectInfo vect_info
240
                ; trust_info  = (setSafeMode . safeHaskell) dflags
241 242 243

	        ; intermediate_iface = ModIface { 
			mi_module   = this_mod,
244
			mi_boot     = is_boot,
245 246
			mi_deps     = deps,
			mi_usages   = usages,
247
			mi_exports  = mkIfaceExports exports,
248 249 250
	
			-- Sort these lexicographically, so that
			-- the result is stable across compilations
251
			mi_insts    = sortLe le_inst iface_insts,
252
			mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
253
			mi_rules    = sortLe le_rule iface_rules,
254

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
255 256
                        mi_vect_info = iface_vect_info,

257
			mi_fixities = fixities,
Ian Lynagh's avatar
Ian Lynagh committed
258
			mi_warns  = warns,
259
			mi_anns     = mkIfaceAnnotations anns,
260 261
			mi_globals  = Just rdr_env,

262
			-- Left out deliberately: filled in by addVersionInfo
263 264 265 266
			mi_iface_hash = fingerprint0,
			mi_mod_hash  = fingerprint0,
 			mi_exp_hash  = fingerprint0,
 			mi_orphan_hash = fingerprint0,
267 268
			mi_orphan    = False,	-- Always set by addVersionInfo, but
						-- it's a strict field, so we can't omit it.
269
                        mi_finsts    = False,   -- Ditto
270
			mi_decls     = deliberatelyOmitted "decls",
271
			mi_hash_fn   = deliberatelyOmitted "hash_fn",
272
			mi_hpc       = isHpcUsed hpc_info,
273
			mi_trust     = trust_info,
274 275

			-- And build the cached values
Ian Lynagh's avatar
Ian Lynagh committed
276
			mi_warn_fn = mkIfaceWarnCache warns,
277
			mi_fix_fn = mkIfaceFixCache fixities }
278
		}
279

280
        ; (new_iface, no_change_at_all) 
281 282
	        <- {-# SCC "versioninfo" #-}
			 addFingerprints hsc_env maybe_old_fingerprint
283
                                         intermediate_iface decls
284

285
		-- Warn about orphans
286 287 288 289 290
	; let warn_orphs      = dopt Opt_WarnOrphans dflags
              warn_auto_orphs = dopt 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
291 292 293 294 295 296 297
	      errs_and_warns = (orph_warnings, emptyBag)
	      unqual = mkPrintUnqualified dflags rdr_env
	      inst_warns = listToBag [ instOrphWarn unqual d 
	      		   	     | (d,i) <- insts `zip` iface_insts
	      		   	     , isNothing (ifInstOrph i) ]
	      rule_warns = listToBag [ ruleOrphWarn unqual this_mod r 
	      		    	     | r <- iface_rules
298 299 300
	      		   	     , isNothing (ifRuleOrph r)
                                     , if ifRuleAuto r then warn_auto_orphs
                                                       else warn_orphs ]
301

Thomas Schilling's avatar
Thomas Schilling committed
302 303 304
	; if errorsFound dflags errs_and_warns
            then return ( errs_and_warns, Nothing )
            else do {
305

306
	   	-- Debug printing
307 308 309
	; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE" 
			(pprModIface new_iface)

310 311 312 313 314 315
                -- bug #1617: on reload we weren't updating the PrintUnqualified
                -- correctly.  This stems from the fact that the interface had
                -- not changed, so addVersionInfo returns the old ModIface
                -- with the old GlobalRdrEnv (mi_globals).
        ; let final_iface = new_iface{ mi_globals = Just rdr_env }

Thomas Schilling's avatar
Thomas Schilling committed
316
	; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
317
  where
318 319 320 321 322 323 324 325
     r1 `le_rule`     r2 = ifRuleName      r1    <=    ifRuleName      r2
     i1 `le_inst`     i2 = ifDFun          i1 `le_occ` ifDFun          i2  
     i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2

     le_occ :: Name -> Name -> Bool
	-- Compare lexicographically by OccName, *not* by unique, because 
	-- the latter is not stable across compilations
     le_occ n1 n2 = nameOccName n1 <= nameOccName n2
326

327
     dflags = hsc_dflags hsc_env
328 329

     deliberatelyOmitted :: String -> a
330
     deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
331

332
     ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
333

334 335 336 337
     flattenVectInfo (VectInfo { vectInfoVar          = vVar
                               , vectInfoTyCon        = vTyCon
                               , vectInfoScalarVars   = vScalarVars
                               , vectInfoScalarTyCons = vScalarTyCons
338
                               }) = 
339 340 341 342 343 344
       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
345
       } 
346

347
-----------------------------
348 349
writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
writeIfaceFile dflags location new_iface
Ian Lynagh's avatar
Ian Lynagh committed
350
    = do createDirectoryHierarchy (takeDirectory hi_file_path)
351
         writeBinIface dflags hi_file_path new_iface
352
    where hi_file_path = ml_hi_file location
353 354


355 356
-- -----------------------------------------------------------------------------
-- Look up parents and versions of Names
357

358 359
-- 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
360
-- the parent and version info.
361

362
mkHashFun
363 364
        :: HscEnv                       -- needed to look up versions
        -> ExternalPackageState         -- ditto
365 366
        -> (Name -> Fingerprint)
mkHashFun hsc_env eps
367 368
  = \name -> 
      let 
369
        mod = ASSERT2( isExternalName name, ppr name ) nameModule name
370 371 372 373
        occ = nameOccName name
        iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse` 
                   pprPanic "lookupVers2" (ppr mod <+> ppr occ)
      in  
374 375
        snd (mi_hash_fn iface occ `orElse` 
                  pprPanic "lookupVers1" (ppr mod <+> ppr occ))
376
  where
377 378
      hpt = hsc_HPT hsc_env
      pit = eps_PIT eps
379

380 381 382 383 384 385 386 387 388
-- ---------------------------------------------------------------------------
-- Compute fingerprints for the interface

addFingerprints
        :: HscEnv
        -> Maybe Fingerprint -- the old fingerprint, if any
        -> ModIface	     -- The new interface (lacking decls)
        -> [IfaceDecl]       -- The new decls
        -> IO (ModIface,     -- Updated interface
389
               Bool)	     -- True <=> no changes at all; 
390 391 392 393 394 395
                             -- no need to write Iface

addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
 = do
   eps <- hscEPS hsc_env
   let
396
        -- The ABI of a declaration represents everything that is made
397 398 399 400 401 402 403 404 405 406 407 408 409
        -- visible about the declaration that a client can depend on.
        -- see IfaceDeclABI below.
       declABI :: IfaceDecl -> IfaceDeclABI 
       declABI decl = (this_mod, decl, extras)
        where extras = declExtras fix_fn non_orph_rules non_orph_insts decl

       edges :: [(IfaceDeclABI, Unique, [Unique])]
       edges = [ (abi, getUnique (ifName decl), out)
	       | decl <- new_decls
               , let abi = declABI decl
	       , let out = localOccs $ freeNamesDeclABI abi
               ]

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
410
       name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
411
       localOccs = map (getUnique . getParent . getOccName) 
412
                        . filter ((== this_mod) . name_module)
413 414 415 416 417 418 419 420 421 422 423 424 425
                        . nameSetToList
          where getParent occ = lookupOccEnv parent_map occ `orElse` occ

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

        -- strongly-connected groups of declarations, in dependency order
426
       groups = stronglyConnCompFromEdgedVertices edges
427 428 429 430 431 432 433 434 435 436 437 438 439 440 441

       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
442
          = ASSERT2( isExternalName name, ppr name )
443
	    let hash | nameModule name /= this_mod =  global_hash_fn name
444 445 446 447
                     | otherwise = 
                        snd (lookupOccEnv local_env (getOccName name)
                           `orElse` pprPanic "urk! lookup local fingerprint" 
                                       (ppr name)) -- (undefined,fingerprint0))
448 449 450 451 452 453 454
                -- 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.
455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491
            in 
            put_ bh hash

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

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

       fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
          = do let hash_fn = mk_put_name local_env
                   decl = abiDecl abi
               -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
               hash <- computeFingerprint dflags hash_fn abi
               return (extend_hash_env (hash,decl) local_env,
                       (hash,decl) : decls_w_hashes)

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

       extend_hash_env :: (Fingerprint,IfaceDecl)
                       -> OccEnv (OccName,Fingerprint)
                       -> OccEnv (OccName,Fingerprint)
       extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
492
        where
493 494 495 496 497 498 499 500 501
          decl_name = ifName d
          item = (decl_name, hash)
          env1 = extendOccEnv env0 decl_name item
          add_imp bndr env = extendOccEnv env bndr item
            
   --
   (local_env, decls_w_hashes) <- 
       foldM fingerprint_group (emptyOccEnv, []) groups

502 503 504 505 506
   -- 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)

507
   -- the export hash of a module depends on the orphan hashes of the
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
508
   -- orphan modules below us in the dependency tree.  This is the way
509 510 511 512
   -- 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.
513 514
   let orph_mods = filter ((== this_pkg) . modulePackageId)
                   $ dep_orphs sorted_deps
515 516 517
   dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods

   orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
518
                      (map ifDFun orph_insts, orph_rules, fam_insts)
519 520 521 522

   -- the export list hash doesn't depend on the fingerprints of
   -- the Names it mentions, only the Names themselves, hence putNameLiterally.
   export_hash <- computeFingerprint dflags putNameLiterally 
523 524 525
                      (mi_exports iface0,
                       orphan_hash,
                       dep_orphan_hashes,
526
                       dep_pkgs (mi_deps iface0),
527 528
                        -- dep_pkgs: see "Package Version Changes" on
                        -- wiki/Commentary/Compiler/RecompilationAvoidance
529 530 531 532
                       mi_trust iface0)
                        -- TODO: Can probably make more fine grained. Only
                        -- really need to have recompilation for overlapping
                        -- instances.
533 534

   -- put the declarations in a canonical order, sorted by OccName
535
   let sorted_decls = Map.elems $ Map.fromList $
536 537 538 539 540 541 542 543 544 545 546 547
                          [(ifName d, e) | e@(_, d) <- decls_w_hashes]

   -- the ABI hash depends on:
   --   - decls
   --   - export list
   --   - orphans
   --   - deprecations
   --   - XXX vect info?
   mod_hash <- computeFingerprint dflags putNameLiterally
                      (map fst sorted_decls,
                       export_hash,
                       orphan_hash,
Ian Lynagh's avatar
Ian Lynagh committed
548
                       mi_warns iface0)
549 550 551 552 553 554 555 556 557

   -- The interface hash depends on:
   --    - the ABI hash, plus
   --    - usages
   --    - deps
   --    - hpc
   iface_hash <- computeFingerprint dflags putNameLiterally
                      (mod_hash, 
                       mi_usages iface0,
558
                       sorted_deps,
559 560 561 562 563 564 565 566 567 568 569 570 571 572 573
                       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,
                mi_orphan      = not (null orph_rules && null orph_insts),
                mi_finsts      = not . null $ mi_fam_insts iface0,
                mi_decls       = sorted_decls,
                mi_hash_fn     = lookupOccEnv local_env }
   --
574
   return (final_iface, no_change_at_all)
575

576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602
  where
    this_mod = mi_module iface0
    dflags = hsc_dflags hsc_env
    this_pkg = thisPackage dflags
    (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
    (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
        -- ToDo: shouldn't we be splitting fam_insts into orphans and
        -- non-orphans?
    fam_insts = mi_fam_insts iface0
    fix_fn = mi_fix_fn iface0


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


603 604 605
sortDependencies :: Dependencies -> Dependencies
sortDependencies d
 = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
606
          dep_pkgs   = sortBy (stablePackageIdCmp `on` fst) (dep_pkgs d),
607 608
          dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
          dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624
\end{code}


%************************************************************************
%*		                					*
          The ABI of an IfaceDecl       									
%*	       	     							*
%************************************************************************

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

626 627 628 629 630 631 632 633 634 635 636
   (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
637 638
the declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
and fingerprinting that as part of the declaration.
639 640

\begin{code}
641 642
type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)

643 644 645 646 647 648 649
data IfaceDeclExtras 
  = IfaceIdExtras    Fixity [IfaceRule]
  | IfaceDataExtras  Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
  | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
  | IfaceSynExtras   Fixity
  | IfaceOtherDeclExtras

650 651 652 653 654 655 656 657 658 659 660 661 662 663
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)
664 665 666 667
freeNamesDeclExtras (IfaceDataExtras  _ insts subs)
  = unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
freeNamesDeclExtras (IfaceClassExtras _ insts subs)
  = unionManyNameSets (mkNameSet insts : map freeNamesSub subs)
668 669
freeNamesDeclExtras (IfaceSynExtras _)
  = emptyNameSet
670 671 672 673 674 675
freeNamesDeclExtras IfaceOtherDeclExtras
  = emptyNameSet

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

676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693
instance Outputable IfaceDeclExtras where
  ppr IfaceOtherDeclExtras       = empty
  ppr (IfaceIdExtras  fix rules) = ppr_id_extras fix rules
  ppr (IfaceSynExtras fix)       = ppr fix
  ppr (IfaceDataExtras fix insts stuff)  = vcat [ppr fix, ppr_insts insts,
                                                 ppr_id_extras_s stuff]
  ppr (IfaceClassExtras fix insts stuff) = vcat [ppr fix, ppr_insts insts,
                                                 ppr_id_extras_s stuff]

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

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

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

694
-- This instance is used only to compute fingerprints
695 696 697 698 699 700
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
701 702 703 704
  put_ bh (IfaceClassExtras fix insts methods) = do
   putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
  put_ bh (IfaceSynExtras fix) = do
   putByte bh 4; put_ bh fix
705
  put_ bh IfaceOtherDeclExtras = do
706
   putByte bh 5
707 708 709 710 711 712 713 714 715 716 717 718 719

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

declExtras fix_fn rule_env inst_env decl
  = case decl of
      IfaceId{} -> IfaceIdExtras (fix_fn n) 
                        (lookupOccEnvL rule_env n)
      IfaceData{ifCons=cons} -> 
                     IfaceDataExtras (fix_fn n)
720
                        (map ifDFun $ lookupOccEnvL inst_env n)
721 722
                        (map (id_extras . ifConOcc) (visibleIfConDecls cons))
      IfaceClass{ifSigs=sigs} -> 
723
                     IfaceClassExtras (fix_fn n)
724
                        (map ifDFun $ lookupOccEnvL inst_env n)
725
                        [id_extras op | IfaceClassOp op _ _ <- sigs]
726
      IfaceSyn{} -> IfaceSynExtras (fix_fn n)
727 728 729 730 731
      _other -> IfaceOtherDeclExtras
  where
        n = ifName decl
        id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)

732
--
733 734
-- When hashing an instance, we hash only the DFunId, because that
-- depends on all the information about the instance.
735
--
736
type IfaceInstABI = IfExtName
737 738 739 740 741 742 743

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 ()
744 745 746
putNameLiterally bh name = ASSERT( isExternalName name ) 
  do { put_ bh $! nameModule name
     ; put_ bh $! nameOccName name }
747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779

computeFingerprint :: Binary a
                   => DynFlags 
                   -> (BinHandle -> Name -> IO ())
                   -> a
                   -> IO Fingerprint

computeFingerprint _dflags put_name a = do
  bh <- openBinMem (3*1024) -- just less than a block
  ud <- newWriteState put_name putFS
  bh <- return $ setUserData bh ud
  put_ bh a
  fingerprintBinMem bh

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

781 782 783 784 785 786 787 788 789 790
instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
instOrphWarn unqual inst
  = mkWarnMsg (getSrcSpan inst) unqual $
    hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)

ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
ruleOrphWarn unqual mod rule
  = mkWarnMsg silly_loc unqual $
    ptext (sLit "Orphan rule:") <+> ppr rule
  where
791
    silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
792 793
    -- 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
794 795

----------------------
796
-- mkOrphMap partitions instance decls or rules into
797 798 799
-- 	(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
800
mkOrphMap :: (decl -> Maybe OccName)	-- (Just occ) for a non-orphan decl, keyed by occ
801 802 803 804 805
					-- 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
806
mkOrphMap get_key decls
807 808 809 810
  = foldl go (emptyOccEnv, []) decls
  where
    go (non_orphs, orphs) d
	| Just occ <- get_key d
811
	= (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
812 813 814 815
	| otherwise = (non_orphs, d:orphs)
\end{code}


816 817 818 819 820
%************************************************************************
%*		                					*
       Keeping track of what we've slurped, and fingerprints
%*	       	     							*
%************************************************************************
821 822

\begin{code}
823 824
mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
mkUsageInfo hsc_env this_mod dir_imp_mods used_names
825
  = do	{ eps <- hscEPS hsc_env
826 827
	; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
				     dir_imp_mods used_names
828 829 830 831
	; 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.
832

833 834
mk_usage_info :: PackageIfaceTable
              -> HscEnv
835 836
              -> Module
              -> ImportedMods
837 838
              -> NameSet
              -> [Usage]
839 840
mk_usage_info pit hsc_env this_mod direct_imports used_names
  = mapCatMaybes mkUsage usage_mods
841
  where
842
    hpt = hsc_HPT hsc_env
Simon Marlow's avatar
Simon Marlow committed
843
    dflags = hsc_dflags hsc_env
844 845 846 847 848 849 850 851
    this_pkg = thisPackage dflags

    used_mods    = moduleEnvKeys ent_map
    dir_imp_mods = (moduleEnvKeys direct_imports)
    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.
852

853
    -- ent_map groups together all the things imported and used
854
    -- from a particular module
855 856
    ent_map :: ModuleEnv [OccName]
    ent_map  = foldNameSet add_mv emptyModuleEnv used_names
857 858
     where
      add_mv name mv_map
859 860 861
        | isWiredInName name = mv_map  -- ignore wired-in names
        | otherwise
        = case nameModule_maybe name of
862
             Nothing  -> pprPanic "mkUsageInfo: internal name?" (ppr name)
863 864
             Just mod -> -- This lambda function is really just a
                         -- specialised (++); originally came about to
865
                         -- avoid quadratic behaviour (trac #2680)
866
                         extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod [occ]
867
    		   where occ = nameOccName name
868 869
    
    -- We want to create a Usage for a home module if 
870 871 872 873 874 875 876 877 878 879 880 881 882
    --	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)
    mkUsage :: Module -> Maybe Usage
    mkUsage mod
      | isNothing maybe_iface		-- We can't depend on it if we didn't
                        		-- load its interface.
      || mod == this_mod                -- We don't care about usages of
                                        -- things in *this* module
      = Nothing

      | modulePackageId mod /= this_pkg
      = Just UsagePackageModule{ usg_mod      = mod,
883 884
                                 usg_mod_hash = mod_hash,
                                 usg_safe     = imp_safe }
885 886 887 888 889
        -- for package modules, we record the module hash only

      | (null used_occs
	  && isNothing export_hash
          && not is_direct_import
890
	  && not finsts_mod)
891
      = Nothing			-- Record no usage info
892 893 894
        -- 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.
895 896
    
      | otherwise	
897 898
      = Just UsageHomeModule { 
                      usg_mod_name = moduleName mod,
899 900 901 902
                      usg_mod_hash = mod_hash,
                      usg_exports  = export_hash,
                      usg_entities = Map.toList ent_hashs,
                      usg_safe     = imp_safe }
903
      where
904 905 906
        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
907

908
        Just iface   = maybe_iface
909
	finsts_mod   = mi_finsts    iface
910 911
        hash_env     = mi_hash_fn   iface
        mod_hash     = mi_mod_hash  iface
dterei's avatar
dterei committed
912
        export_hash | depend_on_exports = Just (mi_exp_hash iface)
913 914 915 916
                    | otherwise         = Nothing

        (is_direct_import, imp_safe)
            = case lookupModuleEnv direct_imports mod of
917 918
                Just ((_,_,_,safe):_xs) -> (True, safe)
                Just _                  -> pprPanic "mkUsage: empty direct import" empty
919
                Nothing                 -> (False, safeImplicitImpsReq dflags)
920 921
                -- Nothing case is for implicit imports like 'System.IO' when 'putStrLn'
                -- is used in the source code. We require them to be safe in SafeHaskell
922 923
    
        used_occs = lookupModuleEnv ent_map mod `orElse` []
924

925
    	-- Making a Map here ensures that (a) we remove duplicates
926 927
        -- when we have usages on several subordinates of a single parent,
        -- and (b) that the usages emerge in a canonical order, which
928
        -- is why we use Map rather than OccEnv: Map works
929
        -- using Ord on the OccNames, which is a lexicographic ordering.
930 931
	ent_hashs :: Map OccName Fingerprint
        ent_hashs = Map.fromList (map lookup_occ used_occs)
932 933
        
        lookup_occ occ = 
934 935 936 937
            case hash_env occ of
                Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
                Just r  -> r

dterei's avatar
dterei committed
938 939 940 941 942 943 944 945 946 947 948 949 950 951 952
        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!
        -}
953 954
\end{code}

955 956 957 958 959 960 961 962 963 964 965
\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}

966
\begin{code}
967 968
mkIfaceExports :: [AvailInfo]
               -> [(Module, [GenAvailInfo OccName])]
969
                  -- Group by module and sort by occurrence
970
mkIfaceExports exports
971
  = [ (mod, Map.elems avails)
972 973
    | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
                              (moduleEnvToList groupFM)
974
                       -- NB. the Map.toList is in a random order,
975 976 977
                       -- because Ord Module is not a predictable
                       -- ordering.  Hence we perform a final sort
                       -- using the stable Module ordering.
978 979
    ]
  where
980 981
	-- Group by the module where the exported entities are defined
	-- (which may not be the same for all Names in an Avail)
982
	-- Deliberately use Map rather than UniqFM so we
983
	-- get a canonical ordering
984
    groupFM :: ModuleEnv (Map FastString (GenAvailInfo OccName))
985
    groupFM = foldl add emptyModuleEnv exports
986

987
    add_one :: ModuleEnv (Map FastString (GenAvailInfo OccName))
988
	    -> Module -> GenAvailInfo OccName
989
	    -> ModuleEnv (Map FastString (GenAvailInfo OccName))
990
    add_one env mod avail 
991 992 993
      -- XXX Is there a need to flip Map.union here?
      =  extendModuleEnvWith (flip Map.union) env mod 
		(Map.singleton (occNameFS (availName avail)) avail)
994 995

	-- NB: we should not get T(X) and T(Y) in the export list
996
	--     else the Map.union will simply discard one!  They
997 998
	--     should have been combined by now.
    add env (Avail n)
999 1000
      = ASSERT( isExternalName n ) 
        add_one env (nameModule n) (Avail (nameOccName n))
1001 1002

    add env (AvailTC tc ns)
1003 1004
      = ASSERT( all isExternalName ns ) 
	foldl add_for_mod env mods
1005
      where
1006 1007 1008 1009 1010
	tc_occ = nameOccName tc
	mods   = nub (map nameModule ns)
		-- Usually just one, but see Note [Original module]

	add_for_mod env mod
1011 1012
	    = add_one env mod (AvailTC tc_occ (sort names_from_mod))
              -- NB. sort the children, we need a canonical order
1013 1014
	    where
	      names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
1015 1016
\end{code}

1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031
Note [Orignal module]
~~~~~~~~~~~~~~~~~~~~~
Consider this:
	module X where { data family T }
	module Y( T(..) ) where { import X; data instance T Int = MkT Int }
The exported Avail from Y will look like
	X.T{X.T, Y.MkT}
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.

1032

1033 1034 1035 1036 1037 1038 1039 1040 1041 1042
%************************************************************************
%*									*
	Load the old interface file for this module (unless
	we have it aleady), and check whether it is up to date
	
%*									*
%************************************************************************

\begin{code}
checkOldIface :: HscEnv
1043
	      -> ModSummary
1044 1045 1046 1047
	      -> Bool 			-- Source unchanged
	      -> Maybe ModIface 	-- Old interface from compilation manager, if any
	      -> IO (RecompileRequired, Maybe ModIface)

1048
checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1049 1050 1051 1052
  = do  showPass (hsc_dflags hsc_env) $
            "Checking old interface for " ++ (showSDoc $ ppr $ ms_mod mod_summary)
        initIfaceCheck hsc_env $
            check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1053

Ian Lynagh's avatar
Ian Lynagh committed
1054 1055
check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
                -> IfG (Bool, Maybe ModIface)
1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092
check_old_iface hsc_env mod_summary src_unchanged maybe_iface
  = let src_changed = not src_unchanged
        dflags = hsc_dflags hsc_env
        getIface =
             case maybe_iface of
                 Just _  -> do
                     traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
                     return maybe_iface
                 Nothing -> do
                     let iface_path = msHiFilePath mod_summary
                     read_result <- readIface (ms_mod mod_summary) iface_path False
                     case read_result of
                         Failed err -> do
                             traceIf (text "FYI: cannont read old interface file:" $$ nest 4 err)
                             return Nothing
                         Succeeded iface -> do
                             traceIf (text "Read the interface file" <+> text iface_path)
                             return $ Just iface

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

         -- If the source has changed and we're in interactive mode, avoid reading
         -- an interface; just return the one we might have been supplied with.
        if not (isObjectTarget $ hscTarget dflags) && src_changed
            then return (outOfDate, maybe_iface)
            else do
                -- Try and read the old interface for the current module
                -- from the .hi file left from the last time we compiled it
                maybe_iface' <- getIface
                case maybe_iface' of
                    Nothing -> return (outOfDate, maybe_iface')
                    Just iface -> do
                        -- We have got the old iface; check its versions
                        recomp <- checkVersions hsc_env src_unchanged mod_summary iface
                        return recomp
1093 1094 1095 1096 1097 1098 1099 1100 1101
\end{code}

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

\begin{code}
type RecompileRequired = Bool
Ian Lynagh's avatar
Ian Lynagh committed
1102
upToDate, outOfDate :: Bool
1103 1104 1105
upToDate  = False	-- Recompile not required
outOfDate = True	-- Recompile required

1106 1107
-- | Check the safe haskell flags haven't changed
--   (e.g different flag on command line now)
1108 1109
safeHsChanged :: HscEnv -> ModIface -> Bool
safeHsChanged hsc_env iface
1110 1111
  = (getSafeMode $ mi_trust iface) /= (safeHaskell $ hsc_dflags hsc_env)

Simon Marlow's avatar
Simon Marlow committed
1112 1113
checkVersions :: HscEnv
	      -> Bool		-- True <=> source unchanged
1114
              -> ModSummary
1115
	      -> ModIface 	-- Old interface
1116
	      -> IfG (RecompileRequired, Maybe ModIface)
1117
checkVersions hsc_env source_unchanged mod_summary iface
1118
  | not source_unchanged
1119 1120 1121
  = let iface' = if safeHsChanged hsc_env iface then Nothing else Just iface
    in return (outOfDate, iface')

1122
  | otherwise
1123
  = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1124
                        ppr (mi_module iface) <> colon)