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