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      ( DynFlags, opt_NoPruneDecls, opt_NoPruneTyDecls, 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 source-imported module, don't record the dependency at all
 254         --
 255         -- (b) may seem a bit strange.  The idea is that the usages in a .hi file records
 256         -- *all* the module's dependencies other than the loop-breakers.  We use
 257         -- this info in findAndReadInterface to decide whether to look for a .hi file or
 258         -- a .hi-boot file.
 259         --
 260         -- This means we won't track version changes, or orphans, from .hi-boot files.
 261         -- The former is potentially rather bad news.  It could be fixed by recording
 262         -- whether something is a boot file along with the usage info for it, but
 263         -- I can't be bothered just now.
 264
 265         mk_imp_info mod_name (has_orphans, is_boot, opened) so_far
 266            | mod_name == this_mod       -- Check if M appears in the set of modules 'below' M
 267                                         -- This seems like a convenient place to check
 268            = WARN( not is_boot, ptext SLIT("Wierd:") <+> ppr this_mod <+>
 269                                 ptext SLIT("imports itself (perhaps indirectly)") )
 270              so_far
 271
 272            | not opened                 -- We didn't even open the interface
 273            =            -- This happens when a module, Foo, that we explicitly imported has
 274                         -- 'import Baz' in its interface file, recording that Baz is below
 275                         -- Foo in the module dependency hierarchy.  We want to propagate this
 276                         -- information.  The Nothing says that we didn't even open the interface
 277                         -- file but we must still propagate the dependency info.
 278                         -- The module in question must be a local module (in the same package)
 279              go_for_it NothingAtAll
 280
 281
 282            | is_lib_module && not has_orphans
 283            = so_far
 284
 285            | is_lib_module                      -- Record the module version only
 286            = go_for_it (Everything module_vers)
 287
 288            | otherwise
 289            = go_for_it whats_imported
 290
 291              where
 292                 go_for_it exports = (mod_name, has_orphans, is_boot, exports) : so_far
 293                 mod_iface         = lookupTableByModName hit pit mod_name `orElse` panic "mkImportInfo"
 294                 mod               = mi_module mod_iface
 295                 is_lib_module     = not (isModuleInThisPackage mod)
 296                 version_info      = mi_version mod_iface
 297                 version_env       = vers_decls version_info
 298                 module_vers       = vers_module version_info
 299
 300                 whats_imported = Specifically module_vers
 301                                               export_vers import_items
 302                                               (vers_rules version_info)
 303
 304                 import_items = [(n,v) | n <- lookupWithDefaultModuleEnv mv_map [] mod,
 305                                         let v = lookupNameEnv version_env n `orElse`
 306                                                 pprPanic "mk_whats_imported" (ppr n)
 307                                ]
 308                 export_vers | moduleName mod `elem` import_all_mods
 309                             = Just (vers_exports version_info)
 310                             | otherwise
 311                             = Nothing
 312
 313         import_info = foldFM mk_imp_info [] mod_map
 314     in
 315     traceRn (text "Modules in Ifaces: " <+> fsep (map ppr (keysFM mod_map)))    `thenRn_`
 316     returnRn import_info
 317
 318
 319 addItem :: ModuleEnv [a] -> Module -> a -> ModuleEnv [a]
 320 addItem fm mod x = extendModuleEnv_C add_item fm mod [x]
 321                  where
 322                    add_item xs _ = x:xs
 323 \end{code}
 324
 325 %*********************************************************
 326 %*                                                       *
 327 \subsection{Slurping declarations}
 328 %*                                                       *
 329 %*********************************************************
 330
 331 \begin{code}
 332 -------------------------------------------------------
 333 slurpImpDecls source_fvs
 334   = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
 335
 336         -- The current slurped-set records all local things
 337     getSlurped                                  `thenRn` \ source_binders ->
 338     slurpSourceRefs source_binders source_fvs   `thenRn` \ (decls, needed) ->
 339
 340         -- Then get everything else
 341     closeDecls decls needed                     `thenRn` \ decls1 ->
 342
 343         -- Finally, get any deferred data type decls
 344     slurpDeferredDecls decls1                   `thenRn` \ final_decls ->
 345
 346     returnRn final_decls
 347
 348
 349 -------------------------------------------------------
 350 slurpSourceRefs :: NameSet                      -- Variables defined in source
 351                 -> FreeVars                     -- Variables referenced in source
 352                 -> RnMG ([RenamedHsDecl],
 353                          FreeVars)              -- Un-satisfied needs
 354 -- The declaration (and hence home module) of each gate has
 355 -- already been loaded
 356
 357 slurpSourceRefs source_binders source_fvs
 358   = go_outer []                         -- Accumulating decls
 359              emptyFVs                   -- Unsatisfied needs
 360              emptyFVs                   -- Accumulating gates
 361              (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
 362   where
 363         -- The outer loop repeatedly slurps the decls for the current gates
 364         -- and the instance decls
 365
 366         -- The outer loop is needed because consider
 367         --      instance Foo a => Baz (Maybe a) where ...
 368         -- It may be that @Baz@ and @Maybe@ are used in the source module,
 369         -- but not @Foo@; so we need to chase @Foo@ too.
 370         --
 371         -- We also need to follow superclass refs.  In particular, 'chasing @Foo@' must
 372         -- include actually getting in Foo's class decl
 373         --      class Wib a => Foo a where ..
 374         -- so that its superclasses are discovered.  The point is that Wib is a gate too.
 375         -- We do this for tycons too, so that we look through type synonyms.
 376
 377     go_outer decls fvs all_gates []
 378         = returnRn (decls, fvs)
 379
 380     go_outer decls fvs all_gates refs   -- refs are not necessarily slurped yet
 381         = traceRn (text "go_outer" <+> ppr refs)                `thenRn_`
 382           foldlRn go_inner (decls, fvs, emptyFVs) refs          `thenRn` \ (decls1, fvs1, gates1) ->
 383           getImportedInstDecls (all_gates `plusFV` gates1)      `thenRn` \ inst_decls ->
 384           rnInstDecls decls1 fvs1 gates1 inst_decls             `thenRn` \ (decls2, fvs2, gates2) ->
 385           go_outer decls2 fvs2 (all_gates `plusFV` gates2)
 386                                (nameSetToList (gates2 `minusNameSet` all_gates))
 387                 -- Knock out the all_gates because even if we don't slurp any new
 388                 -- decls we can get some apparently-new gates from wired-in names
 389
 390     go_inner (decls, fvs, gates) wanted_name
 391         = importDecl wanted_name                `thenRn` \ import_result ->
 392           case import_result of
 393             AlreadySlurped -> returnRn (decls, fvs, gates)
 394             WiredIn        -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
 395             Deferred       -> returnRn (decls, fvs, gates `addOneFV` wanted_name)       -- It's a type constructor
 396
 397             HereItIs decl -> rnIfaceTyClDecl decl               `thenRn` \ (new_decl, fvs1) ->
 398                              returnRn (TyClD new_decl : decls,
 399                                        fvs1 `plusFV` fvs,
 400                                        gates `plusFV` getGates source_fvs new_decl)
 401
 402 rnInstDecls decls fvs gates []
 403   = returnRn (decls, fvs, gates)
 404 rnInstDecls decls fvs gates (d:ds)
 405   = rnIfaceDecl d               `thenRn` \ (new_decl, fvs1) ->
 406     rnInstDecls (new_decl:decls)
 407                 (fvs1 `plusFV` fvs)
 408                 (gates `plusFV` getInstDeclGates new_decl)
 409                 ds
 410 \end{code}
 411
 412
 413 \begin{code}
 414 -------------------------------------------------------
 415 -- closeDecls keeps going until the free-var set is empty
 416 closeDecls decls needed
 417   | not (isEmptyFVs needed)
 418   = slurpDecls decls needed     `thenRn` \ (decls1, needed1) ->
 419     closeDecls decls1 needed1
 420
 421   | otherwise
 422   = getImportedRules                    `thenRn` \ rule_decls ->
 423     case rule_decls of
 424         []    -> returnRn decls -- No new rules, so we are done
 425         other -> rnIfaceDecls decls emptyFVs rule_decls         `thenRn` \ (decls1, needed1) ->
 426                  closeDecls decls1 needed1
 427
 428
 429 -------------------------------------------------------
 430 -- Augment decls with any decls needed by needed.
 431 -- Return also free vars of the new decls (only)
 432 slurpDecls decls needed
 433   = go decls emptyFVs (nameSetToList needed)
 434   where
 435     go decls fvs []         = returnRn (decls, fvs)
 436     go decls fvs (ref:refs) = slurpDecl decls fvs ref   `thenRn` \ (decls1, fvs1) ->
 437                               go decls1 fvs1 refs
 438
 439 -------------------------------------------------------
 440 slurpDecl decls fvs wanted_name
 441   = importDecl wanted_name              `thenRn` \ import_result ->
 442     case import_result of
 443         -- Found a declaration... rename it
 444         HereItIs decl -> rnIfaceTyClDecl decl           `thenRn` \ (new_decl, fvs1) ->
 445                          returnRn (TyClD new_decl:decls, fvs1 `plusFV` fvs)
 446
 447         -- No declaration... (wired in thing, or deferred, or already slurped)
 448         other -> returnRn (decls, fvs)
 449
 450
 451 -------------------------------------------------------
 452 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
 453              -> [(Module, RdrNameHsDecl)]
 454              -> RnM d ([RenamedHsDecl], FreeVars)
 455 rnIfaceDecls decls fvs []     = returnRn (decls, fvs)
 456 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d           `thenRn` \ (new_decl, fvs1) ->
 457                                 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
 458
 459 rnIfaceDecl     (mod, decl) = initIfaceRnMS mod (rnDecl decl)
 460 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl)       `thenRn` \ decl' ->
 461                               returnRn (decl', tyClDeclFVs decl')
 462 \end{code}
 463
 464
 465 \begin{code}
 466 getSlurped
 467   = getIfacesRn         `thenRn` \ ifaces ->
 468     returnRn (iSlurp ifaces)
 469
 470 recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = imp_names })
 471             avail
 472   = let
 473         new_slurped_names = addAvailToNameSet slurped_names avail
 474         new_imp_names     = availName avail : imp_names
 475     in
 476     ifaces { iSlurp  = new_slurped_names, iVSlurp = new_imp_names }
 477
 478 recordLocalSlurps local_avails
 479   = getIfacesRn         `thenRn` \ ifaces ->
 480     let
 481         new_slurped_names = foldl addAvailToNameSet (iSlurp ifaces) local_avails
 482     in
 483     setIfacesRn (ifaces { iSlurp  = new_slurped_names })
 484 \end{code}
 485
 486
 487
 488 %*********************************************************
 489 %*                                                       *
 490 \subsection{Deferred declarations}
 491 %*                                                       *
 492 %*********************************************************
 493
 494 The idea of deferred declarations is this.  Suppose we have a function
 495         f :: T -> Int
 496         data T = T1 A | T2 B
 497         data A = A1 X | A2 Y
 498         data B = B1 P | B2 Q
 499 Then we don't want to load T and all its constructors, and all
 500 the types those constructors refer to, and all the types *those*
 501 constructors refer to, and so on.  That might mean loading many more
 502 interface files than is really necessary.  So we 'defer' loading T.
 503
 504 But f might be strict, and the calling convention for evaluating
 505 values of type T depends on how many constructors T has, so
 506 we do need to load T, but not the full details of the type T.
 507 So we load the full decl for T, but only skeleton decls for A and B:
 508         f :: T -> Int
 509         data T = {- 2 constructors -}
 510
 511 Whether all this is worth it is moot.
 512
 513 \begin{code}
 514 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
 515 slurpDeferredDecls decls = returnRn decls
 516
 517 {-      OMIT FOR NOW
 518 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
 519 slurpDeferredDecls decls
 520   = getDeferredDecls                                            `thenRn` \ def_decls ->
 521     rnIfaceDecls decls emptyFVs (map stripDecl def_decls)       `thenRn` \ (decls1, fvs) ->
 522     ASSERT( isEmptyFVs fvs )
 523     returnRn decls1
 524
 525 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ loc name1 name2))
 526   = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing loc
 527                 name1 name2))
 528         -- Nuke the context and constructors
 529         -- But retain the *number* of constructors!
 530         -- Also the tvs will have kinds on them.
 531 -}
 532 \end{code}
 533
 534
 535 %*********************************************************
 536 %*                                                       *
 537 \subsection{Extracting the `gates'}
 538 %*                                                       *
 539 %*********************************************************
 540
 541 When we import a declaration like
 542 \begin{verbatim}
 543         data T = T1 Wibble | T2 Wobble
 544 \end{verbatim}
 545 we don't want to treat @Wibble@ and @Wobble@ as gates
 546 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
 547 If only @T@ is mentioned
 548 we want only @T@ to be a gate;
 549 that way we don't suck in useless instance
 550 decls for (say) @Eq Wibble@, when they can't possibly be useful.
 551
 552 @getGates@ takes a newly imported (and renamed) decl, and the free
 553 vars of the source program, and extracts from the decl the gate names.
 554
 555 \begin{code}
 556 getGates source_fvs (IfaceSig _ ty _ _)
 557   = extractHsTyNames ty
 558
 559 getGates source_fvs (ClassDecl ctxt cls tvs _ sigs _ _ _ )
 560   = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
 561                         (hsTyVarNames tvs)
 562      `addOneToNameSet` cls)
 563     `plusFV` maybe_double
 564   where
 565     get (ClassOpSig n _ ty _)
 566         | n `elemNameSet` source_fvs = extractHsTyNames ty
 567         | otherwise                  = emptyFVs
 568
 569         -- If we load any numeric class that doesn't have
 570         -- Int as an instance, add Double to the gates.
 571         -- This takes account of the fact that Double might be needed for
 572         -- defaulting, but we don't want to load Double (and all its baggage)
 573         -- if the more exotic classes aren't used at all.
 574     maybe_double | nameUnique cls `elem` fractionalClassKeys
 575                  = unitFV (getName doubleTyCon)
 576                  | otherwise
 577                  = emptyFVs
 578
 579 getGates source_fvs (TySynonym tycon tvs ty _)
 580   = delListFromNameSet (extractHsTyNames ty)
 581                        (hsTyVarNames tvs)
 582         -- A type synonym type constructor isn't a "gate" for instance decls
 583
 584 getGates source_fvs (TyData _ ctxt tycon tvs cons _ _ _ _ _)
 585   = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
 586                        (hsTyVarNames tvs)
 587     `addOneToNameSet` tycon
 588   where
 589     get (ConDecl n _ tvs ctxt details _)
 590         | n `elemNameSet` source_fvs
 591                 -- If the constructor is method, get fvs from all its fields
 592         = delListFromNameSet (get_details details `plusFV`
 593                               extractHsCtxtTyNames ctxt)
 594                              (hsTyVarNames tvs)
 595     get (ConDecl n _ tvs ctxt (RecCon fields) _)
 596                 -- Even if the constructor isn't mentioned, the fields
 597                 -- might be, as selectors.  They can't mention existentially
 598                 -- bound tyvars (typechecker checks for that) so no need for
 599                 -- the deleteListFromNameSet part
 600         = foldr (plusFV . get_field) emptyFVs fields
 601
 602     get other_con = emptyFVs
 603
 604     get_details (VanillaCon tys) = plusFVs (map get_bang tys)
 605     get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
 606     get_details (RecCon fields)  = plusFVs [get_bang t | (_, t) <- fields]
 607
 608     get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
 609                      | otherwise                         = emptyFVs
 610
 611     get_bang bty = extractHsTyNames (getBangType bty)
 612 \end{code}
 613
 614 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
 615 rather than a declaration.
 616
 617 \begin{code}
 618 getWiredInGates :: Name -> FreeVars
 619 getWiredInGates name    -- No classes are wired in
 620   = case lookupNameEnv wiredInThingEnv name of
 621         Just (AnId the_id) -> getWiredInGates_s (namesOfType (idType the_id))
 622
 623         Just (ATyCon tc)
 624           |  isSynTyCon tc
 625           -> getWiredInGates_s (delListFromNameSet (namesOfType ty) (map getName tyvars))
 626           where
 627              (tyvars,ty)  = getSynTyConDefn tc
 628
 629         other -> unitFV name
 630
 631 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
 632 \end{code}
 633
 634 \begin{code}
 635 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
 636 getInstDeclGates other                              = emptyFVs
 637 \end{code}
 638
 639
 640 %*********************************************************
 641 %*                                                      *
 642 \subsection{Getting in a declaration}
 643 %*                                                      *
 644 %*********************************************************
 645
 646 \begin{code}
 647 importDecl :: Name -> RnMG ImportDeclResult
 648
 649 data ImportDeclResult
 650   = AlreadySlurped
 651   | WiredIn
 652   | Deferred
 653   | HereItIs (Module, RdrNameTyClDecl)
 654
 655 importDecl name
 656   =     -- Check if it was loaded before beginning this module
 657     checkAlreadyAvailable name          `thenRn` \ done ->
 658     if done then
 659         returnRn AlreadySlurped
 660     else
 661
 662         -- Check if we slurped it in while compiling this module
 663     getIfacesRn                         `thenRn` \ ifaces ->
 664     if name `elemNameSet` iSlurp ifaces then
 665         returnRn AlreadySlurped
 666     else
 667
 668         -- Don't slurp in decls from this module's own interface file
 669         -- (Indeed, this shouldn't happen.)
 670     if isLocallyDefined name then
 671         addWarnRn (importDeclWarn name) `thenRn_`
 672         returnRn AlreadySlurped
 673     else
 674
 675         -- When we find a wired-in name we must load its home
 676         -- module so that we find any instance decls lurking therein
 677     if name `elemNameEnv` wiredInThingEnv then
 678         loadHomeInterface doc name      `thenRn_`
 679         returnRn WiredIn
 680
 681     else getNonWiredInDecl name
 682   where
 683     doc = ptext SLIT("need home module for wired in thing") <+> ppr name
 684
 685 getNonWiredInDecl :: Name -> RnMG ImportDeclResult
 686 getNonWiredInDecl needed_name
 687   = traceRn doc_str                             `thenRn_`
 688     loadHomeInterface doc_str needed_name       `thenRn` \ ifaces ->
 689     case lookupNameEnv (iDecls ifaces) needed_name of
 690
 691 {-              OMIT DEFERRED STUFF FOR NOW, TILL GHCI WORKS
 692       Just (version, avail, is_tycon_name, decl@(_, TyClD (TyData DataType _ _ _ _ ncons _ _ _ _)))
 693         -- This case deals with deferred import of algebraic data types
 694
 695         |  not opt_NoPruneTyDecls
 696
 697         && (opt_IgnoreIfacePragmas || ncons > 1)
 698                 -- We only defer if imported interface pragmas are ingored
 699                 -- or if it's not a product type.
 700                 -- Sole reason: The wrapper for a strict function may need to look
 701                 -- inside its arg, and hence need to see its arg type's constructors.
 702
 703         && not (getUnique tycon_name `elem` cCallishTyKeys)
 704                 -- Never defer ccall types; we have to unbox them,
 705                 -- and importing them does no harm
 706
 707
 708         ->      -- OK, so we're importing a deferrable data type
 709             if needed_name == tycon_name
 710                 -- The needed_name is the TyCon of a data type decl
 711                 -- Record that it's slurped, put it in the deferred set
 712                 -- and don't return a declaration at all
 713                 setIfacesRn (recordSlurp (ifaces {iDeferred = iDeferred ifaces
 714                                                               `addOneToNameSet` tycon_name})
 715                                          version (AvailTC needed_name [needed_name]))   `thenRn_`
 716                 returnRn Deferred
 717
 718             else
 719                 -- The needed name is a constructor of a data type decl,
 720                 -- getting a constructor, so remove the TyCon from the deferred set
 721                 -- (if it's there) and return the full declaration
 722                 setIfacesRn (recordSlurp (ifaces {iDeferred = iDeferred ifaces
 723                                                                `delFromNameSet` tycon_name})
 724                                     version avail)      `thenRn_`
 725                 returnRn (HereItIs decl)
 726         where
 727            tycon_name = availName avail
 728 -}
 729
 730       Just (avail,_,decl)
 731         -> setIfacesRn (recordSlurp ifaces avail)       `thenRn_`
 732            returnRn (HereItIs decl)
 733
 734       Nothing
 735         -> addErrRn (getDeclErr needed_name)    `thenRn_`
 736            returnRn AlreadySlurped
 737   where
 738      doc_str = ptext SLIT("need decl for") <+> ppr needed_name
 739
 740 {-              OMIT FOR NOW
 741 getDeferredDecls :: RnMG [(Module, RdrNameHsDecl)]
 742 getDeferredDecls
 743   = getIfacesRn         `thenRn` \ ifaces ->
 744     let
 745         decls_map           = iDecls ifaces
 746         deferred_names      = nameSetToList (iDeferred ifaces)
 747         get_abstract_decl n = case lookupNameEnv decls_map n of
 748                                  Just (_, _, _, decl) -> decl
 749     in
 750     traceRn (sep [text "getDeferredDecls", nest 4 (fsep (map ppr deferred_names))])     `thenRn_`
 751     returnRn (map get_abstract_decl deferred_names)
 752 -}
 753 \end{code}
 754
 755 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
 756 It behaves exactly as if the wired in decl were actually in an interface file.
 757 Specifically,
 758 \begin{itemize}
 759 \item   if the wired-in name is a data type constructor or a data constructor,
 760         it brings in the type constructor and all the data constructors; and
 761         marks as ``occurrences'' any free vars of the data con.
 762
 763 \item   similarly for synonum type constructor
 764
 765 \item   if the wired-in name is another wired-in Id, it marks as ``occurrences''
 766         the free vars of the Id's type.
 767
 768 \item   it loads the interface file for the wired-in thing for the
 769         sole purpose of making sure that its instance declarations are available
 770 \end{itemize}
 771 All this is necessary so that we know all types that are ``in play'', so
 772 that we know just what instances to bring into scope.
 773
 774
 775 %********************************************************
 776 %*                                                      *
 777 \subsection{Checking usage information}
 778 %*                                                      *
 779 %********************************************************
 780
 781 @recompileRequired@ is called from the HscMain.   It checks whether
 782 a recompilation is required.  It needs access to the persistent state,
 783 finder, etc, because it may have to load lots of interface files to
 784 check their versions.
 785
 786 \begin{code}
 787 type RecompileRequired = Bool
 788 upToDate  = False       -- Recompile not required
 789 outOfDate = True        -- Recompile required
 790
 791 recompileRequired :: Module
 792                   -> Bool               -- Source unchanged
 793                   -> Maybe ModIface     -- Old interface, if any
 794                   -> RnMG RecompileRequired
 795 recompileRequired mod source_unchanged maybe_iface
 796   = traceRn (text "Considering whether compilation is required for" <+> ppr mod <> colon)       `thenRn_`
 797
 798         -- CHECK WHETHER THE SOURCE HAS CHANGED
 799     if not source_unchanged then
 800         traceRn (nest 4 (text "Source file changed or recompilation check turned off")) `thenRn_`
 801         returnRn outOfDate
 802     else
 803
 804         -- CHECK WHETHER WE HAVE AN OLD IFACE
 805     case maybe_iface of
 806         Nothing -> traceRn (nest 4 (ptext SLIT("No old interface file")))       `thenRn_`
 807                    returnRn outOfDate ;
 808
 809         Just iface  ->          -- Source code unchanged and no errors yet... carry on
 810                         checkList [checkModUsage u | u <- mi_usages iface]
 811
 812 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
 813 checkList []             = returnRn upToDate
 814 checkList (check:checks) = check        `thenRn` \ recompile ->
 815                            if recompile then
 816                                 returnRn outOfDate
 817                            else
 818                                 checkList checks
 819 \end{code}
 820
 821 \begin{code}
 822 checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
 823 -- Given the usage information extracted from the old
 824 -- M.hi file for the module being compiled, figure out
 825 -- whether M needs to be recompiled.
 826
 827 checkModUsage (mod_name, _, _, NothingAtAll)
 828         -- If CurrentModule.hi contains
 829         --      import Foo :: ;
 830         -- then that simply records that Foo lies below CurrentModule in the
 831         -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
 832         -- In this case we don't even want to open Foo's interface.
 833   = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
 834
 835 checkModUsage (mod_name, _, _, whats_imported)
 836   = tryLoadInterface doc_str mod_name ImportBySystem    `thenRn` \ (ifaces, maybe_err) ->
 837     case maybe_err of {
 838         Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
 839                                       ppr mod_name]) ;
 840                 -- Couldn't find or parse a module mentioned in the
 841                 -- old interface file.  Don't complain -- it might just be that
 842                 -- the current module doesn't need that import and it's been deleted
 843
 844         Nothing ->
 845
 846     getHomeIfaceTableRn                                 `thenRn` \ hit ->
 847     let
 848         mod_details   = lookupTableByModName hit (iPIT ifaces) mod_name
 849                         `orElse` panic "checkModUsage"
 850         new_vers      = mi_version mod_details
 851         new_decl_vers = vers_decls new_vers
 852     in
 853     case whats_imported of {    -- NothingAtAll dealt with earlier
 854
 855       Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers       `thenRn` \ recompile ->
 856                                  if recompile then
 857                                         out_of_date (ptext SLIT("...and I needed the whole module"))
 858                                  else
 859                                         returnRn upToDate ;
 860
 861       Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
 862
 863         -- CHECK MODULE
 864     checkModuleVersion old_mod_vers new_vers    `thenRn` \ recompile ->
 865     if not recompile then
 866         returnRn upToDate
 867     else
 868
 869         -- CHECK EXPORT LIST
 870     if checkExportList maybe_old_export_vers new_vers then
 871         out_of_date (ptext SLIT("Export list changed"))
 872     else
 873
 874         -- CHECK RULES
 875     if old_rule_vers /= vers_rules new_vers then
 876         out_of_date (ptext SLIT("Rules changed"))
 877     else
 878
 879         -- CHECK ITEMS ONE BY ONE
 880     checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers]   `thenRn` \ recompile ->
 881     if recompile then
 882         returnRn outOfDate      -- This one failed, so just bail out now
 883     else
 884         up_to_date (ptext SLIT("...but the bits I use haven't."))
 885
 886     }}
 887   where
 888     doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
 889
 890 ------------------------
 891 checkModuleVersion old_mod_vers new_vers
 892   | vers_module new_vers == old_mod_vers
 893   = up_to_date (ptext SLIT("Module version unchanged"))
 894
 895   | otherwise
 896   = out_of_date (ptext SLIT("Module version has changed"))
 897
 898 ------------------------
 899 checkExportList Nothing  new_vers = upToDate
 900 checkExportList (Just v) new_vers = v /= vers_exports new_vers
 901
 902 ------------------------
 903 checkEntityUsage new_vers (name,old_vers)
 904   = case lookupNameEnv new_vers name of
 905
 906         Nothing       ->        -- We used it before, but it ain't there now
 907                           out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
 908
 909         Just new_vers   -- It's there, but is it up to date?
 910           | new_vers == old_vers -> returnRn upToDate
 911           | otherwise            -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
 912
 913 up_to_date  msg = traceRn msg `thenRn_` returnRn upToDate
 914 out_of_date msg = traceRn msg `thenRn_` returnRn outOfDate
 915 \end{code}
 916
 917
 918 %*********************************************************
 919 %*                                                       *
 920 \subsection{Errors}
 921 %*                                                       *
 922 %*********************************************************
 923
 924 \begin{code}
 925 getDeclErr name
 926   = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
 927           ptext SLIT("from module") <+> quotes (ppr (nameModule name))
 928          ]
 929
 930 importDeclWarn name
 931   = sep [ptext SLIT(
 932     "Compiler tried to import decl from interface file with same name as module."),
 933          ptext SLIT(
 934     "(possible cause: module name clashes with interface file already in scope.)")
 935         ] $$
 936     hsep [ptext SLIT("name:"), quotes (ppr name)]
 937 \end{code}