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