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