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