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         getInterfaceExports,
   9         getImportedInstDecls, getImportedRules,
  10         lookupFixity, loadHomeInterface,
  11         importDecl, recordSlurp,
  12         getImportVersions, getSlurped,
  13
  14         checkUpToDate,
  15
  16         getDeclBinders
  17     ) where
  18
  19 #include "HsVersions.h"
  20
  21 import CmdLineOpts      ( opt_NoPruneDecls, opt_IgnoreIfacePragmas )
  22 import HsSyn            ( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..),
  23                           HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
  24                           FixitySig(..), RuleDecl(..),
  25                           isClassOpSig
  26                         )
  27 import BasicTypes       ( Version, NewOrData(..), defaultFixity )
  28 import RdrHsSyn         ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyClDecl, RdrNameRuleDecl,
  29                           extractHsTyRdrNames
  30                         )
  31 import RnEnv            ( mkImportedGlobalName, newImportedBinder, mkImportedGlobalFromRdrName,
  32                           lookupOccRn,
  33                           pprAvail,
  34                           availName, availNames, addAvailToNameSet,
  35                           FreeVars, emptyFVs
  36                         )
  37 import RnMonad
  38 import RnHsSyn          ( RenamedHsDecl )
  39 import ParseIface       ( parseIface, IfaceStuff(..) )
  40
  41 import FiniteMap        ( FiniteMap, sizeFM, emptyFM, delFromFM,
  42                           lookupFM, addToFM, addToFM_C, addListToFM,
  43                           fmToList, elemFM, foldFM
  44                         )
  45 import Name             ( Name {-instance NamedThing-},
  46                           nameModule, isLocallyDefined,
  47                           isWiredInName, nameUnique, NamedThing(..)
  48                          )
  49 import Module           ( Module, moduleString, pprModule,
  50                           mkVanillaModule, pprModuleName,
  51                           moduleUserString, moduleName, isLibModule,
  52                           ModuleName, WhereFrom(..),
  53                         )
  54 import RdrName          ( RdrName, rdrNameOcc )
  55 import NameSet
  56 import Var              ( Id )
  57 import SrcLoc           ( mkSrcLoc, SrcLoc )
  58 import PrelMods         ( pREL_GHC )
  59 import PrelInfo         ( cCallishTyKeys, thinAirModules )
  60 import Bag
  61 import Maybes           ( MaybeErr(..), maybeToBool, orElse )
  62 import ListSetOps       ( unionLists )
  63 import Outputable
  64 import Unique           ( Unique )
  65 import StringBuffer     ( StringBuffer, hGetStringBuffer )
  66 import FastString       ( mkFastString )
  67 import Outputable
  68
  69 import IO       ( isDoesNotExistError )
  70 import List     ( nub )
  71 \end{code}
  72
  73
  74 %*********************************************************
  75 %*                                                      *
  76 \subsection{Loading a new interface file}
  77 %*                                                      *
  78 %*********************************************************
  79
  80 \begin{code}
  81 loadHomeInterface :: SDoc -> Name -> RnM d (Module, Ifaces)
  82 loadHomeInterface doc_str name
  83   = loadInterface doc_str (moduleName (nameModule name)) ImportBySystem
  84
  85 loadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d (Module, Ifaces)
  86 loadInterface doc_str mod_name from
  87  = getIfacesRn                  `thenRn` \ ifaces ->
  88    let
  89         mod_map  = iImpModInfo ifaces
  90         mod_info = lookupFM mod_map mod_name
  91         in_map   = maybeToBool mod_info
  92    in
  93
  94         -- Issue a warning for a redundant {- SOURCE -} import
  95         -- It's redundant if the moduld is in the iImpModInfo at all,
  96         -- because we arrange to read all the ordinary imports before
  97         -- any of the {- SOURCE -} imports
  98    warnCheckRn  (not (in_map && case from of {ImportByUserSource -> True; other -> False}))
  99                 (warnRedundantSourceImport mod_name)    `thenRn_`
 100
 101         -- CHECK WHETHER WE HAVE IT ALREADY
 102    case mod_info of {
 103         Just (_, _, Just (load_mod, _, _))
 104                 ->      -- We're read it already so don't re-read it
 105                     returnRn (load_mod, ifaces) ;
 106
 107         mod_map_result ->
 108
 109         -- READ THE MODULE IN
 110    findAndReadIface doc_str mod_name from in_map        `thenRn` \ (hi_boot_read, read_result) ->
 111    case read_result of {
 112         Nothing ->      -- Not found, so add an empty export env to the Ifaces map
 113                         -- so that we don't look again
 114                    let
 115                         mod         = mkVanillaModule mod_name
 116                         new_mod_map = addToFM mod_map mod_name (0, False, Just (mod, False, []))
 117                         new_ifaces  = ifaces { iImpModInfo = new_mod_map }
 118                    in
 119                    setIfacesRn new_ifaces               `thenRn_`
 120                    failWithRn (mod, new_ifaces) (noIfaceErr mod hi_boot_read) ;
 121
 122         -- Found and parsed!
 123         Just (mod, iface) ->
 124
 125         -- LOAD IT INTO Ifaces
 126
 127         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
 128         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
 129         --     If we do loadExport first the wrong info gets into the cache (unless we
 130         --      explicitly tag each export which seems a bit of a bore)
 131
 132     getModuleRn                 `thenRn` \ this_mod_nm ->
 133     let
 134         rd_decls = pi_decls iface
 135     in
 136     foldlRn (loadDecl mod)           (iDecls ifaces) rd_decls           `thenRn` \ new_decls ->
 137     foldlRn (loadInstDecl mod)       (iInsts ifaces) (pi_insts iface)   `thenRn` \ new_insts ->
 138     foldlRn (loadRule mod)           (iRules ifaces) (pi_rules iface)   `thenRn` \ new_rules ->
 139     foldlRn (loadFixDecl mod_name)   (iFixes ifaces) rd_decls           `thenRn` \ new_fixities ->
 140     mapRn   (loadExport this_mod_nm) (pi_exports iface)                 `thenRn` \ avails_s ->
 141     let
 142         -- For an explicit user import, add to mod_map info about
 143         -- the things the imported module depends on, extracted
 144         -- from its usage info.
 145         mod_map1 = case from of
 146                         ImportByUser -> addModDeps mod mod_map (pi_usages iface)
 147                         other        -> mod_map
 148
 149         -- Now add info about this module
 150         mod_map2    = addToFM mod_map1 mod_name mod_details
 151         mod_details = (pi_mod iface, pi_orphan iface, Just (mod, hi_boot_read, concat avails_s))
 152
 153         new_ifaces = ifaces { iImpModInfo = mod_map2,
 154                               iDecls      = new_decls,
 155                               iFixes      = new_fixities,
 156                               iRules      = new_rules,
 157                               iInsts      = new_insts }
 158     in
 159     setIfacesRn new_ifaces              `thenRn_`
 160     returnRn (mod, new_ifaces)
 161     }}
 162
 163 addModDeps :: Module -> ImportedModuleInfo
 164            -> [ImportVersion a] -> ImportedModuleInfo
 165 addModDeps mod mod_deps new_deps
 166   = foldr add mod_deps new_deps
 167   where
 168     is_lib = isLibModule mod    -- Don't record dependencies when importing a library module
 169     add (imp_mod, version, has_orphans, _) deps
 170         | is_lib && not has_orphans = deps
 171         | otherwise                 = addToFM_C combine deps imp_mod (version, has_orphans, Nothing)
 172         -- Record dependencies for modules that are
 173         --      either are dependent via a non-library module
 174         --      or contain orphan rules or instance decls
 175
 176         -- Don't ditch a module that's already loaded!!
 177     combine old@(_, _, Just _)  new = old
 178     combine old@(_, _, Nothing) new = new
 179
 180 loadExport :: ModuleName -> ExportItem -> RnM d [AvailInfo]
 181 loadExport this_mod (mod, entities)
 182   | mod == this_mod = returnRn []
 183         -- If the module exports anything defined in this module, just ignore it.
 184         -- Reason: otherwise it looks as if there are two local definition sites
 185         -- for the thing, and an error gets reported.  Easiest thing is just to
 186         -- filter them out up front. This situation only arises if a module
 187         -- imports itself, or another module that imported it.  (Necessarily,
 188         -- this invoves a loop.)  Consequence: if you say
 189         --      module A where
 190         --         import B( AType )
 191         --         type AType = ...
 192         --
 193         --      module B( AType ) where
 194         --         import {-# SOURCE #-} A( AType )
 195         --
 196         -- then you'll get a 'B does not export AType' message.  A bit bogus
 197         -- but it's a bogus thing to do!
 198
 199   | otherwise
 200   = mapRn (load_entity mod) entities
 201   where
 202     new_name mod occ = mkImportedGlobalName mod occ
 203
 204     load_entity mod (Avail occ)
 205       = new_name mod occ        `thenRn` \ name ->
 206         returnRn (Avail name)
 207     load_entity mod (AvailTC occ occs)
 208       = new_name mod occ              `thenRn` \ name ->
 209         mapRn (new_name mod) occs     `thenRn` \ names ->
 210         returnRn (AvailTC name names)
 211
 212
 213 loadFixDecl :: ModuleName -> FixityEnv
 214             -> (Version, RdrNameHsDecl)
 215             -> RnM d FixityEnv
 216 loadFixDecl mod_name fixity_env (version, FixD sig@(FixitySig rdr_name fixity loc))
 217   =     -- Ignore the version; when the fixity changes the version of
 218         -- its 'host' entity changes, so we don't need a separate version
 219         -- number for fixities
 220     mkImportedGlobalName mod_name (rdrNameOcc rdr_name)         `thenRn` \ name ->
 221     let
 222         new_fixity_env = addToNameEnv fixity_env name (FixitySig name fixity loc)
 223     in
 224     returnRn new_fixity_env
 225
 226         -- Ignore the other sorts of decl
 227 loadFixDecl mod_name fixity_env other_decl = returnRn fixity_env
 228
 229 loadDecl :: Module
 230          -> DeclsMap
 231          -> (Version, RdrNameHsDecl)
 232          -> RnM d DeclsMap
 233
 234 loadDecl mod decls_map (version, decl)
 235   = getDeclBinders new_name decl        `thenRn` \ maybe_avail ->
 236     case maybe_avail of {
 237         Nothing -> returnRn decls_map;  -- No bindings
 238         Just avail ->
 239
 240     getDeclSysBinders new_name decl     `thenRn` \ sys_bndrs ->
 241     let
 242         main_name     = availName avail
 243         new_decls_map = foldl add_decl decls_map
 244                                        [ (name, (version, avail, name==main_name, (mod, decl)))
 245                                        | name <- sys_bndrs ++ availNames avail]
 246         add_decl decls_map (name, stuff)
 247           = WARN( name `elemNameEnv` decls_map, ppr name )
 248             addToNameEnv decls_map name stuff
 249     in
 250     returnRn new_decls_map
 251     }
 252   where
 253         -- newImportedBinder puts into the cache the binder with the
 254         -- module information set correctly.  When the decl is later renamed,
 255         -- the binding site will thereby get the correct module.
 256     new_name rdr_name loc = newImportedBinder mod rdr_name
 257
 258     {-
 259       If a signature decl is being loaded, and optIgnoreIfacePragmas is on,
 260       we toss away unfolding information.
 261
 262       Also, if the signature is loaded from a module we're importing from source,
 263       we do the same. This is to avoid situations when compiling a pair of mutually
 264       recursive modules, peering at unfolding info in the interface file of the other,
 265       e.g., you compile A, it looks at B's interface file and may as a result change
 266       its interface file. Hence, B is recompiled, maybe changing its interface file,
 267       which will the unfolding info used in A to become invalid. Simple way out is to
 268       just ignore unfolding info.
 269
 270       [Jan 99: I junked the second test above.  If we're importing from an hi-boot
 271        file there isn't going to *be* any pragma info.  Maybe the above comment
 272        dates from a time where we picked up a .hi file first if it existed?]
 273     -}
 274     decl' = case decl of
 275                SigD (IfaceSig name tp ls loc) | opt_IgnoreIfacePragmas ->  SigD (IfaceSig name tp [] loc)
 276                other                                                   -> decl
 277
 278 loadInstDecl :: Module
 279              -> Bag GatedDecl
 280              -> RdrNameInstDecl
 281              -> RnM d (Bag GatedDecl)
 282 loadInstDecl mod insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
 283   =
 284         -- Find out what type constructors and classes are "gates" for the
 285         -- instance declaration.  If all these "gates" are slurped in then
 286         -- we should slurp the instance decl too.
 287         --
 288         -- We *don't* want to count names in the context part as gates, though.
 289         -- For example:
 290         --              instance Foo a => Baz (T a) where ...
 291         --
 292         -- Here the gates are Baz and T, but *not* Foo.
 293     let
 294         munged_inst_ty = case inst_ty of
 295                                 HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
 296                                 other                 -> inst_ty
 297         free_names = extractHsTyRdrNames munged_inst_ty
 298     in
 299     setModuleRn (moduleName mod) $
 300     mapRn mkImportedGlobalFromRdrName free_names        `thenRn` \ gate_names ->
 301     returnRn ((mkNameSet gate_names, (mod, InstD decl)) `consBag` insts)
 302
 303 loadRule :: Module -> Bag GatedDecl
 304          -> RdrNameRuleDecl -> RnM d (Bag GatedDecl)
 305 -- "Gate" the rule simply by whether the rule variable is
 306 -- needed.  We can refine this later.
 307 loadRule mod rules decl@(IfaceRuleDecl var body src_loc)
 308   = setModuleRn (moduleName mod) $
 309     mkImportedGlobalFromRdrName var             `thenRn` \ var_name ->
 310     returnRn ((unitNameSet var_name, (mod, RuleD decl)) `consBag` rules)
 311 \end{code}
 312
 313
 314 %********************************************************
 315 %*                                                      *
 316 \subsection{Loading usage information}
 317 %*                                                      *
 318 %********************************************************
 319
 320 \begin{code}
 321 checkUpToDate :: ModuleName -> RnMG Bool                -- True <=> no need to recompile
 322 checkUpToDate mod_name
 323   = getIfacesRn                                 `thenRn` \ ifaces ->
 324     findAndReadIface doc_str mod_name
 325                      ImportByUser
 326                      (error "checkUpToDate")    `thenRn` \ (_, read_result) ->
 327
 328         -- CHECK WHETHER WE HAVE IT ALREADY
 329     case read_result of
 330         Nothing ->      -- Old interface file not found, so we'd better bail out
 331                     traceRn (sep [ptext SLIT("Didnt find old iface"),
 332                                   pprModuleName mod_name])      `thenRn_`
 333                     returnRn False
 334
 335         Just (_, iface)
 336                 ->      -- Found it, so now check it
 337                     checkModUsage (pi_usages iface)
 338   where
 339         -- Only look in current directory, with suffix .hi
 340     doc_str = sep [ptext SLIT("need usage info from"), pprModuleName mod_name]
 341
 342 checkModUsage [] = returnRn True                -- Yes!  Everything is up to date!
 343
 344 checkModUsage ((mod_name, old_mod_vers, _, whats_imported) : rest)
 345   = loadInterface doc_str mod_name ImportBySystem       `thenRn` \ (mod, ifaces) ->
 346     let
 347         maybe_mod_vers = case lookupFM (iImpModInfo ifaces) mod_name of
 348                            Just (version, _, Just (_, _, _)) -> Just version
 349                            other                             -> Nothing
 350     in
 351     case maybe_mod_vers of {
 352         Nothing ->      -- If we can't find a version number for the old module then
 353                         -- bail out saying things aren't up to date
 354                 traceRn (sep [ptext SLIT("Can't find version number for module"),
 355                               pprModuleName mod_name])                          `thenRn_`
 356                 returnRn False ;
 357
 358         Just new_mod_vers ->
 359
 360         -- If the module version hasn't changed, just move on
 361     if new_mod_vers == old_mod_vers then
 362         traceRn (sep [ptext SLIT("Module version unchanged:"), pprModuleName mod_name]) `thenRn_`
 363         checkModUsage rest
 364     else
 365     traceRn (sep [ptext SLIT("Module version has changed:"), pprModuleName mod_name])   `thenRn_`
 366
 367         -- Module version changed, so check entities inside
 368
 369         -- If the usage info wants to say "I imported everything from this module"
 370         --     it does so by making whats_imported equal to Everything
 371         -- In that case, we must recompile
 372     case whats_imported of {
 373       Everything -> traceRn (ptext SLIT("...and I needed the whole module"))    `thenRn_`
 374                     returnRn False;                -- Bale out
 375
 376       Specifically old_local_vers ->
 377
 378         -- Non-empty usage list, so check item by item
 379     checkEntityUsage mod_name (iDecls ifaces) old_local_vers    `thenRn` \ up_to_date ->
 380     if up_to_date then
 381         traceRn (ptext SLIT("...but the bits I use haven't."))  `thenRn_`
 382         checkModUsage rest      -- This one's ok, so check the rest
 383     else
 384         returnRn False          -- This one failed, so just bail out now
 385     }}
 386   where
 387     doc_str = sep [ptext SLIT("need version info for"), pprModuleName mod_name]
 388
 389
 390 checkEntityUsage mod decls []
 391   = returnRn True       -- Yes!  All up to date!
 392
 393 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
 394   = mkImportedGlobalName mod occ_name   `thenRn` \ name ->
 395     case lookupNameEnv decls name of
 396
 397         Nothing       ->        -- We used it before, but it ain't there now
 398                           putDocRn (sep [ptext SLIT("No longer exported:"), ppr name])  `thenRn_`
 399                           returnRn False
 400
 401         Just (new_vers,_,_,_)   -- It's there, but is it up to date?
 402                 | new_vers == old_vers
 403                         -- Up to date, so check the rest
 404                 -> checkEntityUsage mod decls rest
 405
 406                 | otherwise
 407                         -- Out of date, so bale out
 408                 -> putDocRn (sep [ptext SLIT("Out of date:"), ppr name])  `thenRn_`
 409                    returnRn False
 410 \end{code}
 411
 412
 413 %*********************************************************
 414 %*                                                      *
 415 \subsection{Getting in a declaration}
 416 %*                                                      *
 417 %*********************************************************
 418
 419 \begin{code}
 420 importDecl :: Name -> RnMG (Maybe (Module, RdrNameHsDecl))
 421         -- Returns Nothing for
 422         --      (a) wired in name
 423         --      (b) local decl
 424         --      (c) already slurped
 425
 426 importDecl name
 427   | isWiredInName name
 428   = returnRn Nothing
 429   | otherwise
 430   = getSlurped                          `thenRn` \ already_slurped ->
 431     if name `elemNameSet` already_slurped then
 432         returnRn Nothing        -- Already dealt with
 433     else
 434         getModuleRn             `thenRn` \ this_mod ->
 435         let
 436           mod = moduleName (nameModule name)
 437         in
 438         if mod == this_mod then         -- Don't bring in decls from
 439                                         -- the renamed module's own interface file
 440                   addWarnRn (importDeclWarn mod name) `thenRn_`
 441                   returnRn Nothing
 442         else
 443         getNonWiredInDecl name
 444 \end{code}
 445
 446 \begin{code}
 447 getNonWiredInDecl :: Name -> RnMG (Maybe (Module, RdrNameHsDecl))
 448 getNonWiredInDecl needed_name
 449   = traceRn doc_str                             `thenRn_`
 450     loadHomeInterface doc_str needed_name       `thenRn` \ (_, ifaces) ->
 451     case lookupNameEnv (iDecls ifaces) needed_name of
 452
 453       Just (version,avail,_,decl)
 454         -> recordSlurp (Just version) avail     `thenRn_`
 455            returnRn (Just decl)
 456
 457       Nothing           -- Can happen legitimately for "Optional" occurrences
 458         -> addErrRn (getDeclErr needed_name)    `thenRn_`
 459            returnRn Nothing
 460   where
 461      doc_str = ptext SLIT("need decl for") <+> ppr needed_name
 462 \end{code}
 463
 464 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
 465 It behaves exactly as if the wired in decl were actually in an interface file.
 466 Specifically,
 467
 468   *     if the wired-in name is a data type constructor or a data constructor,
 469         it brings in the type constructor and all the data constructors; and
 470         marks as "occurrences" any free vars of the data con.
 471
 472   *     similarly for synonum type constructor
 473
 474   *     if the wired-in name is another wired-in Id, it marks as "occurrences"
 475         the free vars of the Id's type.
 476
 477   *     it loads the interface file for the wired-in thing for the
 478         sole purpose of making sure that its instance declarations are available
 479
 480 All this is necessary so that we know all types that are "in play", so
 481 that we know just what instances to bring into scope.
 482
 483
 484
 485
 486 %*********************************************************
 487 %*                                                      *
 488 \subsection{Getting what a module exports}
 489 %*                                                      *
 490 %*********************************************************
 491
 492 @getInterfaceExports@ is called only for directly-imported modules
 493
 494 \begin{code}
 495 getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, Avails)
 496 getInterfaceExports mod_name from
 497   = loadInterface doc_str mod_name from `thenRn` \ (mod, ifaces) ->
 498     case lookupFM (iImpModInfo ifaces) mod_name of
 499         Nothing ->      -- Not there; it must be that the interface file wasn't found;
 500                         -- the error will have been reported already.
 501                         -- (Actually loadInterface should put the empty export env in there
 502                         --  anyway, but this does no harm.)
 503                       returnRn (mod, [])
 504
 505         Just (_, _, Just (mod, _, avails)) -> returnRn (mod, avails)
 506   where
 507     doc_str = sep [pprModuleName mod_name, ptext SLIT("is directly imported")]
 508 \end{code}
 509
 510
 511 %*********************************************************
 512 %*                                                      *
 513 \subsection{Instance declarations are handled specially}
 514 %*                                                      *
 515 %*********************************************************
 516
 517 \begin{code}
 518 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameHsDecl)]
 519 getImportedInstDecls gates
 520   =     -- First load any orphan-instance modules that aren't aready loaded
 521         -- Orphan-instance modules are recorded in the module dependecnies
 522     getIfacesRn                                                 `thenRn` \ ifaces ->
 523     let
 524         orphan_mods = [mod | (mod, (_, True, Nothing)) <- fmToList (iImpModInfo ifaces)]
 525     in
 526     traceRn (text "Loading orphan modules" <+> fsep (map pprModuleName orphan_mods))    `thenRn_`
 527     mapRn_ load_it orphan_mods  `thenRn_`
 528
 529         -- Now we're ready to grab the instance declarations
 530         -- Find the un-gated ones and return them,
 531         -- removing them from the bag kept in Ifaces
 532     getIfacesRn                                                 `thenRn` \ ifaces ->
 533     let
 534         (decls, new_insts) = selectGated gates (iInsts ifaces)
 535     in
 536     setIfacesRn (ifaces { iInsts = new_insts })         `thenRn_`
 537
 538     traceRn (sep [text "getImportedInstDecls:",
 539                   nest 4 (fsep (map ppr (nameSetToList gates))),
 540                   text "Slurped" <+> int (length decls) <+> text "instance declarations"])      `thenRn_`
 541     returnRn decls
 542   where
 543     load_it mod = loadInterface (doc_str mod) mod ImportBySystem
 544     doc_str mod = sep [pprModuleName mod, ptext SLIT("is a orphan-instance module")]
 545
 546 getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
 547 getImportedRules
 548   = getIfacesRn         `thenRn` \ ifaces ->
 549     let
 550         gates              = iSlurp ifaces      -- Anything at all that's been slurped
 551         (decls, new_rules) = selectGated gates (iRules ifaces)
 552     in
 553     setIfacesRn (ifaces { iRules = new_rules })         `thenRn_`
 554     traceRn (sep [text "getImportedRules:",
 555                   text "Slurped" <+> int (length decls) <+> text "rules"])      `thenRn_`
 556     returnRn decls
 557
 558 selectGated gates decl_bag
 559 #ifdef DEBUG
 560   | opt_NoPruneDecls    -- Just to try the effect of not gating at all
 561   = (foldrBag (\ (_,d) ds -> d:ds) [] decl_bag, emptyBag)       -- Grab them all
 562
 563   | otherwise
 564 #endif
 565   = foldrBag select ([], emptyBag) decl_bag
 566   where
 567     select (reqd, decl) (yes, no)
 568         | isEmptyNameSet (reqd `minusNameSet` gates) = (decl:yes, no)
 569         | otherwise                                  = (yes,      (reqd,decl) `consBag` no)
 570
 571 lookupFixity :: Name -> RnMS Fixity
 572 lookupFixity name
 573   | isLocallyDefined name
 574   = getFixityEnv                        `thenRn` \ local_fix_env ->
 575     case lookupNameEnv local_fix_env name of
 576         Just (FixitySig _ fix _) -> returnRn fix
 577         Nothing                  -> returnRn defaultFixity
 578
 579   | otherwise   -- Imported
 580   = loadHomeInterface doc name          `thenRn` \ (_, ifaces) ->
 581     case lookupNameEnv (iFixes ifaces) name of
 582         Just (FixitySig _ fix _) -> returnRn fix
 583         Nothing                  -> returnRn defaultFixity
 584   where
 585     doc = ptext SLIT("Checking fixity for") <+> ppr name
 586 \end{code}
 587
 588
 589 %*********************************************************
 590 %*                                                      *
 591 \subsection{Keeping track of what we've slurped, and version numbers}
 592 %*                                                      *
 593 %*********************************************************
 594
 595 getImportVersions figures out what the "usage information" for this moudule is;
 596 that is, what it must record in its interface file as the things it uses.
 597 It records:
 598         - anything reachable from its body code
 599         - any module exported with a "module Foo".
 600
 601 Why the latter?  Because if Foo changes then this module's export list
 602 will change, so we must recompile this module at least as far as
 603 making a new interface file --- but in practice that means complete
 604 recompilation.
 605
 606 What about this?
 607         module A( f, g ) where          module B( f ) where
 608           import B( f )                   f = h 3
 609           g = ...                         h = ...
 610
 611 Should we record B.f in A's usages?  In fact we don't.  Certainly, if
 612 anything about B.f changes than anyone who imports A should be recompiled;
 613 they'll get an early exit if they don't use B.f.  However, even if B.f
 614 doesn't change at all, B.h may do so, and this change may not be reflected
 615 in f's version number.  So there are two things going on when compiling module A:
 616
 617 1.  Are A.o and A.hi correct?  Then we can bale out early.
 618 2.  Should modules that import A be recompiled?
 619
 620 For (1) it is slightly harmful to record B.f in A's usages, because a change in
 621 B.f's version will provoke full recompilation of A, producing an identical A.o,
 622 and A.hi differing only in its usage-version of B.f (which isn't used by any importer).
 623
 624 For (2), because of the tricky B.h question above, we ensure that A.hi is touched
 625 (even if identical to its previous version) if A's recompilation was triggered by
 626 an imported .hi file date change.  Given that, there's no need to record B.f in
 627 A's usages.
 628
 629 On the other hand, if A exports "module B" then we *do* count module B among
 630 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
 631
 632 \begin{code}
 633 getImportVersions :: ModuleName                 -- Name of this module
 634                   -> Maybe [IE any]             -- Export list for this module
 635                   -> RnMG (VersionInfo Name)    -- Version info for these names
 636
 637 getImportVersions this_mod exports
 638   = getIfacesRn                                 `thenRn` \ ifaces ->
 639     let
 640         mod_map   = iImpModInfo ifaces
 641         imp_names = iVSlurp     ifaces
 642
 643         -- mv_map groups together all the things imported from a particular module.
 644         mv_map1, mv_map2 :: FiniteMap ModuleName (WhatsImported Name)
 645
 646                 -- mv_map1 records all the modules that have a "module M"
 647                 -- in this module's export list with an "Everything"
 648         mv_map1 = foldr add_mod emptyFM export_mods
 649
 650                 -- mv_map2 adds the version numbers of things exported individually
 651         mv_map2 = foldr add_mv mv_map1 imp_names
 652
 653         -- Build the result list by adding info for each module,
 654         -- *omitting*   (a) library modules
 655         --              (b) source-imported modules
 656         mk_version_info mod_name (version, has_orphans, cts) so_far
 657            | omit cts  = so_far -- Don't record usage info for this module
 658            | otherwise = (mod_name, version, has_orphans, whats_imported) : so_far
 659            where
 660              whats_imported = case lookupFM mv_map2 mod_name of
 661                                 Just wi -> wi
 662                                 Nothing -> Specifically []
 663
 664         omit (Just (mod, boot_import, _)) = isLibModule mod || boot_import
 665         omit Nothing                      = False
 666     in
 667     returnRn (foldFM mk_version_info [] mod_map)
 668   where
 669      export_mods = case exports of
 670                         Nothing -> []
 671                         Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
 672
 673      add_mv v@(name, version) mv_map
 674       = addToFM_C add_item mv_map mod (Specifically [v])
 675         where
 676          mod = moduleName (nameModule name)
 677
 678          add_item Everything        _ = Everything
 679          add_item (Specifically xs) _ = Specifically (v:xs)
 680
 681      add_mod mod mv_map = addToFM mv_map mod Everything
 682 \end{code}
 683
 684 \begin{code}
 685 getSlurped
 686   = getIfacesRn         `thenRn` \ ifaces ->
 687     returnRn (iSlurp ifaces)
 688
 689 recordSlurp maybe_version avail
 690   = getIfacesRn         `thenRn` \ ifaces@(Ifaces { iSlurp  = slurped_names,
 691                                                     iVSlurp = imp_names }) ->
 692     let
 693         new_slurped_names = addAvailToNameSet slurped_names avail
 694
 695         new_imp_names = case maybe_version of
 696                            Just version -> (availName avail, version) : imp_names
 697                            Nothing      -> imp_names
 698     in
 699     setIfacesRn (ifaces { iSlurp  = new_slurped_names,
 700                           iVSlurp = new_imp_names })
 701 \end{code}
 702
 703
 704 %*********************************************************
 705 %*                                                      *
 706 \subsection{Getting binders out of a declaration}
 707 %*                                                      *
 708 %*********************************************************
 709
 710 @getDeclBinders@ returns the names for a @RdrNameHsDecl@.
 711 It's used for both source code (from @availsFromDecl@) and interface files
 712 (from @loadDecl@).
 713
 714 It doesn't deal with source-code specific things: ValD, DefD.  They
 715 are handled by the sourc-code specific stuff in RnNames.
 716
 717 \begin{code}
 718 getDeclBinders :: (RdrName -> SrcLoc -> RnM d Name)     -- New-name function
 719                 -> RdrNameHsDecl
 720                 -> RnM d (Maybe AvailInfo)
 721
 722 getDeclBinders new_name (TyClD (TyData _ _ tycon _ condecls _ _ src_loc))
 723   = new_name tycon src_loc                      `thenRn` \ tycon_name ->
 724     getConFieldNames new_name condecls          `thenRn` \ sub_names ->
 725     returnRn (Just (AvailTC tycon_name (tycon_name : nub sub_names)))
 726         -- The "nub" is because getConFieldNames can legitimately return duplicates,
 727         -- when a record declaration has the same field in multiple constructors
 728
 729 getDeclBinders new_name (TyClD (TySynonym tycon _ _ src_loc))
 730   = new_name tycon src_loc              `thenRn` \ tycon_name ->
 731     returnRn (Just (AvailTC tycon_name [tycon_name]))
 732
 733 getDeclBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ _ _ _ src_loc))
 734   = new_name cname src_loc                      `thenRn` \ class_name ->
 735
 736         -- Record the names for the class ops
 737     let
 738         -- just want class-op sigs
 739         op_sigs = filter isClassOpSig sigs
 740     in
 741     mapRn (getClassOpNames new_name) op_sigs    `thenRn` \ sub_names ->
 742
 743     returnRn (Just (AvailTC class_name (class_name : sub_names)))
 744
 745 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
 746   = new_name var src_loc                        `thenRn` \ var_name ->
 747     returnRn (Just (Avail var_name))
 748
 749 getDeclBinders new_name (FixD _)  = returnRn Nothing
 750 getDeclBinders new_name (ForD _)  = returnRn Nothing
 751 getDeclBinders new_name (DefD _)  = returnRn Nothing
 752 getDeclBinders new_name (InstD _) = returnRn Nothing
 753 getDeclBinders new_name (RuleD _) = returnRn Nothing
 754
 755 ----------------
 756 getConFieldNames new_name (ConDecl con _ _ (RecCon fielddecls) src_loc : rest)
 757   = mapRn (\n -> new_name n src_loc) (con:fields)       `thenRn` \ cfs ->
 758     getConFieldNames new_name rest                      `thenRn` \ ns  ->
 759     returnRn (cfs ++ ns)
 760   where
 761     fields = concat (map fst fielddecls)
 762
 763 getConFieldNames new_name (ConDecl con _ _ condecl src_loc : rest)
 764   = new_name con src_loc                `thenRn` \ n ->
 765     (case condecl of
 766       NewCon _ (Just f) ->
 767         new_name f src_loc `thenRn` \ new_f ->
 768         returnRn [n,new_f]
 769       _ -> returnRn [n])                `thenRn` \ nn ->
 770     getConFieldNames new_name rest      `thenRn` \ ns ->
 771     returnRn (nn ++ ns)
 772
 773 getConFieldNames new_name [] = returnRn []
 774
 775 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
 776 \end{code}
 777
 778 @getDeclSysBinders@ gets the implicit binders introduced by a decl.
 779 A the moment that's just the tycon and datacon that come with a class decl.
 780 They aren'te returned by getDeclBinders because they aren't in scope;
 781 but they *should* be put into the DeclsMap of this module.
 782
 783 Note that this excludes the default-method names of a class decl,
 784 and the dict fun of an instance decl, because both of these have
 785 bindings of their own elsewhere.
 786
 787 \begin{code}
 788 getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname snames src_loc))
 789   = new_name dname src_loc                              `thenRn` \ datacon_name ->
 790     new_name tname src_loc                              `thenRn` \ tycon_name ->
 791     sequenceRn [new_name n src_loc | n <- snames]       `thenRn` \ scsel_names ->
 792     returnRn (tycon_name : datacon_name : scsel_names)
 793
 794 getDeclSysBinders new_name other_decl
 795   = returnRn []
 796 \end{code}
 797
 798 %*********************************************************
 799 %*                                                      *
 800 \subsection{Reading an interface file}
 801 %*                                                      *
 802 %*********************************************************
 803
 804 \begin{code}
 805 findAndReadIface :: SDoc -> ModuleName -> WhereFrom
 806                  -> Bool        -- Only relevant for SystemImport
 807                                 -- True  <=> Look for a .hi file
 808                                 -- False <=> Look for .hi-boot file unless there's
 809                                 --           a library .hi file
 810                  -> RnM d (Bool, Maybe (Module, ParsedIface))
 811         -- Bool is True if the interface actually read was a .hi-boot one
 812         -- Nothing <=> file not found, or unreadable, or illegible
 813         -- Just x  <=> successfully found and parsed
 814
 815 findAndReadIface doc_str mod_name from hi_file
 816   = traceRn trace_msg                   `thenRn_`
 817       -- we keep two maps for interface files,
 818       -- one for 'normal' ones, the other for .hi-boot files,
 819       -- hence the need to signal which kind we're interested.
 820
 821     getHiMaps                   `thenRn` \ hi_maps ->
 822
 823     case find_path from hi_maps of
 824          -- Found the file
 825        (hi_boot, Just (fpath, mod)) -> traceRn (ptext SLIT("...reading from") <+> text fpath)   `thenRn_`
 826                                        readIface mod fpath      `thenRn` \ result ->
 827                                        returnRn (hi_boot, result)
 828        (hi_boot, Nothing)           -> traceRn (ptext SLIT("...not found"))     `thenRn_`
 829                                        returnRn (hi_boot, Nothing)
 830   where
 831     find_path ImportByUser       (hi_map, _)     = (False, lookupFM hi_map mod_name)
 832     find_path ImportByUserSource (_, hiboot_map) = (True,  lookupFM hiboot_map mod_name)
 833
 834     find_path ImportBySystem     (hi_map, hiboot_map)
 835       | hi_file
 836       =         -- If the module we seek is in our dependent set,
 837                 -- Look for a .hi file
 838          (False, lookupFM hi_map mod_name)
 839
 840       | otherwise
 841                 -- Check if there's a library module of that name
 842                 -- If not, look for an hi-boot file
 843       = case lookupFM hi_map mod_name of
 844            stuff@(Just (_, mod)) | isLibModule mod -> (False, stuff)
 845            other                                   -> (True, lookupFM hiboot_map mod_name)
 846
 847     trace_msg = sep [hsep [ptext SLIT("Reading"),
 848                            ppr from,
 849                            ptext SLIT("interface for"),
 850                            pprModuleName mod_name <> semi],
 851                      nest 4 (ptext SLIT("reason:") <+> doc_str)]
 852 \end{code}
 853
 854 @readIface@ tries just the one file.
 855
 856 \begin{code}
 857 readIface :: Module -> String -> RnM d (Maybe (Module, ParsedIface))
 858         -- Nothing <=> file not found, or unreadable, or illegible
 859         -- Just x  <=> successfully found and parsed
 860 readIface the_mod file_path
 861   = ioToRnM (hGetStringBuffer file_path)       `thenRn` \ read_result ->
 862     case read_result of
 863         Right contents    ->
 864              case parseIface contents (mkSrcLoc (mkFastString file_path) 1) of
 865                   Failed err                    -> failWithRn Nothing err
 866                   Succeeded (PIface mod_nm iface) ->
 867                             warnCheckRn (mod_nm == moduleName the_mod)
 868                                         (hsep [ ptext SLIT("Something is amiss; requested module name")
 869                                                 , pprModule the_mod
 870                                                 , ptext SLIT("differs from name found in the interface file ")
 871                                                 , pprModuleName mod_nm
 872                                                 ])                                `thenRn_`
 873                             returnRn (Just (the_mod, iface))
 874
 875         Left err
 876           | isDoesNotExistError err -> returnRn Nothing
 877           | otherwise               -> failWithRn Nothing (cannaeReadFile file_path err)
 878 \end{code}
 879
 880 %*********************************************************
 881 %*                                                       *
 882 \subsection{Errors}
 883 %*                                                       *
 884 %*********************************************************
 885
 886 \begin{code}
 887 noIfaceErr filename boot_file
 888   = hsep [ptext SLIT("Could not find valid"), boot,
 889           ptext SLIT("interface file"), quotes (pprModule filename)]
 890   where
 891     boot | boot_file = ptext SLIT("[boot]")
 892          | otherwise = empty
 893
 894 cannaeReadFile file err
 895   = hcat [ptext SLIT("Failed in reading file: "),
 896           text file,
 897           ptext SLIT("; error="),
 898           text (show err)]
 899
 900 getDeclErr name
 901   = ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name)
 902
 903 getDeclWarn name loc
 904   = sep [ptext SLIT("Failed to find (optional) interface decl for") <+> quotes (ppr name),
 905          ptext SLIT("desired at") <+> ppr loc]
 906
 907 importDeclWarn mod name
 908   = sep [ptext SLIT("Compiler tried to import decl from interface file with same name as module."),
 909          ptext SLIT("(possible cause: module name clashes with interface file already in scope.)")
 910         ] $$
 911     hsep [ptext SLIT("Interface:"), quotes (pprModuleName mod),
 912           comma, ptext SLIT("name:"), quotes (ppr name)]
 913
 914 warnRedundantSourceImport mod_name
 915   = ptext SLIT("Unnecessary {- SOURCE -} in the import of module") <+> quotes (pprModuleName mod_name)
 916 \end{code}