ghc/compiler/rename/RnIfaces.lhs

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