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