ghc/compiler/rename/RnIfaces.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module RnIfaces (
  10         getInterfaceExports,
  11         getImportedInstDecls,
  12         getSpecialInstModules,
  13         importDecl, recordSlurp,
  14         getImportVersions,
  15
  16         checkUpToDate,
  17
  18         getDeclBinders,
  19         mkSearchPath
  20     ) where
  21
  22 IMP_Ubiq()
  23
  24
  25 import CmdLineOpts      ( opt_HiSuffix, opt_HiSuffixPrelude )
  26 import HsSyn            ( HsDecl(..), TyDecl(..), ClassDecl(..), HsTyVar, Bind, HsExpr, Sig(..), HsType(..),
  27                           HsBinds(..), MonoBinds, DefaultDecl, ConDecl(..), BangType, IfaceSig(..),
  28                           FixityDecl(..), Fixity, Fake, InPat, InstDecl(..), SYN_IE(Version), HsIdInfo,
  29                           IE(..)
  30                         )
  31 import HsPragmas        ( noGenPragmas )
  32 import RdrHsSyn         ( SYN_IE(RdrNameHsDecl), SYN_IE(RdrNameInstDecl),
  33                           RdrName, rdrNameOcc
  34                         )
  35 import RnEnv            ( newGlobalName, lookupRn, addImplicitOccsRn, availName, availNames, addAvailToNameSet )
  36 import RnSource         ( rnHsType )
  37 import RnMonad
  38 import ParseIface       ( parseIface )
  39
  40 import ErrUtils         ( SYN_IE(Error), SYN_IE(Warning) )
  41 import FiniteMap        ( FiniteMap, emptyFM, unitFM, lookupFM, addToFM, addToFM_C, addListToFM, fmToList )
  42 import Name             ( Name {-instance NamedThing-}, Provenance, OccName(..),
  43                           modAndOcc, occNameString, moduleString, pprModule,
  44                           NameSet(..), emptyNameSet, unionNameSets, nameSetToList,
  45                           minusNameSet, mkNameSet, elemNameSet,
  46                           isWiredInName, maybeWiredInTyConName, maybeWiredInIdName
  47                          )
  48 import Id               ( GenId, Id(..), idType, dataConTyCon, isDataCon )
  49 import TyCon            ( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
  50 import Type             ( namesOfType )
  51 import TyVar            ( GenTyVar )
  52 import SrcLoc           ( mkIfaceSrcLoc )
  53 import PrelMods         ( gHC__, isPreludeModule )
  54 import Bag
  55 import Maybes           ( MaybeErr(..), expectJust, maybeToBool )
  56 import ListSetOps       ( unionLists )
  57 import Pretty
  58 import PprStyle         ( PprStyle(..) )
  59 import Util             ( pprPanic, pprTrace )
  60 import StringBuffer     ( StringBuffer, hGetStringBuffer, freeStringBuffer )
  61
  62 \end{code}
  63
  64
  65
  66 %*********************************************************
  67 %*                                                      *
  68 \subsection{Loading a new interface file}
  69 %*                                                      *
  70 %*********************************************************
  71
  72 \begin{code}
  73 loadInterface :: Pretty -> Module -> RnMG Ifaces
  74 loadInterface doc_str load_mod
  75   = getIfacesRn                 `thenRn` \ ifaces ->
  76     let
  77         Ifaces this_mod mod_vers_map export_envs decls all_names imp_names insts inst_mods = ifaces
  78     in
  79         -- CHECK WHETHER WE HAVE IT ALREADY
  80     if maybeToBool (lookupFM export_envs load_mod)
  81     then
  82         returnRn ifaces         -- Already in the cache; don't re-read it
  83     else
  84
  85         -- READ THE MODULE IN
  86     findAndReadIface doc_str load_mod           `thenRn` \ read_result ->
  87     case read_result of {
  88         -- Check for not found
  89         Nothing ->      -- Not found, so add an empty export env to the Ifaces map
  90                         -- so that we don't look again
  91                    let
  92                         new_export_envs = addToFM export_envs load_mod ([],[])
  93                         new_ifaces = Ifaces this_mod mod_vers_map
  94                                             new_export_envs
  95                                             decls all_names imp_names insts inst_mods
  96                    in
  97                    setIfacesRn new_ifaces               `thenRn_`
  98                    failWithRn new_ifaces (noIfaceErr load_mod) ;
  99
 100         -- Found and parsed!
 101         Just (ParsedIface _ mod_vers usages exports rd_inst_mods fixs rd_decls rd_insts) ->
 102
 103         -- LOAD IT INTO Ifaces
 104     mapRn loadExport exports                            `thenRn` \ avails_s ->
 105     foldlRn (loadDecl load_mod) decls rd_decls          `thenRn` \ new_decls ->
 106     foldlRn (loadInstDecl load_mod) insts rd_insts      `thenRn` \ new_insts ->
 107     let
 108          export_env = (concat avails_s, fixs)
 109
 110                         -- Exclude this module from the "special-inst" modules
 111          new_inst_mods = inst_mods `unionLists` (filter (/= this_mod) rd_inst_mods)
 112
 113          new_ifaces = Ifaces this_mod
 114                              (addToFM mod_vers_map load_mod mod_vers)
 115                              (addToFM export_envs load_mod export_env)
 116                              new_decls
 117                              all_names imp_names
 118                              new_insts
 119                              new_inst_mods
 120     in
 121     setIfacesRn new_ifaces              `thenRn_`
 122     returnRn new_ifaces
 123     }
 124
 125 loadExport :: ExportItem -> RnMG [AvailInfo]
 126 loadExport (mod, entities)
 127   = mapRn load_entity entities
 128   where
 129     new_name occ = newGlobalName mod occ
 130
 131 -- The communcation between this little code fragment and the "entity" rule
 132 -- in ParseIface.y is a bit gruesome.  The idea is that things which are
 133 -- destined to be AvailTCs show up as (occ, [non-empty-list]), whereas
 134 -- things destined to be Avails show up as (occ, [])
 135
 136     load_entity (occ, occs)
 137       = new_name occ            `thenRn` \ name ->
 138         if null occs then
 139                 returnRn (Avail name)
 140         else
 141                 mapRn new_name occs     `thenRn` \ names ->
 142                 returnRn (AvailTC name names)
 143
 144 loadDecl :: Module -> DeclsMap
 145          -> (Version, RdrNameHsDecl)
 146          -> RnMG DeclsMap
 147 loadDecl mod decls_map (version, decl)
 148   = getDeclBinders new_implicit_name decl       `thenRn` \ avail ->
 149     returnRn (addListToFM decls_map
 150                           [(name,(version,avail,decl)) | name <- availNames avail]
 151     )
 152   where
 153     new_implicit_name rdr_name loc = newGlobalName mod (rdrNameOcc rdr_name)
 154
 155 loadInstDecl :: Module
 156              -> Bag IfaceInst
 157              -> RdrNameInstDecl
 158              -> RnMG (Bag IfaceInst)
 159 loadInstDecl mod_name insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
 160   =
 161         -- Find out what type constructors and classes are "gates" for the
 162         -- instance declaration.  If all these "gates" are slurped in then
 163         -- we should slurp the instance decl too.
 164         --
 165         -- We *don't* want to count names in the context part as gates, though.
 166         -- For example:
 167         --              instance Foo a => Baz (T a) where ...
 168         --
 169         -- Here the gates are Baz and T, but *not* Foo.
 170     let
 171         munged_inst_ty = case inst_ty of
 172                                 HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
 173                                 HsPreForAllTy cxt ty  -> HsPreForAllTy [] ty
 174                                 other                 -> inst_ty
 175     in
 176         -- We find the gates by renaming the instance type with in a
 177         -- and returning the occurrence pool.
 178     initRnMS emptyRnEnv mod_name InterfaceMode (
 179         findOccurrencesRn (rnHsType munged_inst_ty)
 180     )                                           `thenRn` \ gate_names ->
 181     returnRn (((mod_name, decl), gate_names) `consBag` insts)
 182 \end{code}
 183
 184
 185 %********************************************************
 186 %*                                                      *
 187 \subsection{Loading usage information}
 188 %*                                                      *
 189 %********************************************************
 190
 191 \begin{code}
 192 checkUpToDate :: Module -> RnMG Bool            -- True <=> no need to recompile
 193 checkUpToDate mod_name
 194   = findAndReadIface doc_str mod_name           `thenRn` \ read_result ->
 195     case read_result of
 196         Nothing ->      -- Old interface file not found, so we'd better bail out
 197                     traceRn (ppSep [ppPStr SLIT("Didnt find old iface"),
 198                                     pprModule PprDebug mod_name])       `thenRn_`
 199                     returnRn False
 200
 201         Just (ParsedIface _ _ usages _ _ _ _ _)
 202                 ->      -- Found it, so now check it
 203                     checkModUsage usages
 204   where
 205         -- Only look in current directory, with suffix .hi
 206     doc_str = ppSep [ppPStr SLIT("Need usage info from"), pprModule PprDebug mod_name]
 207
 208
 209 checkModUsage [] = returnRn True                -- Yes!  Everything is up to date!
 210
 211 checkModUsage ((mod, old_mod_vers, old_local_vers) : rest)
 212   = loadInterface doc_str mod           `thenRn` \ ifaces ->
 213     let
 214         Ifaces _ mod_vers _ decls _ _ _ _ = ifaces
 215         maybe_new_mod_vers = lookupFM mod_vers mod
 216         Just new_mod_vers  = maybe_new_mod_vers
 217     in
 218         -- If we can't find a version number for the old module then
 219         -- bail out saying things aren't up to date
 220     if not (maybeToBool maybe_new_mod_vers) then
 221         returnRn False
 222     else
 223
 224         -- If the module version hasn't changed, just move on
 225     if new_mod_vers == old_mod_vers then
 226         traceRn (ppSep [ppPStr SLIT("Module version unchanged:"), pprModule PprDebug mod])      `thenRn_`
 227         checkModUsage rest
 228     else
 229     traceRn (ppSep [ppPStr SLIT("Module version has changed:"), pprModule PprDebug mod])        `thenRn_`
 230
 231         -- New module version, so check entities inside
 232     checkEntityUsage mod decls old_local_vers   `thenRn` \ up_to_date ->
 233     if up_to_date then
 234         traceRn (ppPStr SLIT("...but the bits I use haven't.")) `thenRn_`
 235         checkModUsage rest      -- This one's ok, so check the rest
 236     else
 237         returnRn False          -- This one failed, so just bail out now
 238   where
 239     doc_str = ppSep [ppPStr SLIT("need version info for"), pprModule PprDebug mod]
 240
 241
 242 checkEntityUsage mod decls []
 243   = returnRn True       -- Yes!  All up to date!
 244
 245 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
 246   = newGlobalName mod occ_name          `thenRn` \ name ->
 247     case lookupFM decls name of
 248
 249         Nothing       ->        -- We used it before, but it ain't there now
 250                           traceRn (ppSep [ppPStr SLIT("...and this no longer exported:"), ppr PprDebug name])   `thenRn_`
 251                           returnRn False
 252
 253         Just (new_vers,_,_)     -- It's there, but is it up to date?
 254                 | new_vers == old_vers
 255                         -- Up to date, so check the rest
 256                 -> checkEntityUsage mod decls rest
 257
 258                 | otherwise
 259                         -- Out of date, so bale out
 260                 -> traceRn (ppSep [ppPStr SLIT("...and this is out of date:"), ppr PprDebug name])  `thenRn_`
 261                    returnRn False
 262 \end{code}
 263
 264
 265 %*********************************************************
 266 %*                                                      *
 267 \subsection{Getting in a declaration}
 268 %*                                                      *
 269 %*********************************************************
 270
 271 \begin{code}
 272 importDecl :: Name -> Necessity -> RnMG (Maybe RdrNameHsDecl)
 273         -- Returns Nothing for a wired-in or already-slurped decl
 274
 275 importDecl name necessity
 276   = checkSlurped name                   `thenRn` \ already_slurped ->
 277     if already_slurped then
 278         returnRn Nothing        -- Already dealt with
 279     else
 280     if isWiredInName name then
 281         getWiredInDecl name
 282     else
 283        getIfacesRn              `thenRn` \ ifaces ->
 284        let
 285          Ifaces this_mod _ _ _ _ _ _ _ = ifaces
 286          (mod,_) = modAndOcc name
 287        in
 288        if mod == this_mod  then    -- Don't bring in decls from
 289           pprTrace "importDecl wierdness:" (ppr PprDebug name) $
 290           returnRn Nothing         -- the renamed module's own interface file
 291                                    --
 292        else
 293         getNonWiredInDecl name necessity
 294
 295 \end{code}
 296
 297 \begin{code}
 298 getNonWiredInDecl :: Name -> Necessity -> RnMG (Maybe RdrNameHsDecl)
 299 getNonWiredInDecl name necessity
 300   = traceRn doc_str                     `thenRn_`
 301     loadInterface doc_str mod           `thenRn` \ (Ifaces _ _ _ decls _ _ _ _) ->
 302     case lookupFM decls name of
 303
 304       Just (version,avail,decl) -> recordSlurp (Just version) avail     `thenRn_`
 305                                    returnRn (Just decl)
 306
 307       Nothing ->        -- Can happen legitimately for "Optional" occurrences
 308                    case necessity of {
 309                                 Optional -> addWarnRn (getDeclWarn name);
 310                                 other    -> addErrRn  (getDeclErr  name)
 311                    }                                            `thenRn_`
 312                    returnRn Nothing
 313   where
 314      doc_str = ppSep [ppPStr SLIT("Need decl for"), ppr PprDebug name]
 315      (mod,_) = modAndOcc name
 316 \end{code}
 317
 318 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
 319 It behaves exactly as if the wired in decl were actually in an interface file.
 320 Specifically,
 321
 322   *     if the wired-in name is a data type constructor or a data constructor,
 323         it brings in the type constructor and all the data constructors; and
 324         marks as "occurrences" any free vars of the data con.
 325
 326   *     similarly for synonum type constructor
 327
 328   *     if the wired-in name is another wired-in Id, it marks as "occurrences"
 329         the free vars of the Id's type.
 330
 331   *     it loads the interface file for the wired-in thing for the
 332         sole purpose of making sure that its instance declarations are available
 333
 334 All this is necessary so that we know all types that are "in play", so
 335 that we know just what instances to bring into scope.
 336
 337 \begin{code}
 338 getWiredInDecl name
 339   =     -- Force in the home module in case it has instance decls for
 340         -- the thing we are interested in
 341     (if not is_tycon || mod == gHC__ then
 342         returnRn ()                     -- Mini hack 1: no point for non-tycons; and if we
 343                                         -- do this we find PrelNum trying to import PackedString,
 344                                         -- because PrelBase's .hi file mentions PackedString.unpackString
 345                                         -- But PackedString.hi isn't built by that point!
 346                                         --
 347                                         -- Mini hack 2; GHC is guaranteed not to have
 348                                         -- instance decls, so it's a waste of time
 349                                         -- to read it
 350     else
 351         loadInterface doc_str mod       `thenRn_`
 352         returnRn ()
 353     )                                   `thenRn_`
 354
 355     get_wired                           `thenRn` \ avail ->
 356     recordSlurp Nothing avail           `thenRn_`
 357     returnRn Nothing            -- No declaration to process further
 358   where
 359     doc_str = ppSep [ppPStr SLIT("Need home module for wired in thing"), ppr PprDebug name]
 360     (mod,_) = modAndOcc name
 361     maybe_wired_in_tycon = maybeWiredInTyConName name
 362     is_tycon             = maybeToBool maybe_wired_in_tycon
 363     maybe_wired_in_id    = maybeWiredInIdName    name
 364     Just the_tycon       = maybe_wired_in_tycon
 365     Just the_id          = maybe_wired_in_id
 366
 367     get_wired | is_tycon                        -- ... a type constructor
 368               = get_wired_tycon the_tycon
 369               -- Else, must be a wired-in-Id
 370
 371               | (isDataCon the_id)              -- ... a wired-in data constructor
 372               = get_wired_tycon (dataConTyCon the_id)
 373
 374               | otherwise                       -- ... a wired-in non data-constructor
 375               = get_wired_id the_id
 376
 377
 378 get_wired_id id
 379   = addImplicitOccsRn (nameSetToList id_mentioned)      `thenRn_`
 380     returnRn (Avail (getName id))
 381   where
 382     id_mentioned = namesOfType (idType id)
 383
 384 get_wired_tycon tycon
 385   | isSynTyCon tycon
 386   = addImplicitOccsRn (nameSetToList mentioned)         `thenRn_`
 387     returnRn (Avail (getName tycon))
 388   where
 389     (tyvars,ty) = getSynTyConDefn tycon
 390     mentioned = namesOfType ty `minusNameSet` mkNameSet (map getName tyvars)
 391
 392 get_wired_tycon tycon
 393   | otherwise           -- data or newtype
 394   = addImplicitOccsRn (nameSetToList mentioned)         `thenRn_`
 395     returnRn (AvailTC tycon_name (tycon_name : map getName data_cons))
 396   where
 397     tycon_name = getName tycon
 398     data_cons  = tyConDataCons tycon
 399     mentioned  = foldr (unionNameSets . namesOfType . idType) emptyNameSet data_cons
 400 \end{code}
 401
 402
 403 \begin{code}
 404 checkSlurped name
 405   = getIfacesRn         `thenRn` \ (Ifaces _ _ _ _ slurped_names _ _ _) ->
 406     returnRn (name `elemNameSet` slurped_names)
 407
 408 recordSlurp maybe_version avail
 409   = getIfacesRn         `thenRn` \ ifaces ->
 410     let
 411         Ifaces this_mod mod_vers export_envs decls slurped_names imp_names insts inst_mods = ifaces
 412         new_slurped_names = addAvailToNameSet slurped_names avail
 413
 414         new_imp_names = case maybe_version of
 415                            Just version -> (availName avail, version) : imp_names
 416                            Nothing      -> imp_names
 417
 418         new_ifaces = Ifaces this_mod mod_vers export_envs decls
 419                             new_slurped_names
 420                             new_imp_names
 421                             insts
 422                             inst_mods
 423     in
 424     setIfacesRn new_ifaces
 425 \end{code}
 426
 427 %*********************************************************
 428 %*                                                      *
 429 \subsection{Getting other stuff}
 430 %*                                                      *
 431 %*********************************************************
 432
 433 \begin{code}
 434 getInterfaceExports :: Module -> RnMG (Avails, [(OccName,Fixity)])
 435 getInterfaceExports mod
 436   = loadInterface doc_str mod           `thenRn` \ (Ifaces _ _ export_envs _ _ _ _ _) ->
 437     case lookupFM export_envs mod of
 438         Nothing ->      -- Not there; it must be that the interface file wasn't found;
 439                         -- the error will have been reported already.
 440                         -- (Actually loadInterface should put the empty export env in there
 441                         --  anyway, but this does no harm.)
 442                       returnRn ([],[])
 443
 444         Just stuff -> returnRn stuff
 445   where
 446     doc_str = ppSep [pprModule PprDebug mod, ppPStr SLIT("is directly imported")]
 447
 448
 449 getImportedInstDecls :: RnMG [(Module,RdrNameInstDecl)]
 450 getImportedInstDecls
 451   =     -- First load any special-instance modules that aren't aready loaded
 452     getSpecialInstModules                       `thenRn` \ inst_mods ->
 453     mapRn load_it inst_mods                     `thenRn_`
 454
 455         -- Now we're ready to grab the instance declarations
 456         -- Find the un-gated ones and return them,
 457         -- removing them from the bag kept in Ifaces
 458     getIfacesRn         `thenRn` \ ifaces ->
 459     let
 460         Ifaces this_mod mod_vers export_envs decls slurped_names imp_names insts inst_mods = ifaces
 461
 462                 -- An instance decl is ungated if all its gates have been slurped
 463         select_ungated :: IfaceInst                                     -- A gated inst decl
 464
 465                        -> ([(Module, RdrNameInstDecl)], [IfaceInst])    -- Accumulator
 466
 467                        -> ([(Module, RdrNameInstDecl)],                 -- The ungated ones
 468                            [IfaceInst])                                 -- Still gated, but with
 469                                                                         -- depeleted gates
 470         select_ungated (decl,gates) (ungated_decls, gated_decls)
 471           | null remaining_gates
 472           = (decl : ungated_decls, gated_decls)
 473           | otherwise
 474           = (ungated_decls, (decl, remaining_gates) : gated_decls)
 475           where
 476             remaining_gates = filter (not . (`elemNameSet` slurped_names)) gates
 477
 478         (un_gated_insts, still_gated_insts) = foldrBag select_ungated ([], []) insts
 479
 480         new_ifaces = Ifaces this_mod mod_vers export_envs decls slurped_names imp_names
 481                             (listToBag still_gated_insts)
 482                             inst_mods
 483     in
 484     setIfacesRn new_ifaces      `thenRn_`
 485     returnRn un_gated_insts
 486   where
 487     load_it mod = loadInterface (doc_str mod) mod
 488     doc_str mod = ppSep [pprModule PprDebug mod, ppPStr SLIT("is a special-instance module")]
 489
 490
 491 getSpecialInstModules :: RnMG [Module]
 492 getSpecialInstModules
 493   = getIfacesRn                                         `thenRn` \ ifaces ->
 494     let
 495          Ifaces _ _ _ _ _ _ _ inst_mods = ifaces
 496     in
 497     returnRn inst_mods
 498 \end{code}
 499
 500 getImportVersions figures out what the "usage information" for this moudule is;
 501 that is, what it must record in its interface file as the things it uses.
 502 It records:
 503         - anything reachable from its body code
 504         - any module exported with a "module Foo".
 505
 506 Why the latter?  Because if Foo changes then this module's export list
 507 will change, so we must recompile this module at least as far as
 508 making a new interface file --- but in practice that means complete
 509 recompilation.
 510
 511 What about this?
 512         module A( f, g ) where          module B( f ) where
 513           import B( f )                   f = h 3
 514           g = ...                         h = ...
 515
 516 Should we record B.f in A's usages?  In fact we don't.  Certainly, if
 517 anything about B.f changes than anyone who imports A should be recompiled;
 518 they'll get an early exit if they don't use B.f.  However, even if B.f
 519 doesn't change at all, B.h may do so, and this change may not be reflected
 520 in f's version number.  So there are two things going on when compiling module A:
 521
 522 1.  Are A.o and A.hi correct?  Then we can bale out early.
 523 2.  Should modules that import A be recompiled?
 524
 525 For (1) it is slightly harmful to record B.f in A's usages, because a change in
 526 B.f's version will provoke full recompilation of A, producing an identical A.o,
 527 and A.hi differing only in its usage-version of B.f (which isn't used by any importer).
 528
 529 For (2), because of the tricky B.h question above, we ensure that A.hi is touched
 530 (even if identical to its previous version) if A's recompilation was triggered by
 531 an imported .hi file date change.  Given that, there's no need to record B.f in
 532 A's usages.
 533
 534 On the other hand, if A exports "module B" then we *do* count module B among
 535 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
 536
 537 \begin{code}
 538 getImportVersions :: Module                     -- Name of this module
 539                   -> Maybe [IE any]             -- Export list for this module
 540                   -> RnMG (VersionInfo Name)    -- Version info for these names
 541
 542 getImportVersions this_mod exports
 543   = getIfacesRn                                 `thenRn` \ ifaces ->
 544     let
 545          Ifaces _ mod_versions_map _ _ _ imp_names _ _ = ifaces
 546          mod_version mod = expectJust "import_versions" (lookupFM mod_versions_map mod)
 547
 548          -- mv_map groups together all the things imported from a particular module.
 549          mv_map, mv_map_mod :: FiniteMap Module [LocalVersion Name]
 550
 551          mv_map_mod = foldl add_mod emptyFM export_mods
 552                 -- mv_map_mod records all the modules that have a "module M"
 553                 -- in this module's export list
 554
 555          mv_map = foldl add_mv mv_map_mod imp_names
 556                 -- mv_map adds the version numbers of things exported individually
 557     in
 558     returnRn [ (mod, mod_version mod, local_versions)
 559              | (mod, local_versions) <- fmToList mv_map
 560              ]
 561
 562   where
 563      export_mods = case exports of
 564                         Nothing -> []
 565                         Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
 566
 567      add_mv mv_map v@(name, version)
 568       = addToFM_C (\ ls _ -> (v:ls)) mv_map mod [v]
 569         where
 570          (mod,_) = modAndOcc name
 571
 572      add_mod mv_map mod = addToFM mv_map mod []
 573 \end{code}
 574
 575 %*********************************************************
 576 %*                                                      *
 577 \subsection{Getting binders out of a declaration}
 578 %*                                                      *
 579 %*********************************************************
 580
 581 @getDeclBinders@ returns the names for a @RdrNameHsDecl@.
 582 It's used for both source code (from @availsFromDecl@) and interface files
 583 (from @loadDecl@).
 584
 585 It doesn't deal with source-code specific things: ValD, DefD.  They
 586 are handled by the sourc-code specific stuff in RnNames.
 587
 588 \begin{code}
 589 getDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)              -- New-name function
 590                 -> RdrNameHsDecl
 591                 -> RnMG AvailInfo
 592
 593 getDeclBinders new_name (TyD (TyData _ tycon _ condecls _ _ src_loc))
 594   = new_name tycon src_loc                      `thenRn` \ tycon_name ->
 595     getConFieldNames new_name condecls          `thenRn` \ sub_names ->
 596     returnRn (AvailTC tycon_name (tycon_name : sub_names))
 597
 598 getDeclBinders new_name (TyD (TyNew _ tycon _ (NewConDecl con _ con_loc) _ _ src_loc))
 599   = new_name tycon src_loc              `thenRn` \ tycon_name ->
 600     new_name con src_loc                `thenRn` \ con_name ->
 601     returnRn (AvailTC tycon_name [tycon_name, con_name])
 602
 603 getDeclBinders new_name (TyD (TySynonym tycon _ _ src_loc))
 604   = new_name tycon src_loc              `thenRn` \ tycon_name ->
 605     returnRn (Avail tycon_name)
 606
 607 getDeclBinders new_name (ClD (ClassDecl _ cname _ sigs _ _ src_loc))
 608   = new_name cname src_loc                      `thenRn` \ class_name ->
 609     mapRn (getClassOpNames new_name) sigs       `thenRn` \ sub_names ->
 610     returnRn (AvailTC class_name (class_name : sub_names))
 611
 612 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
 613   = new_name var src_loc                        `thenRn` \ var_name ->
 614     returnRn (Avail var_name)
 615
 616 getDeclBinders new_name (DefD _)  = returnRn NotAvailable
 617 getDeclBinders new_name (InstD _) = returnRn NotAvailable
 618
 619 ----------------
 620 getConFieldNames new_name (ConDecl con _ src_loc : rest)
 621   = new_name con src_loc                `thenRn` \ n ->
 622     getConFieldNames new_name rest      `thenRn` \ ns ->
 623     returnRn (n:ns)
 624
 625 getConFieldNames new_name (NewConDecl con _ src_loc : rest)
 626   = new_name con src_loc                `thenRn` \ n ->
 627     getConFieldNames new_name rest      `thenRn` \ ns ->
 628     returnRn (n:ns)
 629
 630 getConFieldNames new_name (ConOpDecl _ con _ src_loc : rest)
 631   = new_name con src_loc                `thenRn` \ n ->
 632     getConFieldNames new_name rest      `thenRn` \ ns ->
 633     returnRn (n:ns)
 634
 635 getConFieldNames new_name (RecConDecl con fielddecls src_loc : rest)
 636   = mapRn (\n -> new_name n src_loc) (con:fields)       `thenRn` \ cfs ->
 637     getConFieldNames new_name rest                      `thenRn` \ ns  ->
 638     returnRn (cfs ++ ns)
 639   where
 640     fields = concat (map fst fielddecls)
 641
 642 getConFieldNames new_name [] = returnRn []
 643
 644 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
 645 \end{code}
 646
 647
 648 %*********************************************************
 649 %*                                                      *
 650 \subsection{Reading an interface file}
 651 %*                                                      *
 652 %*********************************************************
 653
 654 \begin{code}
 655 findAndReadIface :: Pretty -> Module -> RnMG (Maybe ParsedIface)
 656         -- Nothing <=> file not found, or unreadable, or illegible
 657         -- Just x  <=> successfully found and parsed
 658 findAndReadIface doc_str mod
 659   = traceRn trace_msg                   `thenRn_`
 660     getSearchPathRn                     `thenRn` \ dirs ->
 661     try dirs dirs
 662   where
 663     trace_msg = ppHang (ppBesides [ppPStr SLIT("Reading interface for "),
 664                                    pprModule PprDebug mod, ppSemi])
 665                      4 (ppBesides [ppPStr SLIT("reason: "), doc_str])
 666
 667     mod_str = moduleString mod
 668     hisuf =
 669       if isPreludeModule mod then
 670          case opt_HiSuffixPrelude of { Just hisuf -> hisuf; _ -> ".hi"}
 671       else
 672          case opt_HiSuffix of {Just hisuf -> hisuf; _ -> ".hi"}
 673
 674     try all_dirs [] = traceRn (ppPStr SLIT("...failed"))        `thenRn_`
 675                       returnRn Nothing
 676
 677     try all_dirs (dir:dirs)
 678         = readIface file_path   `thenRn` \ read_result ->
 679           case read_result of
 680                 Nothing    -> try all_dirs dirs
 681                 Just iface -> traceRn (ppPStr SLIT("...done"))  `thenRn_`
 682                               returnRn (Just iface)
 683         where
 684           file_path = dir ++ "/" ++ moduleString mod ++ hisuf
 685 \end{code}
 686
 687 @readIface@ trys just one file.
 688
 689 \begin{code}
 690 readIface :: String -> RnMG (Maybe ParsedIface)
 691         -- Nothing <=> file not found, or unreadable, or illegible
 692         -- Just x  <=> successfully found and parsed
 693 readIface file_path
 694   = ioToRnMG (hGetStringBuffer file_path)       `thenRn` \ read_result ->
 695 --OLD:  = ioToRnMG (readFile file_path)         `thenRn` \ read_result ->
 696     case read_result of
 697         Right contents    -> case parseIface contents of
 698                                 Failed err      -> --ioToRnMG (freeStringBuffer contents) `thenRn` \ _ ->
 699                                                    failWithRn Nothing err
 700                                 Succeeded iface -> --ioToRnMG (freeStringBuffer contents) `thenRn` \ _ ->
 701                                                    returnRn (Just iface)
 702
 703         Left  (NoSuchThing _) -> returnRn Nothing
 704
 705         Left  err             -> failWithRn Nothing
 706                                             (cannaeReadFile file_path err)
 707
 708 \end{code}
 709
 710 mkSearchPath takes a string consisting of a colon-separated list of directories, and turns it into
 711 a list of directories.  For example:
 712
 713         mkSearchPath "foo:.:baz"  =  ["foo", ".", "baz"]
 714
 715 \begin{code}
 716 mkSearchPath :: Maybe String -> SearchPath
 717 mkSearchPath Nothing = ["."]
 718 mkSearchPath (Just s)
 719   = go s
 720   where
 721     go "" = []
 722     go s  = first : go (drop 1 rest)
 723           where
 724             (first,rest) = span (/= ':') s
 725 \end{code}
 726
 727 %*********************************************************
 728 %*                                                      *
 729 \subsection{Errors}
 730 %*                                                      *
 731 %*********************************************************
 732
 733 \begin{code}
 734 noIfaceErr mod sty
 735   = ppBesides [ppPStr SLIT("Could not find valid interface file for "), ppQuote (pprModule sty mod)]
 736 --      , ppStr " in"]) 4 (ppAboves (map ppStr dirs))
 737
 738 cannaeReadFile file err sty
 739   = ppBesides [ppPStr SLIT("Failed in reading file: "), ppStr file, ppPStr SLIT("; error="), ppStr (show err)]
 740
 741 getDeclErr name sty
 742   = ppSep [ppPStr SLIT("Failed to find interface decl for"), ppr sty name]
 743
 744 getDeclWarn name sty
 745   = ppSep [ppPStr SLIT("Warning: failed to find (optional) interface decl for"), ppr sty name]
 746 \end{code}