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