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