ghc/compiler/iface/MkIface.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4
   5 \begin{code}
   6 module MkIface (
   7         pprModIface, showIface,         -- Print the iface in Foo.hi
   8
   9         mkUsageInfo,    -- Construct the usage info for a module
  10
  11         mkIface,        -- Build a ModIface from a ModGuts,
  12                         -- including computing version information
  13
  14         writeIfaceFile, -- Write the interface file
  15
  16         checkOldIface   -- See if recompilation is required, by
  17                         -- comparing version information
  18  ) where
  19 \end{code}
  20
  21         -----------------------------------------------
  22                 MkIface.lhs deals with versioning
  23         -----------------------------------------------
  24
  25 Here's the version-related info in an interface file
  26
  27   module Foo 8          -- module-version
  28              3          -- export-list-version
  29              2          -- rule-version
  30     Usages:     -- Version info for what this compilation of Foo imported
  31         Baz 3           -- Module version
  32             [4]         -- The export-list version if Foo depended on it
  33             (g,2)       -- Function and its version
  34             (T,1)       -- Type and its version
  35
  36     <version> f :: Int -> Int {- Unfolding: \x -> Wib.t[2] x -}
  37                 -- The [2] says that f's unfolding
  38                 -- mentions verison 2 of Wib.t
  39
  40         -----------------------------------------------
  41                         Basic idea
  42         -----------------------------------------------
  43
  44 Basic idea:
  45   * In the mi_usages information in an interface, we record the
  46     version number of each free variable of the module
  47
  48   * In mkIface, we compute the version number of each exported thing A.f
  49     by comparing its A.f's info with its new info, and bumping its
  50     version number if it differs.  If A.f mentions B.g, and B.g's version
  51     number has changed, then we count A.f as having changed too.
  52
  53   * In checkOldIface we compare the mi_usages for the module with
  54     the actual version info for all each thing recorded in mi_usages
  55
  56
  57 Fixities
  58 ~~~~~~~~
  59 We count A.f as changing if its fixity changes
  60
  61 Rules
  62 ~~~~~
  63 If a rule changes, we want to recompile any module that might be
  64 affected by that rule.  For non-orphan rules, this is relatively easy.
  65 If module M defines f, and a rule for f, just arrange that the version
  66 number for M.f changes if any of the rules for M.f change.  Any module
  67 that does not depend on M.f can't be affected by the rule-change
  68 either.
  69
  70 Orphan rules (ones whose 'head function' is not defined in M) are
  71 harder.  Here's what we do.
  72
  73   * We have a per-module orphan-rule version number which changes if
  74     any orphan rule changes. (It's unaffected by non-orphan rules.)
  75
  76   * We record usage info for any orphan module 'below' this one,
  77     giving the orphan-rule version number.  We recompile if this
  78     changes.
  79
  80 The net effect is that if an orphan rule changes, we recompile every
  81 module above it.  That's very conservative, but it's devilishly hard
  82 to know what it might affect, so we just have to be conservative.
  83
  84 Instance decls
  85 ~~~~~~~~~~~~~~
  86 In an iface file we have
  87      module A where
  88         instance Eq a => Eq [a]  =  dfun29
  89         dfun29 :: ...
  90
  91 We have a version number for dfun29, covering its unfolding
  92 etc. Suppose we are compiling a module M that imports A only
  93 indirectly.  If typechecking M uses this instance decl, we record the
  94 dependency on A.dfun29 as if it were a free variable of the module
  95 (via the tcg_inst_usages accumulator).  That means that A will appear
  96 in M's usage list.  If the shape of the instance declaration changes,
  97 then so will dfun29's version, triggering a recompilation.
  98
  99 Adding an instance declaration, or changing an instance decl that is
 100 not currently used, is more tricky.  (This really only makes a
 101 difference when we have overlapping instance decls, because then the
 102 new instance decl might kick in to override the old one.)  We handle
 103 this in a very similar way that we handle rules above.
 104
 105   * For non-orphan instance decls, identify one locally-defined tycon/class
 106     mentioned in the decl.  Treat the instance decl as part of the defn of that
 107     tycon/class, so that if the shape of the instance decl changes, so does the
 108     tycon/class; that in turn will force recompilation of anything that uses
 109     that tycon/class.
 110
 111   * For orphan instance decls, act the same way as for orphan rules.
 112     Indeed, we use the same global orphan-rule version number.
 113
 114 mkUsageInfo
 115 ~~~~~~~~~~~
 116 mkUsageInfo figures out what the ``usage information'' for this
 117 moudule is; that is, what it must record in its interface file as the
 118 things it uses.
 119
 120 We produce a line for every module B below the module, A, currently being
 121 compiled:
 122         import B <n> ;
 123 to record the fact that A does import B indirectly.  This is used to decide
 124 to look to look for B.hi rather than B.hi-boot when compiling a module that
 125 imports A.  This line says that A imports B, but uses nothing in it.
 126 So we'll get an early bale-out when compiling A if B's version changes.
 127
 128 The usage information records:
 129
 130 \begin{itemize}
 131 \item   (a) anything reachable from its body code
 132 \item   (b) any module exported with a @module Foo@
 133 \item   (c) anything reachable from an exported item
 134 \end{itemize}
 135
 136 Why (b)?  Because if @Foo@ changes then this module's export list
 137 will change, so we must recompile this module at least as far as
 138 making a new interface file --- but in practice that means complete
 139 recompilation.
 140
 141 Why (c)?  Consider this:
 142 \begin{verbatim}
 143         module A( f, g ) where  |       module B( f ) where
 144           import B( f )         |         f = h 3
 145           g = ...               |         h = ...
 146 \end{verbatim}
 147
 148 Here, @B.f@ isn't used in A.  Should we nevertheless record @B.f@ in
 149 @A@'s usages?  Our idea is that we aren't going to touch A.hi if it is
 150 *identical* to what it was before.  If anything about @B.f@ changes
 151 than anyone who imports @A@ should be recompiled in case they use
 152 @B.f@ (they'll get an early exit if they don't).  So, if anything
 153 about @B.f@ changes we'd better make sure that something in A.hi
 154 changes, and the convenient way to do that is to record the version
 155 number @B.f@ in A.hi in the usage list.  If B.f changes that'll force a
 156 complete recompiation of A, which is overkill but it's the only way to
 157 write a new, slightly different, A.hi.
 158
 159 But the example is tricker.  Even if @B.f@ doesn't change at all,
 160 @B.h@ may do so, and this change may not be reflected in @f@'s version
 161 number.  But with -O, a module that imports A must be recompiled if
 162 @B.h@ changes!  So A must record a dependency on @B.h@.  So we treat
 163 the occurrence of @B.f@ in the export list *just as if* it were in the
 164 code of A, and thereby haul in all the stuff reachable from it.
 165
 166         *** Conclusion: if A mentions B.f in its export list,
 167             behave just as if A mentioned B.f in its source code,
 168             and slurp in B.f and all its transitive closure ***
 169
 170 [NB: If B was compiled with -O, but A isn't, we should really *still*
 171 haul in all the unfoldings for B, in case the module that imports A *is*
 172 compiled with -O.  I think this is the case.]
 173
 174
 175 \begin{code}
 176 #include "HsVersions.h"
 177
 178 import HsSyn
 179 import Packages         ( isHomeModule, PackageIdH(..) )
 180 import IfaceSyn         ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
 181                           IfaceRule(..), IfaceInst(..), IfaceExtName(..),
 182                           eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool,
 183                           eqMaybeBy, eqListBy, visibleIfConDecls,
 184                           tyThingToIfaceDecl, instanceToIfaceInst, coreRuleToIfaceRule )
 185 import LoadIface        ( readIface, loadInterface )
 186 import BasicTypes       ( Version, initialVersion, bumpVersion )
 187 import TcRnMonad
 188 import TcRnTypes        ( mkModDeps )
 189 import HscTypes         ( ModIface(..),
 190                           ModGuts(..), ModGuts, IfaceExport,
 191                           HscEnv(..), hscEPS, Dependencies(..), FixItem(..),
 192                           ModSummary(..), msHiFilePath,
 193                           mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
 194                           typeEnvElts,
 195                           GenAvailInfo(..), availName,
 196                           ExternalPackageState(..),
 197                           Usage(..), IsBootInterface,
 198                           Deprecs(..), IfaceDeprecs, Deprecations,
 199                           lookupIfaceByModule
 200                         )
 201
 202
 203 import DynFlags         ( GhcMode(..), DynFlags(..), DynFlag(..), dopt )
 204 import StaticFlags      ( opt_HiVersion )
 205 import Name             ( Name, nameModule, nameOccName, nameParent,
 206                           isExternalName, isInternalName, nameParent_maybe, isWiredInName,
 207                           isImplicitName, NamedThing(..) )
 208 import NameEnv
 209 import NameSet
 210 import OccName          ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
 211                           extendOccEnv_C,
 212                           OccSet, emptyOccSet, elemOccSet, occSetElts,
 213                           extendOccSet, extendOccSetList,
 214                           isEmptyOccSet, intersectOccSet, intersectsOccSet,
 215                           occNameFS, isTcOcc )
 216 import Module           ( Module, moduleFS,
 217                           ModLocation(..), mkSysModuleFS, moduleUserString,
 218                           ModuleEnv, emptyModuleEnv, lookupModuleEnv,
 219                           extendModuleEnv_C
 220                         )
 221 import Outputable
 222 import Util             ( createDirectoryHierarchy, directoryOf )
 223 import Util             ( sortLe, seqList )
 224 import Binary           ( getBinFileWithDict )
 225 import BinIface         ( writeBinIface, v_IgnoreHiWay )
 226 import Unique           ( Unique, Uniquable(..) )
 227 import ErrUtils         ( dumpIfSet_dyn, showPass )
 228 import Digraph          ( stronglyConnComp, SCC(..) )
 229 import SrcLoc           ( SrcSpan )
 230 import FiniteMap
 231 import FastString
 232
 233 import DATA_IOREF       ( writeIORef )
 234 import Monad            ( when )
 235 import List             ( insert )
 236 import Maybes           ( orElse, mapCatMaybes, isNothing, isJust,
 237                           fromJust, expectJust, MaybeErr(..) )
 238 \end{code}
 239
 240
 241
 242 %************************************************************************
 243 %*                                                                      *
 244 \subsection{Completing an interface}
 245 %*                                                                      *
 246 %************************************************************************
 247
 248 \begin{code}
 249 mkIface :: HscEnv
 250         -> Maybe ModIface       -- The old interface, if we have it
 251         -> ModGuts              -- The compiled, tidied module
 252         -> IO (ModIface,        -- The new one, complete with decls and versions
 253                Bool)            -- True <=> there was an old Iface, and the new one
 254                                 --          is identical, so no need to write it
 255
 256 mkIface hsc_env maybe_old_iface
 257         guts@ModGuts{ mg_module  = this_mod,
 258                       mg_boot    = is_boot,
 259                       mg_usages  = usages,
 260                       mg_deps    = deps,
 261                       mg_exports = exports,
 262                       mg_rdr_env = rdr_env,
 263                       mg_fix_env = fix_env,
 264                       mg_deprecs = src_deprecs,
 265                       mg_insts   = insts,
 266                       mg_rules   = rules,
 267                       mg_types   = type_env }
 268 -- NB:  notice that mkIface does not look at the bindings
 269 --      only at the TypeEnv.  The previous Tidy phase has
 270 --      put exactly the info into the TypeEnv that we want
 271 --      to expose in the interface
 272
 273   = do  { eps <- hscEPS hsc_env
 274         ; let   { ext_nm_rhs = mkExtNameFn hsc_env eps this_mod
 275                 ; ext_nm_lhs = mkLhsNameFn this_mod
 276
 277                 ; decls  = [ tyThingToIfaceDecl ext_nm_rhs thing
 278                            | thing <- typeEnvElts type_env,
 279                              not (isImplicitName (getName thing)) ]
 280                         -- Don't put implicit Ids and class tycons in the interface file
 281
 282                 ; fixities    = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
 283                 ; deprecs     = mkIfaceDeprec src_deprecs
 284                 ; iface_rules = map (coreRuleToIfaceRule ext_nm_lhs ext_nm_rhs) rules
 285                 ; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts
 286
 287                 ; intermediate_iface = ModIface {
 288                         mi_module   = this_mod,
 289                         mi_package  = HomePackage,
 290                         mi_boot     = is_boot,
 291                         mi_deps     = deps,
 292                         mi_usages   = usages,
 293                         mi_exports  = mkIfaceExports exports,
 294                         mi_insts    = sortLe le_inst iface_insts,
 295                         mi_rules    = sortLe le_rule iface_rules,
 296                         mi_fixities = fixities,
 297                         mi_deprecs  = deprecs,
 298                         mi_globals  = Just rdr_env,
 299
 300                         -- Left out deliberately: filled in by addVersionInfo
 301                         mi_mod_vers  = initialVersion,
 302                         mi_exp_vers  = initialVersion,
 303                         mi_rule_vers = initialVersion,
 304                         mi_orphan    = False,   -- Always set by addVersionInfo, but
 305                                                 -- it's a strict field, so we can't omit it.
 306                         mi_decls     = deliberatelyOmitted "decls",
 307                         mi_ver_fn    = deliberatelyOmitted "ver_fn",
 308
 309                         -- And build the cached values
 310                         mi_dep_fn = mkIfaceDepCache deprecs,
 311                         mi_fix_fn = mkIfaceFixCache fixities }
 312
 313                 -- Add version information
 314                 ; (new_iface, no_change_at_all, pp_diffs, pp_orphs)
 315                         = _scc_ "versioninfo"
 316                          addVersionInfo maybe_old_iface intermediate_iface decls
 317                 }
 318
 319                 -- Debug printing
 320         ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags)
 321                (printDump (fromJust pp_orphs))
 322         ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
 323         ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
 324                         (pprModIface new_iface)
 325
 326         ; return (new_iface, no_change_at_all) }
 327   where
 328      r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
 329      i1 `le_inst` i2 = ifDFun     i1 <= ifDFun     i2
 330
 331      dflags = hsc_dflags hsc_env
 332      deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
 333
 334
 335 -----------------------------
 336 writeIfaceFile :: HscEnv -> ModLocation -> ModIface -> Bool -> IO ()
 337 -- Write the interface file, if necessary
 338 writeIfaceFile hsc_env location new_iface no_change_at_all
 339   | no_change_at_all        = return ()
 340   | ghc_mode == Interactive = return ()
 341   | otherwise
 342   = do  { createDirectoryHierarchy (directoryOf hi_file_path)
 343         ; writeBinIface hi_file_path new_iface }
 344   where
 345      ghc_mode = ghcMode (hsc_dflags hsc_env)
 346      hi_file_path = ml_hi_file location
 347
 348
 349 -----------------------------
 350 mkExtNameFn :: HscEnv -> ExternalPackageState -> Module -> Name -> IfaceExtName
 351 mkExtNameFn hsc_env eps this_mod
 352   = ext_nm
 353   where
 354     dflags = hsc_dflags hsc_env
 355     hpt = hsc_HPT hsc_env
 356     pit = eps_PIT eps
 357
 358     ext_nm name
 359       | mod == this_mod = case nameParent_maybe name of
 360                                 Nothing  -> LocalTop occ
 361                                 Just par -> LocalTopSub occ (nameOccName par)
 362       | isWiredInName name       = ExtPkg  mod occ
 363       | isHomeModule dflags mod  = HomePkg mod occ vers
 364       | otherwise                = ExtPkg  mod occ
 365       where
 366         mod      = nameModule name
 367         occ      = nameOccName name
 368         par_occ  = nameOccName (nameParent name)
 369                 -- The version of the *parent* is the one want
 370         vers     = lookupVersion mod par_occ
 371
 372     lookupVersion :: Module -> OccName -> Version
 373         -- Even though we're looking up a home-package thing, in
 374         -- one-shot mode the imported interfaces may be in the PIT
 375     lookupVersion mod occ
 376       = mi_ver_fn iface occ `orElse`
 377         pprPanic "lookupVers1" (ppr mod <+> ppr occ)
 378       where
 379         iface = lookupIfaceByModule hpt pit mod `orElse`
 380                 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
 381
 382
 383 ---------------------
 384 -- mkLhsNameFn ignores versioning info altogether
 385 -- It is used for the LHS of instance decls and rules, where we
 386 -- there's no point in recording version info
 387 mkLhsNameFn :: Module -> Name -> IfaceExtName
 388 mkLhsNameFn this_mod name
 389   | isInternalName name = pprTrace "mkLhsNameFn: unexpected internal" (ppr name) $
 390                           LocalTop occ  -- Should not happen
 391   | mod == this_mod = LocalTop occ
 392   | otherwise       = ExtPkg mod occ
 393   where
 394     mod = nameModule name
 395     occ = nameOccName name
 396
 397
 398 -----------------------------
 399 -- Compute version numbers for local decls
 400
 401 addVersionInfo :: Maybe ModIface        -- The old interface, read from M.hi
 402                -> ModIface              -- The new interface decls (lacking decls)
 403                -> [IfaceDecl]           -- The new decls
 404                -> (ModIface,
 405                    Bool,                -- True <=> no changes at all; no need to write new Iface
 406                    SDoc,                -- Differences
 407                    Maybe SDoc)          -- Warnings about orphans
 408
 409 addVersionInfo Nothing new_iface new_decls
 410 -- No old interface, so definitely write a new one!
 411   = (new_iface { mi_orphan = anyNothing ifInstOrph (mi_insts new_iface)
 412                           || anyNothing ifRuleOrph (mi_rules new_iface),
 413                  mi_decls  = [(initialVersion, decl) | decl <- new_decls],
 414                  mi_ver_fn = \n -> Just initialVersion },
 415      False,
 416      ptext SLIT("No old interface file"),
 417      pprOrphans orph_insts orph_rules)
 418   where
 419     orph_insts = filter (isNothing . ifInstOrph) (mi_insts new_iface)
 420     orph_rules = filter (isNothing . ifRuleOrph) (mi_rules new_iface)
 421
 422 addVersionInfo (Just old_iface@(ModIface { mi_mod_vers  = old_mod_vers,
 423                                            mi_exp_vers  = old_exp_vers,
 424                                            mi_rule_vers = old_rule_vers,
 425                                            mi_decls     = old_decls,
 426                                            mi_ver_fn    = old_decl_vers,
 427                                            mi_fix_fn    = old_fixities }))
 428                new_iface@(ModIface { mi_fix_fn = new_fixities })
 429                new_decls
 430
 431   | no_change_at_all = (old_iface,   True,  ptext SLIT("Interface file unchanged"), pp_orphs)
 432   | otherwise        = (final_iface, False, vcat [ptext SLIT("Interface file has changed"),
 433                                                   nest 2 pp_diffs], pp_orphs)
 434   where
 435     final_iface = new_iface { mi_mod_vers  = bump_unless no_output_change old_mod_vers,
 436                               mi_exp_vers  = bump_unless no_export_change old_exp_vers,
 437                               mi_rule_vers = bump_unless no_rule_change   old_rule_vers,
 438                               mi_orphan    = not (null new_orph_rules && null new_orph_insts),
 439                               mi_decls     = decls_w_vers,
 440                               mi_ver_fn    = mkIfaceVerCache decls_w_vers }
 441
 442     decls_w_vers = [(add_vers decl, decl) | decl <- new_decls]
 443
 444     -------------------
 445     (old_non_orph_insts, old_orph_insts) = mkOrphMap ifInstOrph (mi_insts old_iface)
 446     (new_non_orph_insts, new_orph_insts) = mkOrphMap ifInstOrph (mi_insts new_iface)
 447     same_insts occ = eqMaybeBy  (eqListBy eqIfInst)
 448                                 (lookupOccEnv old_non_orph_insts occ)
 449                                 (lookupOccEnv new_non_orph_insts occ)
 450
 451     (old_non_orph_rules, old_orph_rules) = mkOrphMap ifRuleOrph (mi_rules old_iface)
 452     (new_non_orph_rules, new_orph_rules) = mkOrphMap ifRuleOrph (mi_rules new_iface)
 453     same_rules occ = eqMaybeBy  (eqListBy eqIfRule)
 454                                 (lookupOccEnv old_non_orph_rules occ)
 455                                 (lookupOccEnv new_non_orph_rules occ)
 456     -------------------
 457     -- Computing what changed
 458     no_output_change = no_decl_change   && no_rule_change &&
 459                        no_export_change && no_deprec_change
 460     no_export_change = mi_exports new_iface == mi_exports old_iface     -- Kept sorted
 461     no_decl_change   = isEmptyOccSet changed_occs
 462     no_rule_change   = not (changedWrt changed_occs (eqListBy eqIfRule old_orph_rules new_orph_rules)
 463                          || changedWrt changed_occs (eqListBy eqIfInst old_orph_insts new_orph_insts))
 464     no_deprec_change = mi_deprecs new_iface == mi_deprecs old_iface
 465
 466         -- If the usages havn't changed either, we don't need to write the interface file
 467     no_other_changes = mi_usages new_iface == mi_usages old_iface &&
 468                        mi_deps new_iface == mi_deps old_iface
 469     no_change_at_all = no_output_change && no_other_changes
 470
 471     pp_diffs = vcat [pp_change no_export_change "Export list"
 472                         (ppr old_exp_vers <+> arrow <+> ppr (mi_exp_vers final_iface)),
 473                      pp_change no_rule_change "Rules"
 474                         (ppr old_rule_vers <+> arrow <+> ppr (mi_rule_vers final_iface)),
 475                      pp_change no_deprec_change "Deprecations" empty,
 476                      pp_change no_other_changes  "Usages" empty,
 477                      pp_decl_diffs]
 478     pp_change True  what info = empty
 479     pp_change False what info = text what <+> ptext SLIT("changed") <+> info
 480
 481     -------------------
 482     old_decl_env = mkOccEnv [(ifName decl, decl) | (_,decl) <- old_decls]
 483     same_fixity n = bool (old_fixities n == new_fixities n)
 484
 485     -------------------
 486     -- Adding version info
 487     new_version     = bumpVersion old_mod_vers
 488     add_vers decl | occ `elemOccSet` changed_occs = new_version
 489                   | otherwise = expectJust "add_vers" (old_decl_vers occ)
 490                                 -- If it's unchanged, there jolly well
 491                   where         -- should be an old version number
 492                     occ = ifName decl
 493
 494     -------------------
 495     changed_occs :: OccSet
 496     changed_occs = computeChangedOccs eq_info
 497
 498     eq_info :: [(OccName, IfaceEq)]
 499     eq_info = map check_eq new_decls
 500     check_eq new_decl | Just old_decl <- lookupOccEnv old_decl_env occ
 501                       = (occ, new_decl `eqIfDecl` old_decl &&&
 502                               eq_indirects new_decl)
 503                       | otherwise {- No corresponding old decl -}
 504                       = (occ, NotEqual)
 505                       where
 506                         occ = ifName new_decl
 507
 508     eq_indirects :: IfaceDecl -> IfaceEq
 509                 -- When seeing if two decls are the same, remember to
 510                 -- check whether any relevant fixity or rules have changed
 511     eq_indirects (IfaceId {ifName = occ}) = eq_ind_occ occ
 512     eq_indirects (IfaceClass {ifName = cls_occ, ifSigs = sigs})
 513         = same_insts cls_occ &&&
 514           eq_ind_occs [op | IfaceClassOp op _ _ <- sigs]
 515     eq_indirects (IfaceData {ifName = tc_occ, ifCons = cons})
 516         = same_insts tc_occ &&& same_fixity tc_occ &&&  -- The TyCon can have a fixity too
 517           eq_ind_occs (map ifConOcc (visibleIfConDecls cons))
 518     eq_indirects other = Equal  -- Synonyms and foreign declarations
 519
 520     eq_ind_occ :: OccName -> IfaceEq    -- For class ops and Ids; check fixity and rules
 521     eq_ind_occ occ = same_fixity occ &&& same_rules occ
 522     eq_ind_occs = foldr ((&&&) . eq_ind_occ) Equal
 523
 524     -------------------
 525     -- Diffs
 526     pp_decl_diffs :: SDoc       -- Nothing => no changes
 527     pp_decl_diffs
 528         | isEmptyOccSet changed_occs = empty
 529         | otherwise
 530         = vcat [ptext SLIT("Changed occs:") <+> ppr (occSetElts changed_occs),
 531                 ptext SLIT("Version change for these decls:"),
 532                 nest 2 (vcat (map show_change new_decls))]
 533
 534     eq_env = mkOccEnv eq_info
 535     show_change new_decl
 536         | not (occ `elemOccSet` changed_occs) = empty
 537         | otherwise
 538         = vcat [ppr occ <+> ppr (old_decl_vers occ) <+> arrow <+> ppr new_version,
 539                 nest 2 why]
 540         where
 541           occ = ifName new_decl
 542           why = case lookupOccEnv eq_env occ of
 543                     Just (EqBut occs) -> sep [ppr occ <> colon, ptext SLIT("Free vars (only) changed:"),
 544                                               nest 2 (braces (fsep (map ppr (occSetElts
 545                                                 (occs `intersectOccSet` changed_occs)))))]
 546                     Just NotEqual
 547                         | Just old_decl <- lookupOccEnv old_decl_env occ
 548                         -> vcat [ptext SLIT("Old:") <+> ppr old_decl,
 549                          ptext SLIT("New:") <+> ppr new_decl]
 550                         | otherwise
 551                         -> ppr occ <+> ptext SLIT("only in new interface")
 552                     other -> pprPanic "MkIface.show_change" (ppr occ)
 553
 554     pp_orphs = pprOrphans new_orph_insts new_orph_rules
 555
 556 pprOrphans insts rules
 557   | null insts && null rules = Nothing
 558   | otherwise
 559   = Just $ vcat [
 560         if null insts then empty else
 561              hang (ptext SLIT("Warning: orphan instances:"))
 562                 2 (vcat (map ppr insts)),
 563         if null rules then empty else
 564              hang (ptext SLIT("Warning: orphan rules:"))
 565                 2 (vcat (map ppr rules))
 566     ]
 567
 568 computeChangedOccs :: [(OccName, IfaceEq)] -> OccSet
 569 computeChangedOccs eq_info
 570   = foldl add_changes emptyOccSet (stronglyConnComp edges)
 571   where
 572     edges :: [((OccName,IfaceEq), Unique, [Unique])]
 573     edges = [ (node, getUnique occ, map getUnique occs)
 574             | node@(occ, iface_eq) <- eq_info
 575             , let occs = case iface_eq of
 576                            EqBut occ_set -> occSetElts occ_set
 577                            other -> [] ]
 578
 579     -- Changes in declarations
 580     add_changes :: OccSet -> SCC (OccName, IfaceEq) -> OccSet
 581     add_changes so_far (AcyclicSCC (occ, iface_eq))
 582         | changedWrt so_far iface_eq                            -- This one has changed
 583         = extendOccSet so_far occ
 584     add_changes so_far (CyclicSCC pairs)
 585         | changedWrt so_far (foldr1 (&&&) (map snd pairs))      -- One of this group has changed
 586         = extendOccSetList so_far (map fst pairs)
 587     add_changes so_far other = so_far
 588
 589 changedWrt :: OccSet -> IfaceEq -> Bool
 590 changedWrt so_far Equal        = False
 591 changedWrt so_far NotEqual     = True
 592 changedWrt so_far (EqBut kids) = so_far `intersectsOccSet` kids
 593
 594 ----------------------
 595 -- mkOrphMap partitions instance decls or rules into
 596 --      (a) an OccEnv for ones that are not orphans,
 597 --          mapping the local OccName to a list of its decls
 598 --      (b) a list of orphan decls
 599 mkOrphMap :: (decl -> Maybe OccName)    -- (Just occ) for a non-orphan decl, keyed by occ
 600                                         -- Nothing for an orphan decl
 601           -> [decl]                     -- Sorted into canonical order
 602           -> (OccEnv [decl],            -- Non-orphan decls associated with their key;
 603                                         --      each sublist in canonical order
 604               [decl])                   -- Orphan decls; in canonical order
 605 mkOrphMap get_key decls
 606   = foldl go (emptyOccEnv, []) decls
 607   where
 608     go (non_orphs, orphs) d
 609         | Just occ <- get_key d
 610         = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
 611         | otherwise = (non_orphs, d:orphs)
 612
 613 anyNothing :: (a -> Maybe b) -> [a] -> Bool
 614 anyNothing p []     = False
 615 anyNothing p (x:xs) = isNothing (p x) || anyNothing p xs
 616
 617 ----------------------
 618 mkIfaceDeprec :: Deprecations -> IfaceDeprecs
 619 mkIfaceDeprec NoDeprecs        = NoDeprecs
 620 mkIfaceDeprec (DeprecAll t)    = DeprecAll t
 621 mkIfaceDeprec (DeprecSome env) = DeprecSome (sortLe (<=) (nameEnvElts env))
 622
 623 ----------------------
 624 bump_unless :: Bool -> Version -> Version
 625 bump_unless True  v = v -- True <=> no change
 626 bump_unless False v = bumpVersion v
 627 \end{code}
 628
 629
 630 %*********************************************************
 631 %*                                                      *
 632 \subsection{Keeping track of what we've slurped, and version numbers}
 633 %*                                                      *
 634 %*********************************************************
 635
 636
 637 \begin{code}
 638 mkUsageInfo :: HscEnv
 639             -> ModuleEnv (Module, Maybe Bool, SrcSpan)
 640             -> [(Module, IsBootInterface)]
 641             -> NameSet -> IO [Usage]
 642 mkUsageInfo hsc_env dir_imp_mods dep_mods used_names
 643   = do  { eps <- hscEPS hsc_env
 644         ; let usages = mk_usage_info (eps_PIT eps) hsc_env
 645                                      dir_imp_mods dep_mods used_names
 646         ; usages `seqList`  return usages }
 647          -- seq the list of Usages returned: occasionally these
 648          -- don't get evaluated for a while and we can end up hanging on to
 649          -- the entire collection of Ifaces.
 650
 651 mk_usage_info pit hsc_env dir_imp_mods dep_mods proto_used_names
 652   = mapCatMaybes mkUsage dep_mods
 653         -- ToDo: do we need to sort into canonical order?
 654   where
 655     dflags = hsc_dflags hsc_env
 656     hpt = hsc_HPT hsc_env
 657
 658     used_names = mkNameSet $                    -- Eliminate duplicates
 659                  [ nameParent n                 -- Just record usage on the 'main' names
 660                  | n <- nameSetToList proto_used_names
 661                  , not (isWiredInName n)        -- Don't record usages for wired-in names
 662                  , isExternalName n             -- Ignore internal names
 663                  ]
 664
 665     -- ent_map groups together all the things imported and used
 666     -- from a particular module in this package
 667     ent_map :: ModuleEnv [OccName]
 668     ent_map  = foldNameSet add_mv emptyModuleEnv used_names
 669     add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [occ]
 670                    where
 671                      occ = nameOccName name
 672                      mod = nameModule name
 673                      add_item occs _ = occ:occs
 674
 675     import_all mod = case lookupModuleEnv dir_imp_mods mod of
 676                         Just (_,imp_all,_) -> isNothing imp_all
 677                         Nothing            -> False
 678
 679     -- We want to create a Usage for a home module if
 680     --  a) we used something from; has something in used_names
 681     --  b) we imported all of it, even if we used nothing from it
 682     --          (need to recompile if its export list changes: export_vers)
 683     --  c) is a home-package orphan module (need to recompile if its
 684     --          instance decls change: rules_vers)
 685     mkUsage :: (Module, Bool) -> Maybe Usage
 686     mkUsage (mod_name, _)
 687       |  isNothing maybe_iface  -- We can't depend on it if we didn't
 688       || not (isHomeModule dflags mod)  -- even open the interface!
 689       || (null used_occs
 690           && not all_imported
 691           && not orphan_mod)
 692       = Nothing                 -- Record no usage info
 693
 694       | otherwise
 695       = Just (Usage { usg_name     = mod,
 696                       usg_mod      = mod_vers,
 697                       usg_exports  = export_vers,
 698                       usg_entities = ent_vers,
 699                       usg_rules    = rules_vers })
 700       where
 701         maybe_iface  = lookupIfaceByModule hpt pit mod_name
 702                 -- In one-shot mode, the interfaces for home-package
 703                 -- modules accumulate in the PIT not HPT.  Sigh.
 704
 705         Just iface   = maybe_iface
 706         mod          = mi_module    iface
 707         orphan_mod   = mi_orphan    iface
 708         version_env  = mi_ver_fn    iface
 709         mod_vers     = mi_mod_vers  iface
 710         rules_vers   = mi_rule_vers iface
 711         all_imported = import_all mod
 712         export_vers | all_imported = Just (mi_exp_vers iface)
 713                     | otherwise    = Nothing
 714
 715         -- The sort is to put them into canonical order
 716         used_occs = lookupModuleEnv ent_map mod `orElse` []
 717         ent_vers :: [(OccName,Version)]
 718         ent_vers = [ (occ, version_env occ `orElse` initialVersion)
 719                    | occ <- sortLe (<=) used_occs]
 720 \end{code}
 721
 722 \begin{code}
 723 mkIfaceExports :: NameSet -> [(Module, [GenAvailInfo OccName])]
 724   -- Group by module and sort by occurrence
 725   -- This keeps the list in canonical order
 726 mkIfaceExports exports
 727   = [ (mkSysModuleFS fs, eltsFM avails)
 728     | (fs, avails) <- fmToList groupFM
 729     ]
 730   where
 731     groupFM :: FiniteMap FastString (FiniteMap FastString (GenAvailInfo OccName))
 732         -- Deliberately use the FastString so we
 733         -- get a canonical ordering
 734     groupFM = foldl add emptyFM (nameSetToList exports)
 735
 736     add env name = addToFM_C add_avail env mod_fs
 737                              (unitFM avail_fs avail)
 738       where
 739         occ    = nameOccName name
 740         mod_fs = moduleFS (nameModule name)
 741         avail | Just p <- nameParent_maybe name = AvailTC (nameOccName p) [occ]
 742               | isTcOcc occ                     = AvailTC occ [occ]
 743               | otherwise                       = Avail occ
 744         avail_fs = occNameFS (availName avail)
 745         add_avail avail_fm _ = addToFM_C add_item avail_fm avail_fs avail
 746
 747         add_item (AvailTC p occs) _ = AvailTC p (List.insert occ occs)
 748         add_item (Avail n)        _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name)
 749 \end{code}
 750
 751
 752 %************************************************************************
 753 %*                                                                      *
 754         Load the old interface file for this module (unless
 755         we have it aleady), and check whether it is up to date
 756
 757 %*                                                                      *
 758 %************************************************************************
 759
 760 \begin{code}
 761 checkOldIface :: HscEnv
 762               -> ModSummary
 763               -> Bool                   -- Source unchanged
 764               -> Maybe ModIface         -- Old interface from compilation manager, if any
 765               -> IO (RecompileRequired, Maybe ModIface)
 766
 767 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
 768   = do  { showPass (hsc_dflags hsc_env)
 769                    ("Checking old interface for " ++ moduleUserString (ms_mod mod_summary)) ;
 770
 771         ; initIfaceCheck hsc_env $
 772           check_old_iface mod_summary source_unchanged maybe_iface
 773      }
 774
 775 check_old_iface mod_summary source_unchanged maybe_iface
 776  =      -- CHECK WHETHER THE SOURCE HAS CHANGED
 777     ifM (not source_unchanged)
 778         (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
 779                                                 `thenM_`
 780
 781      -- If the source has changed and we're in interactive mode, avoid reading
 782      -- an interface; just return the one we might have been supplied with.
 783     getGhciMode                                 `thenM` \ ghci_mode ->
 784     if (ghci_mode == Interactive) && not source_unchanged then
 785          returnM (outOfDate, maybe_iface)
 786     else
 787
 788     case maybe_iface of {
 789        Just old_iface -> -- Use the one we already have
 790                          checkVersions source_unchanged old_iface       `thenM` \ recomp ->
 791                          returnM (recomp, Just old_iface)
 792
 793     ;  Nothing ->
 794
 795         -- Try and read the old interface for the current module
 796         -- from the .hi file left from the last time we compiled it
 797     let
 798         iface_path = msHiFilePath mod_summary
 799     in
 800     readIface (ms_mod mod_summary) iface_path False     `thenM` \ read_result ->
 801     case read_result of {
 802        Failed err ->    -- Old interface file not found, or garbled; give up
 803                    traceIf (text "FYI: cannot read old interface file:"
 804                                  $$ nest 4 err)         `thenM_`
 805                    returnM (outOfDate, Nothing)
 806
 807     ;  Succeeded iface ->
 808
 809         -- We have got the old iface; check its versions
 810     checkVersions source_unchanged iface        `thenM` \ recomp ->
 811     returnM (recomp, Just iface)
 812     }}
 813 \end{code}
 814
 815 @recompileRequired@ is called from the HscMain.   It checks whether
 816 a recompilation is required.  It needs access to the persistent state,
 817 finder, etc, because it may have to load lots of interface files to
 818 check their versions.
 819
 820 \begin{code}
 821 type RecompileRequired = Bool
 822 upToDate  = False       -- Recompile not required
 823 outOfDate = True        -- Recompile required
 824
 825 checkVersions :: Bool           -- True <=> source unchanged
 826               -> ModIface       -- Old interface
 827               -> IfG RecompileRequired
 828 checkVersions source_unchanged iface
 829   | not source_unchanged
 830   = returnM outOfDate
 831   | otherwise
 832   = do  { traceHiDiffs (text "Considering whether compilation is required for" <+>
 833                         ppr (mi_module iface) <> colon)
 834
 835         -- Source code unchanged and no errors yet... carry on
 836
 837         -- First put the dependent-module info, read from the old interface, into the envt,
 838         -- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
 839         --
 840         -- It's just temporary because either the usage check will succeed
 841         -- (in which case we are done with this module) or it'll fail (in which
 842         -- case we'll compile the module from scratch anyhow).
 843         --
 844         -- We do this regardless of compilation mode
 845         ; updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
 846
 847         ; checkList [checkModUsage u | u <- mi_usages iface]
 848     }
 849   where
 850         -- This is a bit of a hack really
 851     mod_deps :: ModuleEnv (Module, IsBootInterface)
 852     mod_deps = mkModDeps (dep_mods (mi_deps iface))
 853
 854 checkModUsage :: Usage -> IfG RecompileRequired
 855 -- Given the usage information extracted from the old
 856 -- M.hi file for the module being compiled, figure out
 857 -- whether M needs to be recompiled.
 858
 859 checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
 860                        usg_rules = old_rule_vers,
 861                        usg_exports = maybe_old_export_vers,
 862                        usg_entities = old_decl_vers })
 863   =     -- Load the imported interface is possible
 864     let
 865         doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
 866     in
 867     traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_`
 868
 869     loadInterface doc_str mod_name ImportBySystem       `thenM` \ mb_iface ->
 870         -- Load the interface, but don't complain on failure;
 871         -- Instead, get an Either back which we can test
 872
 873     case mb_iface of {
 874         Failed exn ->  (out_of_date (sep [ptext SLIT("Can't find version number for module"),
 875                                        ppr mod_name]));
 876                 -- Couldn't find or parse a module mentioned in the
 877                 -- old interface file.  Don't complain -- it might just be that
 878                 -- the current module doesn't need that import and it's been deleted
 879
 880         Succeeded iface ->
 881     let
 882         new_mod_vers    = mi_mod_vers  iface
 883         new_decl_vers   = mi_ver_fn    iface
 884         new_export_vers = mi_exp_vers  iface
 885         new_rule_vers   = mi_rule_vers iface
 886     in
 887         -- CHECK MODULE
 888     checkModuleVersion old_mod_vers new_mod_vers        `thenM` \ recompile ->
 889     if not recompile then
 890         returnM upToDate
 891     else
 892
 893         -- CHECK EXPORT LIST
 894     if checkExportList maybe_old_export_vers new_export_vers then
 895         out_of_date_vers (ptext SLIT("  Export list changed"))
 896                          (fromJust maybe_old_export_vers)
 897                          new_export_vers
 898     else
 899
 900         -- CHECK RULES
 901     if old_rule_vers /= new_rule_vers then
 902         out_of_date_vers (ptext SLIT("  Rules changed"))
 903                          old_rule_vers new_rule_vers
 904     else
 905
 906         -- CHECK ITEMS ONE BY ONE
 907     checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers]   `thenM` \ recompile ->
 908     if recompile then
 909         returnM outOfDate       -- This one failed, so just bail out now
 910     else
 911         up_to_date (ptext SLIT("  Great!  The bits I use are up to date"))
 912     }
 913
 914 ------------------------
 915 checkModuleVersion old_mod_vers new_mod_vers
 916   | new_mod_vers == old_mod_vers
 917   = up_to_date (ptext SLIT("Module version unchanged"))
 918
 919   | otherwise
 920   = out_of_date_vers (ptext SLIT("  Module version has changed"))
 921                      old_mod_vers new_mod_vers
 922
 923 ------------------------
 924 checkExportList Nothing  new_vers = upToDate
 925 checkExportList (Just v) new_vers = v /= new_vers
 926
 927 ------------------------
 928 checkEntityUsage new_vers (name,old_vers)
 929   = case new_vers name of
 930
 931         Nothing       ->        -- We used it before, but it ain't there now
 932                           out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
 933
 934         Just new_vers   -- It's there, but is it up to date?
 935           | new_vers == old_vers -> traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenM_`
 936                                     returnM upToDate
 937           | otherwise            -> out_of_date_vers (ptext SLIT("  Out of date:") <+> ppr name)
 938                                                      old_vers new_vers
 939
 940 up_to_date  msg = traceHiDiffs msg `thenM_` returnM upToDate
 941 out_of_date msg = traceHiDiffs msg `thenM_` returnM outOfDate
 942 out_of_date_vers msg old_vers new_vers
 943   = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers])
 944
 945 ----------------------
 946 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
 947 -- This helper is used in two places
 948 checkList []             = returnM upToDate
 949 checkList (check:checks) = check        `thenM` \ recompile ->
 950                            if recompile then
 951                                 returnM outOfDate
 952                            else
 953                                 checkList checks
 954 \end{code}
 955
 956 %************************************************************************
 957 %*                                                                      *
 958                 Printing interfaces
 959 %*                                                                      *
 960 %************************************************************************
 961
 962 \begin{code}
 963 showIface :: FilePath -> IO ()
 964 -- Read binary interface, and print it out
 965 showIface filename = do
 966    -- skip the version check; we don't want to worry about profiled vs.
 967    -- non-profiled interfaces, for example.
 968    writeIORef v_IgnoreHiWay True
 969    iface <- Binary.getBinFileWithDict filename
 970    printDump (pprModIface iface)
 971  where
 972 \end{code}
 973
 974
 975 \begin{code}
 976 pprModIface :: ModIface -> SDoc
 977 -- Show a ModIface
 978 pprModIface iface
 979  = vcat [ ptext SLIT("interface")
 980                 <+> ppr_package (mi_package iface)
 981                 <+> ppr (mi_module iface) <+> pp_boot
 982                 <+> ppr (mi_mod_vers iface) <+> pp_sub_vers
 983                 <+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
 984                 <+> int opt_HiVersion
 985                 <+> ptext SLIT("where")
 986         , vcat (map pprExport (mi_exports iface))
 987         , pprDeps (mi_deps iface)
 988         , vcat (map pprUsage (mi_usages iface))
 989         , pprFixities (mi_fixities iface)
 990         , vcat (map pprIfaceDecl (mi_decls iface))
 991         , vcat (map ppr (mi_insts iface))
 992         , vcat (map ppr (mi_rules iface))
 993         , pprDeprecs (mi_deprecs iface)
 994         ]
 995   where
 996     pp_boot | mi_boot iface = ptext SLIT("[boot]")
 997             | otherwise     = empty
 998     ppr_package HomePackage = empty
 999     ppr_package (ExtPackage id) = doubleQuotes (ppr id)
1000
1001     exp_vers  = mi_exp_vers iface
1002     rule_vers = mi_rule_vers iface
1003
1004     pp_sub_vers | exp_vers == initialVersion && rule_vers == initialVersion = empty
1005                 | otherwise = brackets (ppr exp_vers <+> ppr rule_vers)
1006 \end{code}
1007
1008 When printing export lists, we print like this:
1009         Avail   f               f
1010         AvailTC C [C, x, y]     C(x,y)
1011         AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C
1012
1013 \begin{code}
1014 pprExport :: IfaceExport -> SDoc
1015 pprExport (mod, items)
1016  = hsep [ ptext SLIT("export"), ppr mod, hsep (map pp_avail items) ]
1017   where
1018     pp_avail :: GenAvailInfo OccName -> SDoc
1019     pp_avail (Avail occ)    = ppr occ
1020     pp_avail (AvailTC _ []) = empty
1021     pp_avail (AvailTC n (n':ns))
1022         | n==n'     = ppr n <> pp_export ns
1023         | otherwise = ppr n <> char '|' <> pp_export (n':ns)
1024
1025     pp_export []    = empty
1026     pp_export names = braces (hsep (map ppr names))
1027
1028 pprUsage :: Usage -> SDoc
1029 pprUsage usage
1030   = hsep [ptext SLIT("import"), ppr (usg_name usage),
1031           int (usg_mod usage),
1032           pp_export_version (usg_exports usage),
1033           int (usg_rules usage),
1034           pp_versions (usg_entities usage) ]
1035   where
1036     pp_versions nvs = hsep [ ppr n <+> int v | (n,v) <- nvs ]
1037     pp_export_version Nothing  = empty
1038     pp_export_version (Just v) = int v
1039
1040 pprDeps :: Dependencies -> SDoc
1041 pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs})
1042   = vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods),
1043           ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs),
1044           ptext SLIT("orphans:") <+> fsep (map ppr orphs)
1045         ]
1046   where
1047     ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
1048     ppr_boot True  = text "[boot]"
1049     ppr_boot False = empty
1050
1051 pprIfaceDecl :: (Version, IfaceDecl) -> SDoc
1052 pprIfaceDecl (ver, decl)
1053   = ppr_vers ver <+> ppr decl
1054   where
1055         -- Print the version for the decl
1056     ppr_vers v | v == initialVersion = empty
1057                | otherwise           = int v
1058
1059 pprFixities :: [(OccName, Fixity)] -> SDoc
1060 pprFixities []    = empty
1061 pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes
1062                   where
1063                     pprFix (occ,fix) = ppr fix <+> ppr occ
1064
1065 pprDeprecs NoDeprecs        = empty
1066 pprDeprecs (DeprecAll txt)  = ptext SLIT("Deprecate all") <+> doubleQuotes (ftext txt)
1067 pprDeprecs (DeprecSome prs) = ptext SLIT("Deprecate") <+> vcat (map pprDeprec prs)
1068                             where
1069                               pprDeprec (name, txt) = ppr name <+> doubleQuotes (ftext txt)
1070 \end{code}