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