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