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 = removeContext inst_ty
 295         free_names     = extractHsTyRdrNames munged_inst_ty
 296     in
 297     setModuleRn (moduleName mod) $
 298     mapRn mkImportedGlobalFromRdrName free_names        `thenRn` \ gate_names ->
 299     returnRn ((mkNameSet gate_names, (mod, InstD decl)) `consBag` insts)
 300
 301
 302 -- In interface files, the instance decls now look like
 303 --      forall a. Foo a -> Baz (T a)
 304 -- so we have to strip off function argument types as well
 305 -- as the bit before the '=>' (which is always empty in interface files)
 306 removeContext (HsForAllTy tvs cxt ty) = HsForAllTy tvs [] (removeFuns ty)
 307 removeContext ty                      = removeFuns ty
 308
 309 removeFuns (MonoFunTy _ ty) = removeFuns ty
 310 removeFuns ty               = ty
 311
 312
 313 loadRule :: Module -> Bag GatedDecl
 314          -> RdrNameRuleDecl -> RnM d (Bag GatedDecl)
 315 -- "Gate" the rule simply by whether the rule variable is
 316 -- needed.  We can refine this later.
 317 loadRule mod rules decl@(IfaceRuleDecl var body src_loc)
 318   = setModuleRn (moduleName mod) $
 319     mkImportedGlobalFromRdrName var             `thenRn` \ var_name ->
 320     returnRn ((unitNameSet var_name, (mod, RuleD decl)) `consBag` rules)
 321 \end{code}
 322
 323
 324 %********************************************************
 325 %*                                                      *
 326 \subsection{Loading usage information}
 327 %*                                                      *
 328 %********************************************************
 329
 330 \begin{code}
 331 checkUpToDate :: ModuleName -> RnMG Bool                -- True <=> no need to recompile
 332 checkUpToDate mod_name
 333   = getIfacesRn                                 `thenRn` \ ifaces ->
 334     findAndReadIface doc_str mod_name
 335                      ImportByUser
 336                      (error "checkUpToDate")    `thenRn` \ (_, read_result) ->
 337
 338         -- CHECK WHETHER WE HAVE IT ALREADY
 339     case read_result of
 340         Nothing ->      -- Old interface file not found, so we'd better bail out
 341                     traceRn (sep [ptext SLIT("Didnt find old iface"),
 342                                   pprModuleName mod_name])      `thenRn_`
 343                     returnRn False
 344
 345         Just (_, iface)
 346                 ->      -- Found it, so now check it
 347                     checkModUsage (pi_usages iface)
 348   where
 349         -- Only look in current directory, with suffix .hi
 350     doc_str = sep [ptext SLIT("need usage info from"), pprModuleName mod_name]
 351
 352 checkModUsage [] = returnRn True                -- Yes!  Everything is up to date!
 353
 354 checkModUsage ((mod_name, old_mod_vers, _, whats_imported) : rest)
 355   = loadInterface doc_str mod_name ImportBySystem       `thenRn` \ (mod, ifaces) ->
 356     let
 357         maybe_mod_vers = case lookupFM (iImpModInfo ifaces) mod_name of
 358                            Just (version, _, Just (_, _, _)) -> Just version
 359                            other                             -> Nothing
 360     in
 361     case maybe_mod_vers of {
 362         Nothing ->      -- If we can't find a version number for the old module then
 363                         -- bail out saying things aren't up to date
 364                 traceRn (sep [ptext SLIT("Can't find version number for module"),
 365                               pprModuleName mod_name])                          `thenRn_`
 366                 returnRn False ;
 367
 368         Just new_mod_vers ->
 369
 370         -- If the module version hasn't changed, just move on
 371     if new_mod_vers == old_mod_vers then
 372         traceRn (sep [ptext SLIT("Module version unchanged:"), pprModuleName mod_name]) `thenRn_`
 373         checkModUsage rest
 374     else
 375     traceRn (sep [ptext SLIT("Module version has changed:"), pprModuleName mod_name])   `thenRn_`
 376
 377         -- Module version changed, so check entities inside
 378
 379         -- If the usage info wants to say "I imported everything from this module"
 380         --     it does so by making whats_imported equal to Everything
 381         -- In that case, we must recompile
 382     case whats_imported of {
 383       Everything -> traceRn (ptext SLIT("...and I needed the whole module"))    `thenRn_`
 384                     returnRn False;                -- Bale out
 385
 386       Specifically old_local_vers ->
 387
 388         -- Non-empty usage list, so check item by item
 389     checkEntityUsage mod_name (iDecls ifaces) old_local_vers    `thenRn` \ up_to_date ->
 390     if up_to_date then
 391         traceRn (ptext SLIT("...but the bits I use haven't."))  `thenRn_`
 392         checkModUsage rest      -- This one's ok, so check the rest
 393     else
 394         returnRn False          -- This one failed, so just bail out now
 395     }}
 396   where
 397     doc_str = sep [ptext SLIT("need version info for"), pprModuleName mod_name]
 398
 399
 400 checkEntityUsage mod decls []
 401   = returnRn True       -- Yes!  All up to date!
 402
 403 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
 404   = mkImportedGlobalName mod occ_name   `thenRn` \ name ->
 405     case lookupNameEnv decls name of
 406
 407         Nothing       ->        -- We used it before, but it ain't there now
 408                           putDocRn (sep [ptext SLIT("No longer exported:"), ppr name])  `thenRn_`
 409                           returnRn False
 410
 411         Just (new_vers,_,_,_)   -- It's there, but is it up to date?
 412                 | new_vers == old_vers
 413                         -- Up to date, so check the rest
 414                 -> checkEntityUsage mod decls rest
 415
 416                 | otherwise
 417                         -- Out of date, so bale out
 418                 -> putDocRn (sep [ptext SLIT("Out of date:"), ppr name])  `thenRn_`
 419                    returnRn False
 420 \end{code}
 421
 422
 423 %*********************************************************
 424 %*                                                      *
 425 \subsection{Getting in a declaration}
 426 %*                                                      *
 427 %*********************************************************
 428
 429 \begin{code}
 430 importDecl :: Name -> RnMG (Maybe (Module, RdrNameHsDecl))
 431         -- Returns Nothing for
 432         --      (a) wired in name
 433         --      (b) local decl
 434         --      (c) already slurped
 435
 436 importDecl name
 437   | isWiredInName name
 438   = returnRn Nothing
 439   | otherwise
 440   = getSlurped                          `thenRn` \ already_slurped ->
 441     if name `elemNameSet` already_slurped then
 442         returnRn Nothing        -- Already dealt with
 443     else
 444         getModuleRn             `thenRn` \ this_mod ->
 445         let
 446           mod = moduleName (nameModule name)
 447         in
 448         if mod == this_mod then         -- Don't bring in decls from
 449                                         -- the renamed module's own interface file
 450                   addWarnRn (importDeclWarn mod name) `thenRn_`
 451                   returnRn Nothing
 452         else
 453         getNonWiredInDecl name
 454 \end{code}
 455
 456 \begin{code}
 457 getNonWiredInDecl :: Name -> RnMG (Maybe (Module, RdrNameHsDecl))
 458 getNonWiredInDecl needed_name
 459   = traceRn doc_str                             `thenRn_`
 460     loadHomeInterface doc_str needed_name       `thenRn` \ (_, ifaces) ->
 461     case lookupNameEnv (iDecls ifaces) needed_name of
 462
 463       Just (version,avail,_,decl)
 464         -> recordSlurp (Just version) avail     `thenRn_`
 465            returnRn (Just decl)
 466
 467       Nothing           -- Can happen legitimately for "Optional" occurrences
 468         -> addErrRn (getDeclErr needed_name)    `thenRn_`
 469            returnRn Nothing
 470   where
 471      doc_str = ptext SLIT("need decl for") <+> ppr needed_name
 472 \end{code}
 473
 474 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
 475 It behaves exactly as if the wired in decl were actually in an interface file.
 476 Specifically,
 477
 478   *     if the wired-in name is a data type constructor or a data constructor,
 479         it brings in the type constructor and all the data constructors; and
 480         marks as "occurrences" any free vars of the data con.
 481
 482   *     similarly for synonum type constructor
 483
 484   *     if the wired-in name is another wired-in Id, it marks as "occurrences"
 485         the free vars of the Id's type.
 486
 487   *     it loads the interface file for the wired-in thing for the
 488         sole purpose of making sure that its instance declarations are available
 489
 490 All this is necessary so that we know all types that are "in play", so
 491 that we know just what instances to bring into scope.
 492
 493
 494
 495
 496 %*********************************************************
 497 %*                                                      *
 498 \subsection{Getting what a module exports}
 499 %*                                                      *
 500 %*********************************************************
 501
 502 @getInterfaceExports@ is called only for directly-imported modules
 503
 504 \begin{code}
 505 getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, Avails)
 506 getInterfaceExports mod_name from
 507   = loadInterface doc_str mod_name from `thenRn` \ (mod, ifaces) ->
 508     case lookupFM (iImpModInfo ifaces) mod_name of
 509         Nothing ->      -- Not there; it must be that the interface file wasn't found;
 510                         -- the error will have been reported already.
 511                         -- (Actually loadInterface should put the empty export env in there
 512                         --  anyway, but this does no harm.)
 513                       returnRn (mod, [])
 514
 515         Just (_, _, Just (mod, _, avails)) -> returnRn (mod, avails)
 516   where
 517     doc_str = sep [pprModuleName mod_name, ptext SLIT("is directly imported")]
 518 \end{code}
 519
 520
 521 %*********************************************************
 522 %*                                                      *
 523 \subsection{Instance declarations are handled specially}
 524 %*                                                      *
 525 %*********************************************************
 526
 527 \begin{code}
 528 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameHsDecl)]
 529 getImportedInstDecls gates
 530   =     -- First load any orphan-instance modules that aren't aready loaded
 531         -- Orphan-instance modules are recorded in the module dependecnies
 532     getIfacesRn                                                 `thenRn` \ ifaces ->
 533     let
 534         orphan_mods = [mod | (mod, (_, True, Nothing)) <- fmToList (iImpModInfo ifaces)]
 535     in
 536     traceRn (text "Loading orphan modules" <+> fsep (map pprModuleName orphan_mods))    `thenRn_`
 537     mapRn_ load_it orphan_mods  `thenRn_`
 538
 539         -- Now we're ready to grab the instance declarations
 540         -- Find the un-gated ones and return them,
 541         -- removing them from the bag kept in Ifaces
 542     getIfacesRn                                                 `thenRn` \ ifaces ->
 543     let
 544         (decls, new_insts) = selectGated gates (iInsts ifaces)
 545     in
 546     setIfacesRn (ifaces { iInsts = new_insts })         `thenRn_`
 547
 548     traceRn (sep [text "getImportedInstDecls:",
 549                   nest 4 (fsep (map ppr (nameSetToList gates))),
 550                   text "Slurped" <+> int (length decls) <+> text "instance declarations"])      `thenRn_`
 551     returnRn decls
 552   where
 553     load_it mod = loadInterface (doc_str mod) mod ImportBySystem
 554     doc_str mod = sep [pprModuleName mod, ptext SLIT("is a orphan-instance module")]
 555
 556 getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
 557 getImportedRules
 558   = getIfacesRn         `thenRn` \ ifaces ->
 559     let
 560         gates              = iSlurp ifaces      -- Anything at all that's been slurped
 561         (decls, new_rules) = selectGated gates (iRules ifaces)
 562     in
 563     setIfacesRn (ifaces { iRules = new_rules })         `thenRn_`
 564     traceRn (sep [text "getImportedRules:",
 565                   text "Slurped" <+> int (length decls) <+> text "rules"])      `thenRn_`
 566     returnRn decls
 567
 568 selectGated gates decl_bag
 569 #ifdef DEBUG
 570   | opt_NoPruneDecls    -- Just to try the effect of not gating at all
 571   = (foldrBag (\ (_,d) ds -> d:ds) [] decl_bag, emptyBag)       -- Grab them all
 572
 573   | otherwise
 574 #endif
 575   = foldrBag select ([], emptyBag) decl_bag
 576   where
 577     select (reqd, decl) (yes, no)
 578         | isEmptyNameSet (reqd `minusNameSet` gates) = (decl:yes, no)
 579         | otherwise                                  = (yes,      (reqd,decl) `consBag` no)
 580
 581 lookupFixity :: Name -> RnMS Fixity
 582 lookupFixity name
 583   | isLocallyDefined name
 584   = getFixityEnv                        `thenRn` \ local_fix_env ->
 585     case lookupNameEnv local_fix_env name of
 586         Just (FixitySig _ fix _) -> returnRn fix
 587         Nothing                  -> returnRn defaultFixity
 588
 589   | otherwise   -- Imported
 590   = loadHomeInterface doc name          `thenRn` \ (_, ifaces) ->
 591     case lookupNameEnv (iFixes ifaces) name of
 592         Just (FixitySig _ fix _) -> returnRn fix
 593         Nothing                  -> returnRn defaultFixity
 594   where
 595     doc = ptext SLIT("Checking fixity for") <+> ppr name
 596 \end{code}
 597
 598
 599 %*********************************************************
 600 %*                                                      *
 601 \subsection{Keeping track of what we've slurped, and version numbers}
 602 %*                                                      *
 603 %*********************************************************
 604
 605 getImportVersions figures out what the "usage information" for this moudule is;
 606 that is, what it must record in its interface file as the things it uses.
 607 It records:
 608         - anything reachable from its body code
 609         - any module exported with a "module Foo".
 610
 611 Why the latter?  Because if Foo changes then this module's export list
 612 will change, so we must recompile this module at least as far as
 613 making a new interface file --- but in practice that means complete
 614 recompilation.
 615
 616 What about this?
 617         module A( f, g ) where          module B( f ) where
 618           import B( f )                   f = h 3
 619           g = ...                         h = ...
 620
 621 Should we record B.f in A's usages?  In fact we don't.  Certainly, if
 622 anything about B.f changes than anyone who imports A should be recompiled;
 623 they'll get an early exit if they don't use B.f.  However, even if B.f
 624 doesn't change at all, B.h may do so, and this change may not be reflected
 625 in f's version number.  So there are two things going on when compiling module A:
 626
 627 1.  Are A.o and A.hi correct?  Then we can bale out early.
 628 2.  Should modules that import A be recompiled?
 629
 630 For (1) it is slightly harmful to record B.f in A's usages, because a change in
 631 B.f's version will provoke full recompilation of A, producing an identical A.o,
 632 and A.hi differing only in its usage-version of B.f (which isn't used by any importer).
 633
 634 For (2), because of the tricky B.h question above, we ensure that A.hi is touched
 635 (even if identical to its previous version) if A's recompilation was triggered by
 636 an imported .hi file date change.  Given that, there's no need to record B.f in
 637 A's usages.
 638
 639 On the other hand, if A exports "module B" then we *do* count module B among
 640 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
 641
 642 \begin{code}
 643 getImportVersions :: ModuleName                 -- Name of this module
 644                   -> Maybe [IE any]             -- Export list for this module
 645                   -> RnMG (VersionInfo Name)    -- Version info for these names
 646
 647 getImportVersions this_mod exports
 648   = getIfacesRn                                 `thenRn` \ ifaces ->
 649     let
 650         mod_map   = iImpModInfo ifaces
 651         imp_names = iVSlurp     ifaces
 652
 653         -- mv_map groups together all the things imported from a particular module.
 654         mv_map1, mv_map2 :: FiniteMap ModuleName (WhatsImported Name)
 655
 656                 -- mv_map1 records all the modules that have a "module M"
 657                 -- in this module's export list with an "Everything"
 658         mv_map1 = foldr add_mod emptyFM export_mods
 659
 660                 -- mv_map2 adds the version numbers of things exported individually
 661         mv_map2 = foldr add_mv mv_map1 imp_names
 662
 663         -- Build the result list by adding info for each module,
 664         -- *omitting*   (a) library modules
 665         --              (b) source-imported modules
 666         mk_version_info mod_name (version, has_orphans, cts) so_far
 667            | omit cts  = so_far -- Don't record usage info for this module
 668            | otherwise = (mod_name, version, has_orphans, whats_imported) : so_far
 669            where
 670              whats_imported = case lookupFM mv_map2 mod_name of
 671                                 Just wi -> wi
 672                                 Nothing -> Specifically []
 673
 674         omit (Just (mod, boot_import, _)) = isLibModule mod || boot_import
 675         omit Nothing                      = False
 676     in
 677     returnRn (foldFM mk_version_info [] mod_map)
 678   where
 679      export_mods = case exports of
 680                         Nothing -> []
 681                         Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
 682
 683      add_mv v@(name, version) mv_map
 684       = addToFM_C add_item mv_map mod (Specifically [v])
 685         where
 686          mod = moduleName (nameModule name)
 687
 688          add_item Everything        _ = Everything
 689          add_item (Specifically xs) _ = Specifically (v:xs)
 690
 691      add_mod mod mv_map = addToFM mv_map mod Everything
 692 \end{code}
 693
 694 \begin{code}
 695 getSlurped
 696   = getIfacesRn         `thenRn` \ ifaces ->
 697     returnRn (iSlurp ifaces)
 698
 699 recordSlurp maybe_version avail
 700   = getIfacesRn         `thenRn` \ ifaces@(Ifaces { iSlurp  = slurped_names,
 701                                                     iVSlurp = imp_names }) ->
 702     let
 703         new_slurped_names = addAvailToNameSet slurped_names avail
 704
 705         new_imp_names = case maybe_version of
 706                            Just version -> (availName avail, version) : imp_names
 707                            Nothing      -> imp_names
 708     in
 709     setIfacesRn (ifaces { iSlurp  = new_slurped_names,
 710                           iVSlurp = new_imp_names })
 711 \end{code}
 712
 713
 714 %*********************************************************
 715 %*                                                      *
 716 \subsection{Getting binders out of a declaration}
 717 %*                                                      *
 718 %*********************************************************
 719
 720 @getDeclBinders@ returns the names for a @RdrNameHsDecl@.
 721 It's used for both source code (from @availsFromDecl@) and interface files
 722 (from @loadDecl@).
 723
 724 It doesn't deal with source-code specific things: ValD, DefD.  They
 725 are handled by the sourc-code specific stuff in RnNames.
 726
 727 \begin{code}
 728 getDeclBinders :: (RdrName -> SrcLoc -> RnM d Name)     -- New-name function
 729                 -> RdrNameHsDecl
 730                 -> RnM d (Maybe AvailInfo)
 731
 732 getDeclBinders new_name (TyClD (TyData _ _ tycon _ condecls _ _ src_loc))
 733   = new_name tycon src_loc                      `thenRn` \ tycon_name ->
 734     getConFieldNames new_name condecls          `thenRn` \ sub_names ->
 735     returnRn (Just (AvailTC tycon_name (tycon_name : nub sub_names)))
 736         -- The "nub" is because getConFieldNames can legitimately return duplicates,
 737         -- when a record declaration has the same field in multiple constructors
 738
 739 getDeclBinders new_name (TyClD (TySynonym tycon _ _ src_loc))
 740   = new_name tycon src_loc              `thenRn` \ tycon_name ->
 741     returnRn (Just (AvailTC tycon_name [tycon_name]))
 742
 743 getDeclBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ _ _ _ src_loc))
 744   = new_name cname src_loc                      `thenRn` \ class_name ->
 745
 746         -- Record the names for the class ops
 747     let
 748         -- just want class-op sigs
 749         op_sigs = filter isClassOpSig sigs
 750     in
 751     mapRn (getClassOpNames new_name) op_sigs    `thenRn` \ sub_names ->
 752
 753     returnRn (Just (AvailTC class_name (class_name : sub_names)))
 754
 755 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
 756   = new_name var src_loc                        `thenRn` \ var_name ->
 757     returnRn (Just (Avail var_name))
 758
 759 getDeclBinders new_name (FixD _)  = returnRn Nothing
 760 getDeclBinders new_name (ForD _)  = returnRn Nothing
 761 getDeclBinders new_name (DefD _)  = returnRn Nothing
 762 getDeclBinders new_name (InstD _) = returnRn Nothing
 763 getDeclBinders new_name (RuleD _) = returnRn Nothing
 764
 765 ----------------
 766 getConFieldNames new_name (ConDecl con _ _ (RecCon fielddecls) src_loc : rest)
 767   = mapRn (\n -> new_name n src_loc) (con:fields)       `thenRn` \ cfs ->
 768     getConFieldNames new_name rest                      `thenRn` \ ns  ->
 769     returnRn (cfs ++ ns)
 770   where
 771     fields = concat (map fst fielddecls)
 772
 773 getConFieldNames new_name (ConDecl con _ _ condecl src_loc : rest)
 774   = new_name con src_loc                `thenRn` \ n ->
 775     (case condecl of
 776       NewCon _ (Just f) ->
 777         new_name f src_loc `thenRn` \ new_f ->
 778         returnRn [n,new_f]
 779       _ -> returnRn [n])                `thenRn` \ nn ->
 780     getConFieldNames new_name rest      `thenRn` \ ns ->
 781     returnRn (nn ++ ns)
 782
 783 getConFieldNames new_name [] = returnRn []
 784
 785 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
 786 \end{code}
 787
 788 @getDeclSysBinders@ gets the implicit binders introduced by a decl.
 789 A the moment that's just the tycon and datacon that come with a class decl.
 790 They aren'te returned by getDeclBinders because they aren't in scope;
 791 but they *should* be put into the DeclsMap of this module.
 792
 793 Note that this excludes the default-method names of a class decl,
 794 and the dict fun of an instance decl, because both of these have
 795 bindings of their own elsewhere.
 796
 797 \begin{code}
 798 getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname snames src_loc))
 799   = new_name dname src_loc                              `thenRn` \ datacon_name ->
 800     new_name tname src_loc                              `thenRn` \ tycon_name ->
 801     sequenceRn [new_name n src_loc | n <- snames]       `thenRn` \ scsel_names ->
 802     returnRn (tycon_name : datacon_name : scsel_names)
 803
 804 getDeclSysBinders new_name other_decl
 805   = returnRn []
 806 \end{code}
 807
 808 %*********************************************************
 809 %*                                                      *
 810 \subsection{Reading an interface file}
 811 %*                                                      *
 812 %*********************************************************
 813
 814 \begin{code}
 815 findAndReadIface :: SDoc -> ModuleName -> WhereFrom
 816                  -> Bool        -- Only relevant for SystemImport
 817                                 -- True  <=> Look for a .hi file
 818                                 -- False <=> Look for .hi-boot file unless there's
 819                                 --           a library .hi file
 820                  -> RnM d (Bool, Maybe (Module, ParsedIface))
 821         -- Bool is True if the interface actually read was a .hi-boot one
 822         -- Nothing <=> file not found, or unreadable, or illegible
 823         -- Just x  <=> successfully found and parsed
 824
 825 findAndReadIface doc_str mod_name from hi_file
 826   = traceRn trace_msg                   `thenRn_`
 827       -- we keep two maps for interface files,
 828       -- one for 'normal' ones, the other for .hi-boot files,
 829       -- hence the need to signal which kind we're interested.
 830
 831     getHiMaps                   `thenRn` \ hi_maps ->
 832
 833     case find_path from hi_maps of
 834          -- Found the file
 835        (hi_boot, Just (fpath, mod)) -> traceRn (ptext SLIT("...reading from") <+> text fpath)   `thenRn_`
 836                                        readIface mod fpath      `thenRn` \ result ->
 837                                        returnRn (hi_boot, result)
 838        (hi_boot, Nothing)           -> traceRn (ptext SLIT("...not found"))     `thenRn_`
 839                                        returnRn (hi_boot, Nothing)
 840   where
 841     find_path ImportByUser       (hi_map, _)     = (False, lookupFM hi_map mod_name)
 842     find_path ImportByUserSource (_, hiboot_map) = (True,  lookupFM hiboot_map mod_name)
 843
 844     find_path ImportBySystem     (hi_map, hiboot_map)
 845       | hi_file
 846       =         -- If the module we seek is in our dependent set,
 847                 -- Look for a .hi file
 848          (False, lookupFM hi_map mod_name)
 849
 850       | otherwise
 851                 -- Check if there's a library module of that name
 852                 -- If not, look for an hi-boot file
 853       = case lookupFM hi_map mod_name of
 854            stuff@(Just (_, mod)) | isLibModule mod -> (False, stuff)
 855            other                                   -> (True, lookupFM hiboot_map mod_name)
 856
 857     trace_msg = sep [hsep [ptext SLIT("Reading"),
 858                            ppr from,
 859                            ptext SLIT("interface for"),
 860                            pprModuleName mod_name <> semi],
 861                      nest 4 (ptext SLIT("reason:") <+> doc_str)]
 862 \end{code}
 863
 864 @readIface@ tries just the one file.
 865
 866 \begin{code}
 867 readIface :: Module -> String -> RnM d (Maybe (Module, ParsedIface))
 868         -- Nothing <=> file not found, or unreadable, or illegible
 869         -- Just x  <=> successfully found and parsed
 870 readIface the_mod file_path
 871   = ioToRnM (hGetStringBuffer file_path)       `thenRn` \ read_result ->
 872     case read_result of
 873         Right contents    ->
 874              case parseIface contents (mkSrcLoc (mkFastString file_path) 1) of
 875                   Failed err                    -> failWithRn Nothing err
 876                   Succeeded (PIface mod_nm iface) ->
 877                             warnCheckRn (mod_nm == moduleName the_mod)
 878                                         (hsep [ ptext SLIT("Something is amiss; requested module name")
 879                                                 , pprModule the_mod
 880                                                 , ptext SLIT("differs from name found in the interface file ")
 881                                                 , pprModuleName mod_nm
 882                                                 ])                                `thenRn_`
 883                             returnRn (Just (the_mod, iface))
 884
 885         Left err
 886           | isDoesNotExistError err -> returnRn Nothing
 887           | otherwise               -> failWithRn Nothing (cannaeReadFile file_path err)
 888 \end{code}
 889
 890 %*********************************************************
 891 %*                                                       *
 892 \subsection{Errors}
 893 %*                                                       *
 894 %*********************************************************
 895
 896 \begin{code}
 897 noIfaceErr filename boot_file
 898   = hsep [ptext SLIT("Could not find valid"), boot,
 899           ptext SLIT("interface file"), quotes (pprModule filename)]
 900   where
 901     boot | boot_file = ptext SLIT("[boot]")
 902          | otherwise = empty
 903
 904 cannaeReadFile file err
 905   = hcat [ptext SLIT("Failed in reading file: "),
 906           text file,
 907           ptext SLIT("; error="),
 908           text (show err)]
 909
 910 getDeclErr name
 911   = ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name)
 912
 913 getDeclWarn name loc
 914   = sep [ptext SLIT("Failed to find (optional) interface decl for") <+> quotes (ppr name),
 915          ptext SLIT("desired at") <+> ppr loc]
 916
 917 importDeclWarn mod name
 918   = sep [ptext SLIT("Compiler tried to import decl from interface file with same name as module."),
 919          ptext SLIT("(possible cause: module name clashes with interface file already in scope.)")
 920         ] $$
 921     hsep [ptext SLIT("Interface:"), quotes (pprModuleName mod),
 922           comma, ptext SLIT("name:"), quotes (ppr name)]
 923
 924 warnRedundantSourceImport mod_name
 925   = ptext SLIT("Unnecessary {- SOURCE -} in the import of module") <+> quotes (pprModuleName mod_name)
 926 \end{code}