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