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