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