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, isModuleInThisPackage,
  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 = isModuleInThisPackage 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     getSlurped                                  `thenRn` \ source_binders ->
 217     slurpSourceRefs source_binders source_fvs   `thenRn` \ (decls, needed) ->
 218
 219         -- Then get everything else
 220     closeDecls decls needed
 221
 222
 223 -------------------------------------------------------
 224 slurpSourceRefs :: NameSet                      -- Variables defined in source
 225                 -> FreeVars                     -- Variables referenced in source
 226                 -> RnMG ([RenamedHsDecl],
 227                          FreeVars)              -- Un-satisfied needs
 228 -- The declaration (and hence home module) of each gate has
 229 -- already been loaded
 230
 231 slurpSourceRefs source_binders source_fvs
 232   = go_outer []                         -- Accumulating decls
 233              emptyFVs                   -- Unsatisfied needs
 234              emptyFVs                   -- Accumulating gates
 235              (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
 236   where
 237         -- The outer loop repeatedly slurps the decls for the current gates
 238         -- and the instance decls
 239
 240         -- The outer loop is needed because consider
 241
 242     go_outer decls fvs all_gates []
 243         = returnRn (decls, fvs)
 244
 245     go_outer decls fvs all_gates refs   -- refs are not necessarily slurped yet
 246         = traceRn (text "go_outer" <+> ppr refs)                `thenRn_`
 247           foldlRn go_inner (decls, fvs, emptyFVs) refs          `thenRn` \ (decls1, fvs1, gates1) ->
 248           getImportedInstDecls (all_gates `plusFV` gates1)      `thenRn` \ inst_decls ->
 249           rnIfaceInstDecls decls1 fvs1 gates1 inst_decls        `thenRn` \ (decls2, fvs2, gates2) ->
 250           go_outer decls2 fvs2 (all_gates `plusFV` gates2)
 251                                (nameSetToList (gates2 `minusNameSet` all_gates))
 252                 -- Knock out the all_gates because even if we don't slurp any new
 253                 -- decls we can get some apparently-new gates from wired-in names
 254
 255     go_inner (decls, fvs, gates) wanted_name
 256         = importDecl wanted_name                `thenRn` \ import_result ->
 257           case import_result of
 258             AlreadySlurped     -> returnRn (decls, fvs, gates)
 259             InTypeEnv ty_thing -> returnRn (decls, fvs, gates `plusFV` getWiredInGates ty_thing)
 260
 261             HereItIs decl -> rnIfaceTyClDecl decl               `thenRn` \ (new_decl, fvs1) ->
 262                              returnRn (TyClD new_decl : decls,
 263                                        fvs1 `plusFV` fvs,
 264                                        gates `plusFV` getGates source_fvs new_decl)
 265 \end{code}
 266
 267
 268 \begin{code}
 269 -------------------------------------------------------
 270 -- closeDecls keeps going until the free-var set is empty
 271 closeDecls decls needed
 272   | not (isEmptyFVs needed)
 273   = slurpDecls decls needed     `thenRn` \ (decls1, needed1) ->
 274     closeDecls decls1 needed1
 275
 276   | otherwise
 277   = getImportedRules                    `thenRn` \ rule_decls ->
 278     case rule_decls of
 279         []    -> returnRn decls -- No new rules, so we are done
 280         other -> rnIfaceDecls rnIfaceRuleDecl rule_decls        `thenRn` \ rule_decls' ->
 281                  let
 282                         rule_fvs = plusFVs (map ruleDeclFVs rule_decls')
 283                  in
 284                  traceRn (text "closeRules" <+> ppr rule_decls' $$ fsep (map ppr (nameSetToList rule_fvs)))     `thenRn_`
 285                  closeDecls (map RuleD rule_decls' ++ decls) rule_fvs
 286
 287
 288
 289 -------------------------------------------------------
 290 -- Augment decls with any decls needed by needed.
 291 -- Return also free vars of the new decls (only)
 292 slurpDecls decls needed
 293   = go decls emptyFVs (nameSetToList needed)
 294   where
 295     go decls fvs []         = returnRn (decls, fvs)
 296     go decls fvs (ref:refs) = slurpDecl decls fvs ref   `thenRn` \ (decls1, fvs1) ->
 297                               go decls1 fvs1 refs
 298
 299 -------------------------------------------------------
 300 slurpDecl decls fvs wanted_name
 301   = importDecl wanted_name              `thenRn` \ import_result ->
 302     case import_result of
 303         -- Found a declaration... rename it
 304         HereItIs decl -> rnIfaceTyClDecl decl           `thenRn` \ (new_decl, fvs1) ->
 305                          returnRn (TyClD new_decl:decls, fvs1 `plusFV` fvs)
 306
 307         -- No declaration... (wired in thing, or deferred, or already slurped)
 308         other -> returnRn (decls, fvs)
 309
 310
 311 -------------------------------------------------------
 312 rnIfaceDecls rn decls      = mapRn (rnIfaceDecl rn) decls
 313 rnIfaceDecl rn (mod, decl) = initIfaceRnMS mod (rn decl)
 314
 315 rnIfaceInstDecls decls fvs gates inst_decls
 316   = rnIfaceDecls rnInstDecl inst_decls  `thenRn` \ inst_decls' ->
 317     returnRn (map InstD inst_decls' ++ decls,
 318               fvs `plusFV` plusFVs (map instDeclFVs inst_decls'),
 319               gates `plusFV` plusFVs (map getInstDeclGates inst_decls'))
 320
 321 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl)       `thenRn` \ decl' ->
 322                               returnRn (decl', tyClDeclFVs decl')
 323 \end{code}
 324
 325
 326 \begin{code}
 327 getSlurped
 328   = getIfacesRn         `thenRn` \ ifaces ->
 329     returnRn (iSlurp ifaces)
 330
 331 recordSlurp ifaces@(Ifaces { iDecls = (decls_map, n_slurped),
 332                              iSlurp = slurped_names,
 333                              iVSlurp = (imp_mods, imp_names) })
 334             avail
 335   = ASSERT2( not (isLocalName (availName avail)), ppr avail )
 336     ifaces { iDecls = (decls_map', n_slurped+1),
 337              iSlurp  = new_slurped_names,
 338              iVSlurp = new_vslurp }
 339   where
 340     decls_map' = foldl delFromNameEnv decls_map (availNames avail)
 341     main_name  = availName avail
 342     mod        = nameModule main_name
 343     new_slurped_names = addAvailToNameSet slurped_names avail
 344     new_vslurp | isModuleInThisPackage mod = (imp_mods, addOneToNameSet imp_names main_name)
 345                | otherwise                 = (extendModuleSet imp_mods mod, imp_names)
 346
 347 recordLocalSlurps local_avails
 348   = getIfacesRn         `thenRn` \ ifaces ->
 349     let
 350         new_slurped_names = foldl addAvailToNameSet (iSlurp ifaces) local_avails
 351     in
 352     setIfacesRn (ifaces { iSlurp  = new_slurped_names })
 353 \end{code}
 354
 355
 356
 357 %*********************************************************
 358 %*                                                       *
 359 \subsection{Extracting the `gates'}
 360 %*                                                       *
 361 %*********************************************************
 362
 363 The gating story
 364 ~~~~~~~~~~~~~~~~~
 365 We want to avoid sucking in too many instance declarations.
 366 An instance decl is only useful if the types and classes mentioned in
 367 its 'head' are all available in the program being compiled.  E.g.
 368
 369         instance (..) => C (T1 a) (T2 b) where ...
 370
 371 is only useful if C, T1 and T2 are all "available".  So we keep
 372 instance decls that have been parsed from .hi files, but not yet
 373 slurped in, in a pool called the 'gated instance pool'.
 374 Each has its set of 'gates': {C, T1, T2} in the above example.
 375
 376 More precisely, the gates of a module are the types and classes
 377 that are mentioned in:
 378
 379         a) the source code
 380         b) the type of an Id that's mentioned in the source code
 381            [includes constructors and selectors]
 382         c) the RHS of a type synonym that is a gate
 383         d) the superclasses of a class that is a gate
 384         e) the context of an instance decl that is slurped in
 385
 386 We slurp in an instance decl from the gated instance pool iff
 387
 388         all its gates are either in the gates of the module,
 389         or are a previously-loaded class.
 390
 391 The latter constraint is because there might have been an instance
 392 decl slurped in during an earlier compilation, like this:
 393
 394         instance Foo a => Baz (Maybe a) where ...
 395
 396 In the module being compiled we might need (Baz (Maybe T)), where T
 397 is defined in this module, and hence we need (Foo T).  So @Foo@ becomes
 398 a gate.  But there's no way to 'see' that, so we simply treat all
 399 previously-loaded classes as gates.
 400
 401 Consructors and class operations
 402 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 403 When we import a declaration like
 404
 405         data T = T1 Wibble | T2 Wobble
 406
 407 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
 408 @T1@, @T2@ respectively are mentioned by the user program. If only
 409 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
 410 in useless instance decls for (say) @Eq Wibble@, when they can't
 411 possibly be useful.
 412
 413 And that's just what (b) says: we only treat T1's type as a gate if
 414 T1 is mentioned.  getGates, which deals with decls we are slurping in,
 415 has to be a bit careful, because a mention of T1 will slurp in T's whole
 416 declaration.
 417
 418 -----------------------------
 419 @getGates@ takes a newly imported (and renamed) decl, and the free
 420 vars of the source program, and extracts from the decl the gate names.
 421
 422 \begin{code}
 423 getGates :: FreeVars            -- Things mentioned in the source program
 424          -> RenamedTyClDecl
 425          -> FreeVars
 426
 427 getGates source_fvs decl
 428   = get_gates (\n -> n `elemNameSet` source_fvs) decl
 429
 430 get_gates is_used (IfaceSig _ ty _ _)
 431   = extractHsTyNames ty
 432
 433 get_gates is_used (ClassDecl ctxt cls tvs _ sigs _ _ _ )
 434   = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
 435                         (hsTyVarNames tvs)
 436      `addOneToNameSet` cls)
 437     `plusFV` maybe_double
 438   where
 439     get (ClassOpSig n _ ty _)
 440         | is_used n = extractHsTyNames ty
 441         | otherwise = emptyFVs
 442
 443         -- If we load any numeric class that doesn't have
 444         -- Int as an instance, add Double to the gates.
 445         -- This takes account of the fact that Double might be needed for
 446         -- defaulting, but we don't want to load Double (and all its baggage)
 447         -- if the more exotic classes aren't used at all.
 448     maybe_double | nameUnique cls `elem` fractionalClassKeys
 449                  = unitFV (getName doubleTyCon)
 450                  | otherwise
 451                  = emptyFVs
 452
 453 get_gates is_used (TySynonym tycon tvs ty _)
 454   = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
 455         -- A type synonym type constructor isn't a "gate" for instance decls
 456
 457 get_gates is_used (TyData _ ctxt tycon tvs cons _ _ _ _ _)
 458   = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
 459                        (hsTyVarNames tvs)
 460     `addOneToNameSet` tycon
 461   where
 462     get (ConDecl n _ tvs ctxt details _)
 463         | is_used n
 464                 -- If the constructor is method, get fvs from all its fields
 465         = delListFromNameSet (get_details details `plusFV`
 466                               extractHsCtxtTyNames ctxt)
 467                              (hsTyVarNames tvs)
 468     get (ConDecl n _ tvs ctxt (RecCon fields) _)
 469                 -- Even if the constructor isn't mentioned, the fields
 470                 -- might be, as selectors.  They can't mention existentially
 471                 -- bound tyvars (typechecker checks for that) so no need for
 472                 -- the deleteListFromNameSet part
 473         = foldr (plusFV . get_field) emptyFVs fields
 474
 475     get other_con = emptyFVs
 476
 477     get_details (VanillaCon tys) = plusFVs (map get_bang tys)
 478     get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
 479     get_details (RecCon fields)  = plusFVs [get_bang t | (_, t) <- fields]
 480
 481     get_field (fs,t) | any is_used fs = get_bang t
 482                      | otherwise      = emptyFVs
 483
 484     get_bang bty = extractHsTyNames (getBangType bty)
 485 \end{code}
 486
 487 @getWiredInGates@ is just like @getGates@, but it sees a previously-loaded
 488 thing rather than a declaration.
 489
 490 \begin{code}
 491 getWiredInGates :: TyThing -> FreeVars
 492 -- The TyThing is one that we already have in our type environment, either
 493 --      a) because the TyCon or Id is wired in, or
 494 --      b) from a previous compile
 495 -- Either way, we might have instance decls in the (persistent) collection
 496 -- of parsed-but-not-slurped instance decls that should be slurped in.
 497 -- This might be the first module that mentions both the type and the class
 498 -- for that instance decl, even though both the type and the class were
 499 -- mentioned in other modules, and hence are in the type environment
 500
 501 getWiredInGates (AnId the_id) = namesOfType (idType the_id)
 502 getWiredInGates (AClass cl)   = emptyFVs        -- The superclasses must also be previously
 503                                                 -- loaded, and hence are automatically gates
 504 getWiredInGates (ATyCon tc)
 505   | isSynTyCon tc = delListFromNameSet (namesOfType ty) (map getName tyvars)
 506   | otherwise     = unitFV (getName tc)
 507   where
 508     (tyvars,ty)  = getSynTyConDefn tc
 509
 510 getInstDeclGates (InstDecl inst_ty _ _ _ _) = extractHsTyNames inst_ty
 511 \end{code}
 512
 513 \begin{code}
 514 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameInstDecl)]
 515 getImportedInstDecls gates
 516   =     -- First, load any orphan-instance modules that aren't aready loaded
 517         -- Orphan-instance modules are recorded in the module dependecnies
 518     getIfacesRn                                         `thenRn` \ ifaces ->
 519     let
 520         orphan_mods =
 521           [mod | (mod, (True, _)) <- fmToList (iImpModInfo ifaces)]
 522     in
 523     loadOrphanModules orphan_mods                       `thenRn_`
 524
 525         -- Now we're ready to grab the instance declarations
 526         -- Find the un-gated ones and return them,
 527         -- removing them from the bag kept in Ifaces
 528     getIfacesRn                                         `thenRn` \ ifaces ->
 529     getTypeEnvRn                                        `thenRn` \ lookup ->
 530     let
 531         (decls, new_insts) = selectGated gates lookup (iInsts ifaces)
 532     in
 533     setIfacesRn (ifaces { iInsts = new_insts })         `thenRn_`
 534
 535     traceRn (sep [text "getImportedInstDecls:",
 536                   nest 4 (fsep (map ppr gate_list)),
 537                   text "Slurped" <+> int (length decls) <+> text "instance declarations",
 538                   nest 4 (vcat (map ppr_brief_inst_decl decls))])       `thenRn_`
 539     returnRn decls
 540   where
 541     gate_list      = nameSetToList gates
 542
 543 ppr_brief_inst_decl (mod, InstDecl inst_ty _ _ _ _)
 544   = case inst_ty of
 545         HsForAllTy _ _ tau -> ppr tau
 546         other              -> ppr inst_ty
 547
 548 getImportedRules :: RnMG [(Module,RdrNameRuleDecl)]
 549 getImportedRules
 550   | opt_IgnoreIfacePragmas = returnRn []
 551   | otherwise
 552   = getIfacesRn         `thenRn` \ ifaces ->
 553     getTypeEnvRn        `thenRn` \ lookup ->
 554     let
 555         gates              = iSlurp ifaces      -- Anything at all that's been slurped
 556         rules              = iRules ifaces
 557         (decls, new_rules) = selectGated gates lookup rules
 558     in
 559     if null decls then
 560         returnRn []
 561     else
 562     setIfacesRn (ifaces { iRules = new_rules })              `thenRn_`
 563     traceRn (sep [text "getImportedRules:",
 564                   text "Slurped" <+> int (length decls) <+> text "rules"])   `thenRn_`
 565     returnRn decls
 566
 567 selectGated gates lookup (decl_bag, n_slurped)
 568         -- Select only those decls whose gates are *all* in 'gates'
 569         -- or are a class in 'lookup'
 570 #ifdef DEBUG
 571   | opt_NoPruneDecls    -- Just to try the effect of not gating at all
 572   = let
 573         decls = foldrBag (\ (_,d) ds -> d:ds) [] decl_bag       -- Grab them all
 574     in
 575     (decls, (emptyBag, n_slurped + length decls))
 576
 577   | otherwise
 578 #endif
 579   = case foldrBag select ([], emptyBag) decl_bag of
 580         (decls, new_bag) -> (decls, (new_bag, n_slurped + length decls))
 581   where
 582     available n = n `elemNameSet` gates
 583                 || case lookup n of { Just (AClass c) -> True; other -> False }
 584
 585     select (reqd, decl) (yes, no)
 586         | all available reqd = (decl:yes, no)
 587         | otherwise          = (yes,      (reqd,decl) `consBag` no)
 588 \end{code}
 589
 590
 591 %*********************************************************
 592 %*                                                      *
 593 \subsection{Getting in a declaration}
 594 %*                                                      *
 595 %*********************************************************
 596
 597 \begin{code}
 598 importDecl :: Name -> RnMG ImportDeclResult
 599
 600 data ImportDeclResult
 601   = AlreadySlurped
 602   | InTypeEnv TyThing
 603   | HereItIs (Module, RdrNameTyClDecl)
 604
 605 importDecl name
 606   =     -- STEP 1: Check if it was loaded before beginning this module
 607     if isLocalName name then
 608         traceRn (text "Already (local)" <+> ppr name) `thenRn_`
 609         returnRn AlreadySlurped
 610     else
 611
 612         -- STEP 2: Check if we've slurped it in while compiling this module
 613     getIfacesRn                         `thenRn` \ ifaces ->
 614     if name `elemNameSet` iSlurp ifaces then
 615         returnRn AlreadySlurped
 616     else
 617
 618         -- STEP 3: Check if it's already in the type environment
 619     getTypeEnvRn                        `thenRn` \ lookup ->
 620     case lookup name of {
 621         Just ty_thing | name `elemNameEnv` wiredInThingEnv
 622                       ->        -- When we find a wired-in name we must load its home
 623                                 -- module so that we find any instance decls lurking therein
 624                          loadHomeInterface wi_doc name  `thenRn_`
 625                          returnRn (InTypeEnv ty_thing)
 626
 627                       | otherwise
 628                       -> returnRn (InTypeEnv ty_thing) ;
 629
 630         Nothing ->
 631
 632         -- STEP 4: OK, we have to slurp it in from an interface file
 633         --         First load the interface file
 634     traceRn nd_doc                      `thenRn_`
 635     loadHomeInterface nd_doc name       `thenRn_`
 636     getIfacesRn                         `thenRn` \ ifaces ->
 637
 638         -- STEP 5: Get the declaration out
 639     let
 640         (decls_map, _) = iDecls ifaces
 641     in
 642     case lookupNameEnv decls_map name of
 643       Just (avail,_,decl)
 644         -> setIfacesRn (recordSlurp ifaces avail)       `thenRn_`
 645            returnRn (HereItIs decl)
 646
 647       Nothing
 648         -> addErrRn (getDeclErr name)   `thenRn_`
 649            returnRn AlreadySlurped
 650     }
 651   where
 652     wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
 653     nd_doc = ptext SLIT("need decl for") <+> ppr name
 654
 655 \end{code}
 656
 657
 658 %********************************************************
 659 %*                                                      *
 660 \subsection{Checking usage information}
 661 %*                                                      *
 662 %********************************************************
 663
 664 @recompileRequired@ is called from the HscMain.   It checks whether
 665 a recompilation is required.  It needs access to the persistent state,
 666 finder, etc, because it may have to load lots of interface files to
 667 check their versions.
 668
 669 \begin{code}
 670 type RecompileRequired = Bool
 671 upToDate  = False       -- Recompile not required
 672 outOfDate = True        -- Recompile required
 673
 674 recompileRequired :: FilePath           -- Only needed for debug msgs
 675                   -> Bool               -- Source unchanged
 676                   -> ModIface           -- Old interface
 677                   -> RnMG RecompileRequired
 678 recompileRequired iface_path source_unchanged iface
 679   = traceHiDiffsRn (text "Considering whether compilation is required for" <+> text iface_path <> colon)        `thenRn_`
 680
 681         -- CHECK WHETHER THE SOURCE HAS CHANGED
 682     if not source_unchanged then
 683         traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))  `thenRn_`
 684         returnRn outOfDate
 685     else
 686
 687         -- Source code unchanged and no errors yet... carry on
 688     checkList [checkModUsage u | u <- mi_usages iface]
 689
 690 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
 691 checkList []             = returnRn upToDate
 692 checkList (check:checks) = check        `thenRn` \ recompile ->
 693                            if recompile then
 694                                 returnRn outOfDate
 695                            else
 696                                 checkList checks
 697 \end{code}
 698
 699 \begin{code}
 700 checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
 701 -- Given the usage information extracted from the old
 702 -- M.hi file for the module being compiled, figure out
 703 -- whether M needs to be recompiled.
 704
 705 checkModUsage (mod_name, _, _, NothingAtAll)
 706         -- If CurrentModule.hi contains
 707         --      import Foo :: ;
 708         -- then that simply records that Foo lies below CurrentModule in the
 709         -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
 710         -- In this case we don't even want to open Foo's interface.
 711   = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
 712
 713 checkModUsage (mod_name, _, is_boot, whats_imported)
 714   =     -- Load the imported interface is possible
 715         -- We use tryLoadInterface, because failure is not an error
 716         -- (might just be that the old .hi file for this module is out of date)
 717         -- We use ImportByUser/ImportByUserSource as the 'from' flag,
 718         --      a) because we need to know whether to load the .hi-boot file
 719         --      b) because loadInterface things matters are amiss if we
 720         --         ImportBySystem an interface it knows nothing about
 721     let
 722         doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
 723         from    | is_boot   = ImportByUserSource
 724                 | otherwise = ImportByUser
 725     in
 726     tryLoadInterface doc_str mod_name from      `thenRn` \ (iface, maybe_err) ->
 727
 728     case maybe_err of {
 729         Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
 730                                       ppr mod_name]) ;
 731                 -- Couldn't find or parse a module mentioned in the
 732                 -- old interface file.  Don't complain -- it might just be that
 733                 -- the current module doesn't need that import and it's been deleted
 734
 735         Nothing ->
 736     let
 737         new_vers      = mi_version iface
 738         new_decl_vers = vers_decls new_vers
 739     in
 740     case whats_imported of {    -- NothingAtAll dealt with earlier
 741
 742       Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers       `thenRn` \ recompile ->
 743                                  if recompile then
 744                                         out_of_date (ptext SLIT("...and I needed the whole module"))
 745                                  else
 746                                         returnRn upToDate ;
 747
 748       Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
 749
 750         -- CHECK MODULE
 751     checkModuleVersion old_mod_vers new_vers    `thenRn` \ recompile ->
 752     if not recompile then
 753         returnRn upToDate
 754     else
 755
 756         -- CHECK EXPORT LIST
 757     if checkExportList maybe_old_export_vers new_vers then
 758         out_of_date (ptext SLIT("Export list changed"))
 759     else
 760
 761         -- CHECK RULES
 762     if old_rule_vers /= vers_rules new_vers then
 763         out_of_date (ptext SLIT("Rules changed"))
 764     else
 765
 766         -- CHECK ITEMS ONE BY ONE
 767     checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers]   `thenRn` \ recompile ->
 768     if recompile then
 769         returnRn outOfDate      -- This one failed, so just bail out now
 770     else
 771         up_to_date (ptext SLIT("...but the bits I use haven't."))
 772
 773     }}
 774
 775 ------------------------
 776 checkModuleVersion old_mod_vers new_vers
 777   | vers_module new_vers == old_mod_vers
 778   = up_to_date (ptext SLIT("Module version unchanged"))
 779
 780   | otherwise
 781   = out_of_date (ptext SLIT("Module version has changed"))
 782
 783 ------------------------
 784 checkExportList Nothing  new_vers = upToDate
 785 checkExportList (Just v) new_vers = v /= vers_exports new_vers
 786
 787 ------------------------
 788 checkEntityUsage new_vers (name,old_vers)
 789   = case lookupNameEnv new_vers name of
 790
 791         Nothing       ->        -- We used it before, but it ain't there now
 792                           out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
 793
 794         Just new_vers   -- It's there, but is it up to date?
 795           | new_vers == old_vers -> returnRn upToDate
 796           | otherwise            -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
 797
 798 up_to_date  msg = traceHiDiffsRn msg `thenRn_` returnRn upToDate
 799 out_of_date msg = traceHiDiffsRn msg `thenRn_` returnRn outOfDate
 800 \end{code}
 801
 802
 803 %*********************************************************
 804 %*                                                       *
 805 \subsection{Errors}
 806 %*                                                       *
 807 %*********************************************************
 808
 809 \begin{code}
 810 getDeclErr name
 811   = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
 812           ptext SLIT("from module") <+> quotes (ppr (nameModule name))
 813          ]
 814 \end{code}