ghc/compiler/rename/RnIfaces.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
   5
   6 \begin{code}
   7 module RnIfaces
   8      (
   9         recordLocalSlurps,
  10         mkImportInfo,
  11
  12         slurpImpDecls, closeDecls,
  13
  14         RecompileRequired, outOfDate, upToDate, recompileRequired
  15        )
  16 where
  17
  18 #include "HsVersions.h"
  19
  20 import CmdLineOpts      ( opt_IgnoreIfacePragmas, opt_NoPruneDecls )
  21 import HscTypes
  22 import HsSyn            ( HsDecl(..), Sig(..), TyClDecl(..), ConDecl(..), ConDetails(..),
  23                           InstDecl(..), HsType(..), hsTyVarNames, getBangType
  24                         )
  25 import HsImpExp         ( ImportDecl(..) )
  26 import RdrHsSyn         ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl )
  27 import RnHsSyn          ( RenamedHsDecl, RenamedTyClDecl,
  28                           extractHsTyNames, extractHsCtxtTyNames,
  29                           tyClDeclFVs, ruleDeclFVs, instDeclFVs
  30                         )
  31 import RnHiFiles        ( tryLoadInterface, loadHomeInterface,
  32                           loadOrphanModules
  33                         )
  34 import RnSource         ( rnTyClDecl, rnInstDecl, rnIfaceRuleDecl )
  35 import RnEnv
  36 import RnMonad
  37 import Id               ( idType, idName, globalIdDetails )
  38 import IdInfo           ( GlobalIdDetails(..) )
  39 import TcType           ( namesOfType )
  40 import FieldLabel       ( fieldLabelTyCon )
  41 import DataCon          ( dataConTyCon )
  42 import TyCon            ( isSynTyCon, getSynTyConDefn, tyConClass_maybe, tyConName )
  43 import Class            ( className )
  44 import Name             ( Name {-instance NamedThing-}, nameOccName,
  45                           nameModule, isLocalName, NamedThing(..)
  46                          )
  47 import NameEnv          ( elemNameEnv, delFromNameEnv, lookupNameEnv )
  48 import NameSet
  49 import Module           ( Module, ModuleEnv,
  50                           moduleName, isHomeModule,
  51                           ModuleName, WhereFrom(..),
  52                           emptyModuleEnv,
  53                           extendModuleEnv_C, foldModuleEnv, lookupModuleEnv,
  54                           elemModuleSet, extendModuleSet
  55                         )
  56 import PrelInfo         ( wiredInThingEnv, hasKey, fractionalClassKey, numClassKey,
  57                           integerTyConName, doubleTyConName )
  58 import Maybes           ( maybeToBool )
  59 import FiniteMap
  60 import Outputable
  61 import Bag
  62 import Util             ( sortLt )
  63 \end{code}
  64
  65
  66 %*********************************************************
  67 %*                                                      *
  68 \subsection{Keeping track of what we've slurped, and version numbers}
  69 %*                                                      *
  70 %*********************************************************
  71
  72 mkImportInfo figures out what the ``usage information'' for this
  73 moudule is; that is, what it must record in its interface file as the
  74 things it uses.
  75
  76 We produce a line for every module B below the module, A, currently being
  77 compiled:
  78         import B <n> ;
  79 to record the fact that A does import B indirectly.  This is used to decide
  80 to look to look for B.hi rather than B.hi-boot when compiling a module that
  81 imports A.  This line says that A imports B, but uses nothing in it.
  82 So we'll get an early bale-out when compiling A if B's version changes.
  83
  84 The usage information records:
  85
  86 \begin{itemize}
  87 \item   (a) anything reachable from its body code
  88 \item   (b) any module exported with a @module Foo@
  89 \item   (c) anything reachable from an exported item
  90 \end{itemize}
  91
  92 Why (b)?  Because if @Foo@ changes then this module's export list
  93 will change, so we must recompile this module at least as far as
  94 making a new interface file --- but in practice that means complete
  95 recompilation.
  96
  97 Why (c)?  Consider this:
  98 \begin{verbatim}
  99         module A( f, g ) where  |       module B( f ) where
 100           import B( f )         |         f = h 3
 101           g = ...               |         h = ...
 102 \end{verbatim}
 103
 104 Here, @B.f@ isn't used in A.  Should we nevertheless record @B.f@ in
 105 @A@'s usages?  Our idea is that we aren't going to touch A.hi if it is
 106 *identical* to what it was before.  If anything about @B.f@ changes
 107 than anyone who imports @A@ should be recompiled in case they use
 108 @B.f@ (they'll get an early exit if they don't).  So, if anything
 109 about @B.f@ changes we'd better make sure that something in A.hi
 110 changes, and the convenient way to do that is to record the version
 111 number @B.f@ in A.hi in the usage list.  If B.f changes that'll force a
 112 complete recompiation of A, which is overkill but it's the only way to
 113 write a new, slightly different, A.hi.
 114
 115 But the example is tricker.  Even if @B.f@ doesn't change at all,
 116 @B.h@ may do so, and this change may not be reflected in @f@'s version
 117 number.  But with -O, a module that imports A must be recompiled if
 118 @B.h@ changes!  So A must record a dependency on @B.h@.  So we treat
 119 the occurrence of @B.f@ in the export list *just as if* it were in the
 120 code of A, and thereby haul in all the stuff reachable from it.
 121
 122         *** Conclusion: if A mentions B.f in its export list,
 123             behave just as if A mentioned B.f in its source code,
 124             and slurp in B.f and all its transitive closure ***
 125
 126 [NB: If B was compiled with -O, but A isn't, we should really *still*
 127 haul in all the unfoldings for B, in case the module that imports A *is*
 128 compiled with -O.  I think this is the case.]
 129
 130 \begin{code}
 131 mkImportInfo :: ModuleName                      -- Name of this module
 132              -> [ImportDecl n]                  -- The import decls
 133              -> RnMG [ImportVersion Name]
 134
 135 mkImportInfo this_mod imports
 136   = getIfacesRn                                 `thenRn` \ ifaces ->
 137     getHomeIfaceTableRn                         `thenRn` \ hit ->
 138     let
 139         (imp_pkg_mods, imp_home_names) = iVSlurp ifaces
 140         pit                            = iPIT    ifaces
 141
 142         import_all_mods :: [ModuleName]
 143                 -- Modules where we imported all the names
 144                 -- (apart from hiding some, perhaps)
 145         import_all_mods = [ m | ImportDecl m _ _ _ imp_list _ <- imports,
 146                                 import_all imp_list ]
 147                         where
 148                           import_all (Just (False, _)) = False  -- Imports are specified explicitly
 149                           import_all other             = True   -- Everything is imported
 150
 151         -- mv_map groups together all the things imported and used
 152         -- from a particular module in this package
 153         -- We use a finite map because we want the domain
 154         mv_map :: ModuleEnv [Name]
 155         mv_map  = foldNameSet add_mv emptyModuleEnv imp_home_names
 156         add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [name]
 157                            where
 158                              mod = nameModule name
 159                              add_item names _ = name:names
 160
 161         -- In our usage list we record
 162         --      a) Specifically: Detailed version info for imports from modules in this package
 163         --                       Gotten from iVSlurp plus import_all_mods
 164         --
 165         --      b) Everything:   Just the module version for imports from modules in other packages
 166         --                       Gotten from iVSlurp plus import_all_mods
 167         --
 168         --      c) NothingAtAll: The name only of modules, Baz, in this package that are 'below' us,
 169         --                       but which we didn't need at all (this is needed only to decide whether
 170         --                       to open Baz.hi or Baz.hi-boot higher up the tree).
 171         --                       This happens when a module, Foo, that we explicitly imported has
 172         --                       'import Baz' in its interface file, recording that Baz is below
 173         --                       Foo in the module dependency hierarchy.  We want to propagate this info.
 174         --                       These modules are in a combination of HIT/PIT and iImpModInfo
 175         --
 176         --      d) NothingAtAll: The name only of all orphan modules we know of (this is needed
 177         --                       so that anyone who imports us can find the orphan modules)
 178         --                       These modules are in a combination of HIT/PIT and iImpModInfo
 179
 180         import_info0 = foldModuleEnv mk_imp_info  []           pit
 181         import_info1 = foldModuleEnv mk_imp_info  import_info0 hit
 182         import_info  = not_even_opened_imports ++ import_info1
 183
 184                 -- Recall that iImpModInfo describes modules that have been mentioned
 185                 -- in the import lists of interfaces we have opened, but which we have
 186                 -- not even opened when compiling this module
 187         not_even_opened_imports = [ (mod_name, orphans, is_boot, NothingAtAll)
 188                                   | (mod_name, (orphans, is_boot)) <- fmToList (iImpModInfo ifaces) ]
 189
 190
 191         mk_imp_info :: ModIface -> [ImportVersion Name] -> [ImportVersion Name]
 192         mk_imp_info iface so_far
 193
 194           | Just ns <- lookupModuleEnv mv_map mod       -- Case (a)
 195           = go_for_it (Specifically mod_vers maybe_export_vers
 196                                     (mk_import_items ns) rules_vers)
 197
 198           | mod `elemModuleSet` imp_pkg_mods            -- Case (b)
 199           = go_for_it (Everything mod_vers)
 200
 201           | import_all_mod                              -- Case (a) and (b); the import-all part
 202           = if is_home_pkg_mod then
 203                 go_for_it (Specifically mod_vers (Just export_vers) [] rules_vers)
 204                 -- Since the module isn't in the mv_map, presumably we
 205                 -- didn't actually import anything at all from it
 206             else
 207                 go_for_it (Everything mod_vers)
 208
 209           | is_home_pkg_mod || has_orphans              -- Case (c) or (d)
 210           = go_for_it NothingAtAll
 211
 212           | otherwise = so_far
 213           where
 214             go_for_it exports = (mod_name, has_orphans, mi_boot iface, exports) : so_far
 215
 216             mod             = mi_module iface
 217             mod_name        = moduleName mod
 218             is_home_pkg_mod = isHomeModule mod
 219             version_info    = mi_version iface
 220             version_env     = vers_decls   version_info
 221             mod_vers        = vers_module  version_info
 222             rules_vers      = vers_rules   version_info
 223             export_vers     = vers_exports version_info
 224             import_all_mod  = mod_name `elem` import_all_mods
 225             has_orphans     = mi_orphan iface
 226
 227                 -- The sort is to put them into canonical order
 228             mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns,
 229                                           let v = lookupVersion version_env n
 230                                  ]
 231                          where
 232                            lt_occ n1 n2 = nameOccName n1 < nameOccName n2
 233
 234             maybe_export_vers | import_all_mod = Just (vers_exports version_info)
 235                               | otherwise      = Nothing
 236     in
 237     returnRn import_info
 238 \end{code}
 239
 240 %*********************************************************
 241 %*                                                       *
 242 \subsection{Slurping declarations}
 243 %*                                                       *
 244 %*********************************************************
 245
 246 \begin{code}
 247 -------------------------------------------------------
 248 slurpImpDecls source_fvs
 249   = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
 250
 251         -- The current slurped-set records all local things
 252     slurpSourceRefs source_fvs  `thenRn` \ (decls, needed) ->
 253
 254         -- Then get everything else
 255     closeDecls decls needed
 256
 257
 258 -------------------------------------------------------
 259 slurpSourceRefs :: FreeVars                     -- Variables referenced in source
 260                 -> RnMG ([RenamedHsDecl],
 261                          FreeVars)              -- Un-satisfied needs
 262 -- The declaration (and hence home module) of each gate has
 263 -- already been loaded
 264
 265 slurpSourceRefs source_fvs
 266   = go_outer []                         -- Accumulating decls
 267              emptyFVs                   -- Unsatisfied needs
 268              emptyFVs                   -- Accumulating gates
 269              (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
 270   where
 271         -- The outer loop repeatedly slurps the decls for the current gates
 272         -- and the instance decls
 273
 274         -- The outer loop is needed because consider
 275         --      instance Foo a => Baz (Maybe a) where ...
 276         -- It may be that Baz and Maybe are used in the source module,
 277         -- but not Foo; so we need to chase Foo too.
 278         --
 279         -- We also need to follow superclass refs.  In particular, 'chasing Foo' must
 280         -- include actually getting in Foo's class decl
 281         --      class Wib a => Foo a where ..
 282         -- so that its superclasses are discovered.  The point is that Wib is a gate too.
 283         -- We do this for tycons too, so that we look through type synonyms.
 284
 285     go_outer decls fvs all_gates []
 286         = returnRn (decls, fvs)
 287
 288     go_outer decls fvs all_gates refs   -- refs are not necessarily slurped yet
 289         = traceRn (text "go_outer" <+> ppr refs)                `thenRn_`
 290           foldlRn go_inner (decls, fvs, emptyFVs) refs          `thenRn` \ (decls1, fvs1, gates1) ->
 291           getImportedInstDecls (all_gates `plusFV` gates1)      `thenRn` \ inst_decls ->
 292           rnIfaceInstDecls decls1 fvs1 gates1 inst_decls        `thenRn` \ (decls2, fvs2, gates2) ->
 293           go_outer decls2 fvs2 (all_gates `plusFV` gates2)
 294                                (nameSetToList (gates2 `minusNameSet` all_gates))
 295                 -- Knock out the all_gates because even if we don't slurp any new
 296                 -- decls we can get some apparently-new gates from wired-in names
 297                 -- and we get an infinite loop
 298
 299     go_inner (decls, fvs, gates) wanted_name
 300         = importDecl wanted_name                `thenRn` \ import_result ->
 301           case import_result of
 302             AlreadySlurped     -> returnRn (decls, fvs, gates)
 303             InTypeEnv ty_thing -> returnRn (decls, fvs, gates `plusFV` getWiredInGates ty_thing)
 304
 305             HereItIs decl -> rnIfaceTyClDecl decl               `thenRn` \ (new_decl, fvs1) ->
 306                              returnRn (TyClD new_decl : decls,
 307                                        fvs1 `plusFV` fvs,
 308                                        gates `plusFV` getGates source_fvs new_decl)
 309 \end{code}
 310
 311
 312 \begin{code}
 313 -------------------------------------------------------
 314 -- closeDecls keeps going until the free-var set is empty
 315 closeDecls decls needed
 316   | not (isEmptyFVs needed)
 317   = slurpDecls decls needed     `thenRn` \ (decls1, needed1) ->
 318     closeDecls decls1 needed1
 319
 320   | otherwise
 321   = getImportedRules                    `thenRn` \ rule_decls ->
 322     case rule_decls of
 323         []    -> returnRn decls -- No new rules, so we are done
 324         other -> rnIfaceDecls rnIfaceRuleDecl rule_decls        `thenRn` \ rule_decls' ->
 325                  let
 326                         rule_fvs = plusFVs (map ruleDeclFVs rule_decls')
 327                  in
 328                  traceRn (text "closeRules" <+> ppr rule_decls' $$ fsep (map ppr (nameSetToList rule_fvs)))     `thenRn_`
 329                  closeDecls (map RuleD rule_decls' ++ decls) rule_fvs
 330
 331
 332
 333 -------------------------------------------------------
 334 -- Augment decls with any decls needed by needed.
 335 -- Return also free vars of the new decls (only)
 336 slurpDecls decls needed
 337   = go decls emptyFVs (nameSetToList needed)
 338   where
 339     go decls fvs []         = returnRn (decls, fvs)
 340     go decls fvs (ref:refs) = slurpDecl decls fvs ref   `thenRn` \ (decls1, fvs1) ->
 341                               go decls1 fvs1 refs
 342
 343 -------------------------------------------------------
 344 slurpDecl decls fvs wanted_name
 345   = importDecl wanted_name              `thenRn` \ import_result ->
 346     case import_result of
 347         -- Found a declaration... rename it
 348         HereItIs decl -> rnIfaceTyClDecl decl           `thenRn` \ (new_decl, fvs1) ->
 349                          returnRn (TyClD new_decl:decls, fvs1 `plusFV` fvs)
 350
 351         -- No declaration... (wired in thing, or deferred, or already slurped)
 352         other -> returnRn (decls, fvs)
 353
 354
 355 -------------------------------------------------------
 356 rnIfaceDecls rn decls      = mapRn (rnIfaceDecl rn) decls
 357 rnIfaceDecl rn (mod, decl) = initIfaceRnMS mod (rn decl)
 358
 359 rnIfaceInstDecls decls fvs gates inst_decls
 360   = rnIfaceDecls rnInstDecl inst_decls  `thenRn` \ inst_decls' ->
 361     returnRn (map InstD inst_decls' ++ decls,
 362               fvs `plusFV` plusFVs (map instDeclFVs inst_decls'),
 363               gates `plusFV` plusFVs (map getInstDeclGates inst_decls'))
 364
 365 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl)       `thenRn` \ decl' ->
 366                               returnRn (decl', tyClDeclFVs decl')
 367 \end{code}
 368
 369
 370 \begin{code}
 371 recordDeclSlurp ifaces@(Ifaces { iDecls  = (decls_map, n_slurped),
 372                                  iSlurp  = slurped_names,
 373                                  iVSlurp = vslurp })
 374             avail
 375   = ASSERT2( not (isLocalName (availName avail)), ppr avail )
 376     ifaces { iDecls = (new_decls_map, n_slurped+1),
 377              iSlurp  = new_slurped_names,
 378              iVSlurp = updateVSlurp vslurp (availName avail) }
 379   where
 380     new_decls_map     = foldl delFromNameEnv decls_map (availNames avail)
 381     new_slurped_names = addAvailToNameSet slurped_names avail
 382
 383
 384 -- recordTypeEnvSlurp is used when we slurp something that's
 385 -- already in the type environment, that was not slurped in an earlier compilation.
 386 -- We record it in the iVSlurp set, because that's used to
 387 -- generate usage information
 388
 389 recordTypeEnvSlurp ifaces ty_thing
 390   = ifaces { iVSlurp = updateVSlurp (iVSlurp ifaces) (get_main_name ty_thing) }
 391   where
 392         -- Tiresomely, we must get the "main" name for the
 393         -- thing, because that's what VSlurp contains, and what
 394         -- is recorded in the usage information
 395     get_main_name (AClass cl) = className cl
 396     get_main_name (ATyCon tc)
 397         | Just clas <- tyConClass_maybe tc = get_main_name (AClass clas)
 398         | otherwise                        = tyConName tc
 399     get_main_name (AnId id)
 400         = case globalIdDetails id of
 401             DataConId     dc -> get_main_name (ATyCon (dataConTyCon dc))
 402             DataConWrapId dc -> get_main_name (ATyCon (dataConTyCon dc))
 403             RecordSelId lbl  -> get_main_name (ATyCon (fieldLabelTyCon lbl))
 404             other            -> idName id
 405
 406 updateVSlurp (imp_mods, imp_names) main_name
 407   | isHomeModule mod = (imp_mods,                     addOneToNameSet imp_names main_name)
 408   | otherwise        = (extendModuleSet imp_mods mod, imp_names)
 409   where
 410     mod = nameModule main_name
 411
 412 recordLocalSlurps new_names
 413   = getIfacesRn         `thenRn` \ ifaces ->
 414     setIfacesRn (ifaces { iSlurp  = iSlurp ifaces `unionNameSets` new_names })
 415 \end{code}
 416
 417
 418
 419 %*********************************************************
 420 %*                                                       *
 421 \subsection{Extracting the `gates'}
 422 %*                                                       *
 423 %*********************************************************
 424
 425 The gating story
 426 ~~~~~~~~~~~~~~~~~
 427 We want to avoid sucking in too many instance declarations.
 428 An instance decl is only useful if the types and classes mentioned in
 429 its 'head' are all available in the program being compiled.  E.g.
 430
 431         instance (..) => C (T1 a) (T2 b) where ...
 432
 433 is only useful if C, T1 and T2 are all "available".  So we keep
 434 instance decls that have been parsed from .hi files, but not yet
 435 slurped in, in a pool called the 'gated instance pool'.
 436 Each has its set of 'gates': {C, T1, T2} in the above example.
 437
 438 More precisely, the gates of a module are the types and classes
 439 that are mentioned in:
 440
 441         a) the source code
 442         b) the type of an Id that's mentioned in the source code
 443            [includes constructors and selectors]
 444         c) the RHS of a type synonym that is a gate
 445         d) the superclasses of a class that is a gate
 446         e) the context of an instance decl that is slurped in
 447
 448 We slurp in an instance decl from the gated instance pool iff
 449
 450         all its gates are either in the gates of the module,
 451         or are a previously-loaded class.
 452
 453 The latter constraint is because there might have been an instance
 454 decl slurped in during an earlier compilation, like this:
 455
 456         instance Foo a => Baz (Maybe a) where ...
 457
 458 In the module being compiled we might need (Baz (Maybe T)), where T
 459 is defined in this module, and hence we need (Foo T).  So @Foo@ becomes
 460 a gate.  But there's no way to 'see' that, so
 461
 462         we simply treat all previously-loaded classes as gates.
 463
 464 Consructors and class operations
 465 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 466 When we import a declaration like
 467
 468         data T = T1 Wibble | T2 Wobble
 469
 470 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
 471 @T1@, @T2@ respectively are mentioned by the user program. If only
 472 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
 473 in useless instance decls for (say) @Eq Wibble@, when they can't
 474 possibly be useful.
 475
 476 And that's just what (b) says: we only treat T1's type as a gate if
 477 T1 is mentioned.  getGates, which deals with decls we are slurping in,
 478 has to be a bit careful, because a mention of T1 will slurp in T's whole
 479 declaration.
 480
 481 -----------------------------
 482 @getGates@ takes a newly imported (and renamed) decl, and the free
 483 vars of the source program, and extracts from the decl the gate names.
 484
 485 \begin{code}
 486 getGates :: FreeVars            -- Things mentioned in the source program
 487                                 -- Used for the cunning "constructors and
 488                                 -- class ops" story described 10 lines above.
 489          -> RenamedTyClDecl
 490          -> FreeVars
 491
 492 getGates source_fvs decl
 493   = get_gates (\n -> n `elemNameSet` source_fvs) decl
 494
 495 get_gates is_used (ForeignType {tcdName = tycon}) = unitNameSet tycon
 496 get_gates is_used (IfaceSig    {tcdType = ty})    = extractHsTyNames ty
 497
 498 get_gates is_used (ClassDecl { tcdCtxt = ctxt, tcdName = cls, tcdTyVars = tvs, tcdSigs = sigs})
 499   = (super_cls_and_sigs `addOneToNameSet` cls) `unionNameSets`
 500     implicitClassGates cls
 501   where
 502     super_cls_and_sigs = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
 503                                             (hsTyVarNames tvs)
 504     get (ClassOpSig n _ ty _)
 505         | is_used n = extractHsTyNames ty
 506         | otherwise = emptyFVs
 507
 508 get_gates is_used (TySynonym {tcdTyVars = tvs, tcdSynRhs = ty})
 509   = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
 510         -- A type synonym type constructor isn't a "gate" for instance decls
 511
 512 get_gates is_used (TyData {tcdCtxt = ctxt, tcdName = tycon, tcdTyVars = tvs, tcdCons = cons})
 513   = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
 514                        (hsTyVarNames tvs)
 515     `addOneToNameSet` tycon
 516   where
 517     get (ConDecl n _ tvs ctxt details _)
 518         | is_used n
 519                 -- If the constructor is method, get fvs from all its fields
 520         = delListFromNameSet (get_details details `plusFV`
 521                               extractHsCtxtTyNames ctxt)
 522                              (hsTyVarNames tvs)
 523     get (ConDecl n _ tvs ctxt (RecCon fields) _)
 524                 -- Even if the constructor isn't mentioned, the fields
 525                 -- might be, as selectors.  They can't mention existentially
 526                 -- bound tyvars (typechecker checks for that) so no need for
 527                 -- the deleteListFromNameSet part
 528         = foldr (plusFV . get_field) emptyFVs fields
 529
 530     get other_con = emptyFVs
 531
 532     get_details (VanillaCon tys) = plusFVs (map get_bang tys)
 533     get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
 534     get_details (RecCon fields)  = plusFVs [get_bang t | (_, t) <- fields]
 535
 536     get_field (fs,t) | any is_used fs = get_bang t
 537                      | otherwise      = emptyFVs
 538
 539     get_bang bty = extractHsTyNames (getBangType bty)
 540
 541 implicitClassGates :: Name -> FreeVars
 542 implicitClassGates cls
 543         -- If we load class Num, add Integer to the free gates
 544         -- This takes account of the fact that Integer might be needed for
 545         -- defaulting, but we don't want to load Integer (and all its baggage)
 546         -- if there's no numeric stuff needed.
 547         -- Similarly for class Fractional and Double
 548         --
 549         -- NB: adding T to the gates will force T to be loaded
 550         --
 551         -- NB: If we load (say) Floating, we'll end up loading Fractional too,
 552         --     since Fractional is a superclass of Floating
 553   | cls `hasKey` numClassKey        = unitFV integerTyConName
 554   | cls `hasKey` fractionalClassKey = unitFV doubleTyConName
 555   | otherwise                       = emptyFVs
 556 \end{code}
 557
 558 @getWiredInGates@ is just like @getGates@, but it sees a previously-loaded
 559 thing rather than a declaration.
 560
 561 \begin{code}
 562 getWiredInGates :: TyThing -> FreeVars
 563 -- The TyThing is one that we already have in our type environment, either
 564 --      a) because the TyCon or Id is wired in, or
 565 --      b) from a previous compile
 566 -- Either way, we might have instance decls in the (persistent) collection
 567 -- of parsed-but-not-slurped instance decls that should be slurped in.
 568 -- This might be the first module that mentions both the type and the class
 569 -- for that instance decl, even though both the type and the class were
 570 -- mentioned in other modules, and hence are in the type environment
 571
 572 getWiredInGates (AnId the_id) = namesOfType (idType the_id)
 573 getWiredInGates (AClass cl)   = implicitClassGates (getName cl)
 574         -- The superclasses must also be previously
 575         -- loaded, and hence are automatically gates
 576         -- All previously-loaded classes are automatically gates
 577         -- See "The gating story" above
 578 getWiredInGates (ATyCon tc)
 579   | isSynTyCon tc = delListFromNameSet (namesOfType ty) (map getName tyvars)
 580   | otherwise     = unitFV (getName tc)
 581   where
 582     (tyvars,ty)  = getSynTyConDefn tc
 583
 584 getInstDeclGates (InstDecl inst_ty _ _ _ _) = extractHsTyNames inst_ty
 585 \end{code}
 586
 587 \begin{code}
 588 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameInstDecl)]
 589 getImportedInstDecls gates
 590   =     -- First, load any orphan-instance modules that aren't aready loaded
 591         -- Orphan-instance modules are recorded in the module dependecnies
 592     getIfacesRn                                         `thenRn` \ ifaces ->
 593     let
 594         orphan_mods =
 595           [mod | (mod, (True, _)) <- fmToList (iImpModInfo ifaces)]
 596     in
 597     loadOrphanModules orphan_mods                       `thenRn_`
 598
 599         -- Now we're ready to grab the instance declarations
 600         -- Find the un-gated ones and return them,
 601         -- removing them from the bag kept in Ifaces
 602     getIfacesRn                                         `thenRn` \ ifaces ->
 603     getTypeEnvRn                                        `thenRn` \ lookup ->
 604     let
 605         available n
 606           | n `elemNameSet` gates = True
 607           | otherwise             = case lookup n of { Just (AClass c) -> True; other -> False }
 608                 -- See "The gating story" above for the AClass thing
 609
 610         (decls, new_insts) = selectGated available (iInsts ifaces)
 611     in
 612     setIfacesRn (ifaces { iInsts = new_insts })         `thenRn_`
 613
 614     traceRn (sep [text "getImportedInstDecls:",
 615                   nest 4 (fsep (map ppr gate_list)),
 616                   text "Slurped" <+> int (length decls) <+> text "instance declarations",
 617                   nest 4 (vcat (map ppr_brief_inst_decl decls))])       `thenRn_`
 618     returnRn decls
 619   where
 620     gate_list      = nameSetToList gates
 621
 622 ppr_brief_inst_decl (mod, InstDecl inst_ty _ _ _ _)
 623   = case inst_ty of
 624         HsForAllTy _ _ tau -> ppr tau
 625         other              -> ppr inst_ty
 626
 627 getImportedRules :: RnMG [(Module,RdrNameRuleDecl)]
 628 getImportedRules
 629   | opt_IgnoreIfacePragmas = returnRn []
 630   | otherwise
 631   = getIfacesRn         `thenRn` \ ifaces ->
 632     getTypeEnvRn        `thenRn` \ lookup ->
 633     let
 634                 -- Slurp rules for anything that is slurped,
 635                 -- either now or previously
 636         gates              = iSlurp ifaces
 637         available n        = n `elemNameSet` gates || maybeToBool (lookup n)
 638         (decls, new_rules) = selectGated available (iRules ifaces)
 639     in
 640     if null decls then
 641         returnRn []
 642     else
 643     setIfacesRn (ifaces { iRules = new_rules })              `thenRn_`
 644     traceRn (sep [text "getImportedRules:",
 645                   text "Slurped" <+> int (length decls) <+> text "rules"])   `thenRn_`
 646     returnRn decls
 647
 648 selectGated :: (Name->Bool) -> GatedDecls d
 649             -> ([(Module,d)], GatedDecls d)
 650 selectGated available (decl_bag, n_slurped)
 651         -- Select only those decls whose gates are *all* available
 652 #ifdef DEBUG
 653   | opt_NoPruneDecls    -- Just to try the effect of not gating at all
 654   = let
 655         decls = foldrBag (\ (_,d) ds -> d:ds) [] decl_bag       -- Grab them all
 656     in
 657     (decls, (emptyBag, n_slurped + length decls))
 658
 659   | otherwise
 660 #endif
 661   = case foldrBag select ([], emptyBag) decl_bag of
 662         (decls, new_bag) -> (decls, (new_bag, n_slurped + length decls))
 663   where
 664     select (gate_fn, decl) (yes, no)
 665         | gate_fn available  = (decl:yes, no)
 666         | otherwise          = (yes,      (gate_fn,decl) `consBag` no)
 667 \end{code}
 668
 669
 670 %*********************************************************
 671 %*                                                      *
 672 \subsection{Getting in a declaration}
 673 %*                                                      *
 674 %*********************************************************
 675
 676 \begin{code}
 677 importDecl :: Name -> RnMG ImportDeclResult
 678
 679 data ImportDeclResult
 680   = AlreadySlurped
 681   | InTypeEnv TyThing
 682   | HereItIs (Module, RdrNameTyClDecl)
 683
 684 importDecl name
 685   =     -- STEP 1: Check if we've slurped it in while compiling this module
 686     getIfacesRn                         `thenRn` \ ifaces ->
 687     if name `elemNameSet` iSlurp ifaces then
 688         returnRn AlreadySlurped
 689     else
 690
 691
 692         -- STEP 2: Check if it's already in the type environment
 693     getTypeEnvRn                        `thenRn` \ lookup ->
 694     case lookup name of {
 695         Just ty_thing
 696             |   name `elemNameEnv` wiredInThingEnv
 697             ->  -- When we find a wired-in name we must load its home
 698                 -- module so that we find any instance decls lurking therein
 699                 loadHomeInterface wi_doc name   `thenRn_`
 700                 returnRn (InTypeEnv ty_thing)
 701
 702             |   otherwise
 703             ->  -- Very important: record that we've seen it
 704                 -- See comments with recordTypeEnvSlurp
 705                 setIfacesRn (recordTypeEnvSlurp ifaces ty_thing)        `thenRn_`
 706                 returnRn (InTypeEnv ty_thing) ;
 707
 708         Nothing ->
 709
 710         -- STEP 3: OK, we have to slurp it in from an interface file
 711         --         First load the interface file
 712     traceRn nd_doc                      `thenRn_`
 713     loadHomeInterface nd_doc name       `thenRn_`
 714     getIfacesRn                         `thenRn` \ ifaces ->
 715
 716         -- STEP 4: Get the declaration out
 717     let
 718         (decls_map, _) = iDecls ifaces
 719     in
 720     case lookupNameEnv decls_map name of
 721       Just (avail,_,decl) -> setIfacesRn (recordDeclSlurp ifaces avail) `thenRn_`
 722                              returnRn (HereItIs decl)
 723
 724       Nothing -> addErrRn (getDeclErr name)     `thenRn_`
 725                  returnRn AlreadySlurped
 726     }
 727   where
 728     wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
 729     nd_doc = ptext SLIT("need decl for") <+> ppr name
 730
 731 \end{code}
 732
 733
 734 %********************************************************
 735 %*                                                      *
 736 \subsection{Checking usage information}
 737 %*                                                      *
 738 %********************************************************
 739
 740 @recompileRequired@ is called from the HscMain.   It checks whether
 741 a recompilation is required.  It needs access to the persistent state,
 742 finder, etc, because it may have to load lots of interface files to
 743 check their versions.
 744
 745 \begin{code}
 746 type RecompileRequired = Bool
 747 upToDate  = False       -- Recompile not required
 748 outOfDate = True        -- Recompile required
 749
 750 recompileRequired :: FilePath           -- Only needed for debug msgs
 751                   -> ModIface           -- Old interface
 752                   -> RnMG RecompileRequired
 753 recompileRequired iface_path iface
 754   = traceHiDiffsRn (text "Considering whether compilation is required for" <+> text iface_path <> colon)        `thenRn_`
 755
 756         -- Source code unchanged and no errors yet... carry on
 757     checkList [checkModUsage u | u <- mi_usages iface]
 758
 759 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
 760 checkList []             = returnRn upToDate
 761 checkList (check:checks) = check        `thenRn` \ recompile ->
 762                            if recompile then
 763                                 returnRn outOfDate
 764                            else
 765                                 checkList checks
 766 \end{code}
 767
 768 \begin{code}
 769 checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
 770 -- Given the usage information extracted from the old
 771 -- M.hi file for the module being compiled, figure out
 772 -- whether M needs to be recompiled.
 773
 774 checkModUsage (mod_name, _, _, NothingAtAll)
 775         -- If CurrentModule.hi contains
 776         --      import Foo :: ;
 777         -- then that simply records that Foo lies below CurrentModule in the
 778         -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
 779         -- In this case we don't even want to open Foo's interface.
 780   = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
 781
 782 checkModUsage (mod_name, _, is_boot, whats_imported)
 783   =     -- Load the imported interface is possible
 784         -- We use tryLoadInterface, because failure is not an error
 785         -- (might just be that the old .hi file for this module is out of date)
 786         -- We use ImportByUser/ImportByUserSource as the 'from' flag,
 787         --      a) because we need to know whether to load the .hi-boot file
 788         --      b) because loadInterface things matters are amiss if we
 789         --         ImportBySystem an interface it knows nothing about
 790     let
 791         doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
 792         from    | is_boot   = ImportByUserSource
 793                 | otherwise = ImportByUser
 794     in
 795     traceHiDiffsRn (text "Checking usages for module" <+> ppr mod_name) `thenRn_`
 796     tryLoadInterface doc_str mod_name from      `thenRn` \ (iface, maybe_err) ->
 797
 798     case maybe_err of {
 799         Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
 800                                       ppr mod_name]) ;
 801                 -- Couldn't find or parse a module mentioned in the
 802                 -- old interface file.  Don't complain -- it might just be that
 803                 -- the current module doesn't need that import and it's been deleted
 804
 805         Nothing ->
 806     let
 807         new_vers      = mi_version iface
 808         new_decl_vers = vers_decls new_vers
 809     in
 810     case whats_imported of {    -- NothingAtAll dealt with earlier
 811
 812       Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers       `thenRn` \ recompile ->
 813                                  if recompile then
 814                                         out_of_date (ptext SLIT("...and I needed the whole module"))
 815                                  else
 816                                         returnRn upToDate ;
 817
 818       Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
 819
 820         -- CHECK MODULE
 821     checkModuleVersion old_mod_vers new_vers    `thenRn` \ recompile ->
 822     if not recompile then
 823         returnRn upToDate
 824     else
 825
 826         -- CHECK EXPORT LIST
 827     if checkExportList maybe_old_export_vers new_vers then
 828         out_of_date (ptext SLIT("Export list changed"))
 829     else
 830
 831         -- CHECK RULES
 832     if old_rule_vers /= vers_rules new_vers then
 833         out_of_date (ptext SLIT("Rules changed"))
 834     else
 835
 836         -- CHECK ITEMS ONE BY ONE
 837     checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers]   `thenRn` \ recompile ->
 838     if recompile then
 839         returnRn outOfDate      -- This one failed, so just bail out now
 840     else
 841         up_to_date (ptext SLIT("...but the bits I use haven't."))
 842
 843     }}
 844
 845 ------------------------
 846 checkModuleVersion old_mod_vers new_vers
 847   | vers_module new_vers == old_mod_vers
 848   = up_to_date (ptext SLIT("Module version unchanged"))
 849
 850   | otherwise
 851   = out_of_date (ptext SLIT("Module version has changed"))
 852
 853 ------------------------
 854 checkExportList Nothing  new_vers = upToDate
 855 checkExportList (Just v) new_vers = v /= vers_exports new_vers
 856
 857 ------------------------
 858 checkEntityUsage new_vers (name,old_vers)
 859   = case lookupNameEnv new_vers name of
 860
 861         Nothing       ->        -- We used it before, but it ain't there now
 862                           out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
 863
 864         Just new_vers   -- It's there, but is it up to date?
 865           | new_vers == old_vers -> traceHiDiffsRn (text "Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenRn_`
 866                                     returnRn upToDate
 867           | otherwise            -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name, ppr
 868                                                       old_vers, ptext SLIT("->"), ppr new_vers])
 869
 870 up_to_date  msg = traceHiDiffsRn msg `thenRn_` returnRn upToDate
 871 out_of_date msg = traceHiDiffsRn msg `thenRn_` returnRn outOfDate
 872 \end{code}
 873
 874
 875 %*********************************************************
 876 %*                                                       *
 877 \subsection{Errors}
 878 %*                                                       *
 879 %*********************************************************
 880
 881 \begin{code}
 882 getDeclErr name
 883   = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
 884           ptext SLIT("from module") <+> quotes (ppr (nameModule name))
 885          ]
 886 \end{code}