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,
  10         getSpecialInstModules, getDeferredDataDecls,
  11         importDecl, recordSlurp,
  12         getImportVersions, getSlurpedNames, getRnStats, getImportedFixities,
  13
  14         checkUpToDate,
  15
  16         getDeclBinders,
  17         mkSearchPath
  18     ) where
  19
  20 #include "HsVersions.h"
  21
  22 import CmdLineOpts      ( opt_PruneTyDecls,  opt_PruneInstDecls,
  23                           opt_D_show_rn_imports, opt_IgnoreIfacePragmas
  24                         )
  25 import HsSyn            ( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..),
  26                           HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
  27                           FixitySig(..),
  28                           hsDeclName, countTyClDecls, isDataDecl, nonFixitySigs
  29                         )
  30 import BasicTypes       ( Version, NewOrData(..) )
  31 import RdrHsSyn         ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyClDecl,
  32                         )
  33 import RnEnv            ( newImportedGlobalName, newImportedGlobalFromRdrName,
  34                           addImplicitOccsRn, pprAvail,
  35                           availName, availNames, addAvailToNameSet
  36                         )
  37 import RnSource         ( rnHsSigType )
  38 import RnMonad
  39 import RnHsSyn          ( RenamedHsDecl )
  40 import ParseIface       ( parseIface, IfaceStuff(..) )
  41
  42 import FiniteMap        ( FiniteMap, sizeFM, emptyFM, delFromFM,
  43                           lookupFM, addToFM, addToFM_C, addListToFM,
  44                           fmToList
  45                         )
  46 import Name             ( Name {-instance NamedThing-},
  47                           nameModule, isLocallyDefined,
  48                           isWiredInName, maybeWiredInTyConName,
  49                           maybeWiredInIdName, nameUnique, NamedThing(..),
  50                           pprEncodedFS
  51                          )
  52 import Module           ( Module, mkBootModule, moduleString, pprModule,
  53                           mkDynamicModule, moduleIfaceFlavour, bootFlavour, hiFile,
  54                           moduleUserString, moduleFS, setModuleFlavour
  55                         )
  56 import RdrName          ( RdrName, rdrNameOcc )
  57 import NameSet
  58 import Id               ( idType, isDataConId_maybe )
  59 import DataCon          ( dataConTyCon, dataConType )
  60 import TyCon            ( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
  61 import Type             ( namesOfType )
  62 import Var              ( Id )
  63 import SrcLoc           ( mkSrcLoc, SrcLoc )
  64 import PrelMods         ( pREL_GHC )
  65 import PrelInfo         ( cCallishTyKeys, thinAirModules )
  66 import Bag
  67 import Maybes           ( MaybeErr(..), maybeToBool )
  68 import ListSetOps       ( unionLists )
  69 import Outputable
  70 import Unique           ( Unique )
  71 import StringBuffer     ( StringBuffer, hGetStringBuffer )
  72 import FastString       ( mkFastString )
  73 import Outputable
  74
  75 import IO       ( isDoesNotExistError )
  76 import List     ( nub )
  77 \end{code}
  78
  79
  80
  81 %*********************************************************
  82 %*                                                      *
  83 \subsection{Statistics}
  84 %*                                                      *
  85 %*********************************************************
  86
  87 \begin{code}
  88 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
  89 getRnStats all_decls
  90   = getIfacesRn                 `thenRn` \ ifaces ->
  91     let
  92         n_mods      = sizeFM (iModMap ifaces)
  93
  94         decls_imported = filter is_imported_decl all_decls
  95
  96         decls_read     = [decl | (_, avail, decl, True) <- nameEnvElts (iDecls ifaces),
  97                                         -- Data, newtype, and class decls are in the decls_fm
  98                                         -- under multiple names; the tycon/class, and each
  99                                         -- constructor/class op too.
 100                                         -- The 'True' selects just the 'main' decl
 101                                  not (isLocallyDefined (availName avail))
 102                              ]
 103
 104         (cd_rd, dd_rd, add_rd, nd_rd, and_rd, sd_rd, vd_rd,     _) = count_decls decls_read
 105         (cd_sp, dd_sp, add_sp, nd_sp, and_sp, sd_sp, vd_sp, id_sp) = count_decls decls_imported
 106
 107         (unslurped_insts, _)  = iDefInsts ifaces
 108         inst_decls_unslurped  = length (bagToList unslurped_insts)
 109         inst_decls_read       = id_sp + inst_decls_unslurped
 110
 111         stats = vcat
 112                 [int n_mods <> text " interfaces read",
 113                  hsep [ int cd_sp, text "class decls imported, out of",
 114                         int cd_rd, text "read"],
 115                  hsep [ int dd_sp, text "data decls imported (of which", int add_sp,
 116                         text "abstractly), out of",
 117                         int dd_rd, text "read"],
 118                  hsep [ int nd_sp, text "newtype decls imported (of which", int and_sp,
 119                         text "abstractly), out of",
 120                         int nd_rd, text "read"],
 121                  hsep [int sd_sp, text "type synonym decls imported, out of",
 122                         int sd_rd, text "read"],
 123                  hsep [int vd_sp, text "value signatures imported, out of",
 124                         int vd_rd, text "read"],
 125                  hsep [int id_sp, text "instance decls imported, out of",
 126                         int inst_decls_read, text "read"]
 127                 ]
 128     in
 129     returnRn (hcat [text "Renamer stats: ", stats])
 130
 131 is_imported_decl (DefD _) = False
 132 is_imported_decl (ValD _) = False
 133 is_imported_decl decl     = not (isLocallyDefined (hsDeclName decl))
 134
 135 count_decls decls
 136   = -- pprTrace "count_decls" (ppr  decls
 137     --
 138     --                      $$
 139     --                      text "========="
 140     --                      $$
 141     --                      ppr imported_decls
 142     --  ) $
 143     (class_decls,
 144      data_decls,    abstract_data_decls,
 145      newtype_decls, abstract_newtype_decls,
 146      syn_decls,
 147      val_decls,
 148      inst_decls)
 149   where
 150     tycl_decls = [d | TyClD d <- decls]
 151     (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
 152     abstract_data_decls    = length [() | TyData DataType _ _ _ [] _ _ _ <- tycl_decls]
 153     abstract_newtype_decls = length [() | TyData NewType  _ _ _ [] _ _ _ <- tycl_decls]
 154
 155     val_decls     = length [() | SigD _   <- decls]
 156     inst_decls    = length [() | InstD _  <- decls]
 157
 158 \end{code}
 159
 160 %*********************************************************
 161 %*                                                      *
 162 \subsection{Loading a new interface file}
 163 %*                                                      *
 164 %*********************************************************
 165
 166 \begin{code}
 167 loadHomeInterface :: SDoc -> Name -> RnMG (Module, Ifaces)
 168 loadHomeInterface doc_str name
 169   = loadInterface doc_str (nameModule name)
 170
 171 loadInterface :: SDoc -> Module -> RnMG (Module, Ifaces)
 172 loadInterface doc_str load_mod
 173  = getIfacesRn          `thenRn` \ ifaces ->
 174    let
 175         hi_boot_wanted       = bootFlavour (moduleIfaceFlavour load_mod)
 176         mod_map              = iModMap ifaces
 177         (insts, tycls_names) = iDefInsts ifaces
 178
 179    in
 180         -- CHECK WHETHER WE HAVE IT ALREADY
 181    case lookupFM mod_map load_mod of {
 182         Just (existing_hif, _, _)
 183                 | hi_boot_wanted || not (bootFlavour existing_hif)
 184                 ->      -- Already in the cache, and new version is no better than old,
 185                         -- so don't re-read it
 186                     returnRn (setModuleFlavour existing_hif load_mod, ifaces) ;
 187         other ->
 188
 189         -- READ THE MODULE IN
 190    findAndReadIface doc_str load_mod            `thenRn` \ read_result ->
 191    case read_result of {
 192         Nothing | not hi_boot_wanted && load_mod `elem` thinAirModules
 193                 -> -- Hack alert!  When compiling PrelBase we have to load the
 194                    -- decls for packCString# and friends; they are 'thin-air' Ids
 195                    -- (see PrelInfo.lhs).  So if we don't find the HiFile we quietly
 196                    -- look for a .hi-boot file instead, and use that
 197                    --
 198                    -- NB this causes multiple "failed" attempts to read PrelPack,
 199                    --    which makes curious reading with -dshow-rn-trace, but
 200                    --    there's no harm done
 201                    loadInterface doc_str (mkBootModule load_mod)
 202
 203
 204                 | otherwise
 205                 ->      -- Not found, so add an empty export env to the Ifaces map
 206                         -- so that we don't look again
 207                    let
 208                         new_mod_map = addToFM mod_map load_mod (hiFile, 0, [])
 209                         new_ifaces = ifaces { iModMap = new_mod_map }
 210                    in
 211                    setIfacesRn new_ifaces               `thenRn_`
 212                    failWithRn (load_mod, new_ifaces) (noIfaceErr load_mod) ;
 213
 214         -- Found and parsed!
 215         Just (the_mod, ParsedIface mod_vers usages exports rd_inst_mods rd_decls rd_insts) ->
 216
 217
 218         -- LOAD IT INTO Ifaces
 219         -- First set the module
 220
 221         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
 222         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
 223         --     If we do loadExport first the wrong info gets into the cache (unless we
 224         --      explicitly tag each export which seems a bit of a bore)
 225
 226     getModuleRn                 `thenRn` \ this_mod ->
 227     setModuleRn the_mod  $      -- First set the module name of the module being loaded,
 228                                 -- so that unqualified occurrences in the interface file
 229                                 -- get the right qualifer
 230     foldlRn loadDecl (iDecls ifaces) rd_decls           `thenRn` \ new_decls ->
 231     foldlRn loadFixDecl (iFixes ifaces) rd_decls        `thenRn` \ new_fixities ->
 232     foldlRn loadInstDecl insts rd_insts                 `thenRn` \ new_insts ->
 233
 234     mapRn (loadExport this_mod) exports                 `thenRn` \ avails_s ->
 235     let
 236           -- Notice: the 'flavour' of the loaded Module does not have to
 237           --  be the same as the requested Module.
 238          the_mod_hif = moduleIfaceFlavour the_mod
 239          mod_details = (the_mod_hif, mod_vers, concat avails_s)
 240
 241                         -- Exclude this module from the "special-inst" modules
 242          new_inst_mods = iInstMods ifaces `unionLists` (filter (/= this_mod) rd_inst_mods)
 243
 244          new_ifaces = ifaces { iModMap   = addToFM mod_map the_mod mod_details,
 245                                iDecls    = new_decls,
 246                                iFixes    = new_fixities,
 247                                iDefInsts = (new_insts, tycls_names),
 248                                iInstMods = new_inst_mods  }
 249     in
 250     setIfacesRn new_ifaces              `thenRn_`
 251     returnRn (the_mod, new_ifaces)
 252     }}
 253
 254 loadExport :: Module -> ExportItem -> RnMG [AvailInfo]
 255 loadExport this_mod (mod, entities)
 256   | mod == this_mod = returnRn []
 257         -- If the module exports anything defined in this module, just ignore it.
 258         -- Reason: otherwise it looks as if there are two local definition sites
 259         -- for the thing, and an error gets reported.  Easiest thing is just to
 260         -- filter them out up front. This situation only arises if a module
 261         -- imports itself, or another module that imported it.  (Necessarily,
 262         -- this invoves a loop.)  Consequence: if you say
 263         --      module A where
 264         --         import B( AType )
 265         --         type AType = ...
 266         --
 267         --      module B( AType ) where
 268         --         import {-# SOURCE #-} A( AType )
 269         --
 270         -- then you'll get a 'B does not export AType' message.  A bit bogus
 271         -- but it's a bogus thing to do!
 272
 273   | otherwise
 274   = setModuleFlavourRn mod `thenRn` \ mod' ->
 275     mapRn (load_entity mod') entities
 276   where
 277     new_name mod occ = newImportedGlobalName mod occ
 278
 279     load_entity mod (Avail occ)
 280       = new_name mod occ        `thenRn` \ name ->
 281         returnRn (Avail name)
 282     load_entity mod (AvailTC occ occs)
 283       = new_name mod occ              `thenRn` \ name ->
 284         mapRn (new_name mod) occs     `thenRn` \ names ->
 285         returnRn (AvailTC name names)
 286
 287
 288 loadFixDecl :: FixityEnv
 289             -> (Version, RdrNameHsDecl)
 290             -> RnMG FixityEnv
 291 loadFixDecl fixity_env (version, FixD (FixitySig rdr_name fixity loc))
 292   =     -- Ignore the version; when the fixity changes the version of
 293         -- its 'host' entity changes, so we don't need a separate version
 294         -- number for fixities
 295     newImportedGlobalFromRdrName rdr_name       `thenRn` \ name ->
 296     let
 297         new_fixity_env = addToNameEnv fixity_env name (FixitySig name fixity loc)
 298     in
 299     returnRn new_fixity_env
 300
 301         -- Ignore the other sorts of decl
 302 loadFixDecl fixity_env other_decl = returnRn fixity_env
 303
 304 loadDecl :: DeclsMap
 305          -> (Version, RdrNameHsDecl)
 306          -> RnMG DeclsMap
 307
 308 loadDecl decls_map (version, decl)
 309   = getDeclBinders new_name decl        `thenRn` \ maybe_avail ->
 310     case maybe_avail of {
 311         Nothing -> returnRn decls_map;  -- No bindings
 312         Just avail ->
 313
 314     getDeclSysBinders new_name decl     `thenRn` \ sys_bndrs ->
 315     let
 316         main_name     = availName avail
 317         new_decls_map = foldl add_decl decls_map
 318                                        [ (name, (version,avail,decl',name==main_name))
 319                                        | name <- sys_bndrs ++ availNames avail]
 320         add_decl decls_map (name, stuff)
 321           = WARN( name `elemNameEnv` decls_map, ppr name )
 322             addToNameEnv decls_map name stuff
 323     in
 324     returnRn new_decls_map
 325     }
 326   where
 327     new_name rdr_name loc = newImportedGlobalFromRdrName rdr_name
 328     {-
 329       If a signature decl is being loaded, and optIgnoreIfacePragmas is on,
 330       we toss away unfolding information.
 331
 332       Also, if the signature is loaded from a module we're importing from source,
 333       we do the same. This is to avoid situations when compiling a pair of mutually
 334       recursive modules, peering at unfolding info in the interface file of the other,
 335       e.g., you compile A, it looks at B's interface file and may as a result change
 336       its interface file. Hence, B is recompiled, maybe changing its interface file,
 337       which will the unfolding info used in A to become invalid. Simple way out is to
 338       just ignore unfolding info.
 339
 340       [Jan 99: I junked the second test above.  If we're importing from an hi-boot
 341        file there isn't going to *be* any pragma info.  Maybe the above comment
 342        dates from a time where we picked up a .hi file first if it existed?]
 343     -}
 344     decl' =
 345      case decl of
 346        SigD (IfaceSig name tp ls loc) | opt_IgnoreIfacePragmas ->
 347             SigD (IfaceSig name tp [] loc)
 348        _ -> decl
 349
 350 loadInstDecl :: Bag IfaceInst
 351              -> RdrNameInstDecl
 352              -> RnMG (Bag IfaceInst)
 353 loadInstDecl insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
 354   =
 355         -- Find out what type constructors and classes are "gates" for the
 356         -- instance declaration.  If all these "gates" are slurped in then
 357         -- we should slurp the instance decl too.
 358         --
 359         -- We *don't* want to count names in the context part as gates, though.
 360         -- For example:
 361         --              instance Foo a => Baz (T a) where ...
 362         --
 363         -- Here the gates are Baz and T, but *not* Foo.
 364     let
 365         munged_inst_ty = case inst_ty of
 366                                 HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
 367                                 other                 -> inst_ty
 368     in
 369         -- We find the gates by renaming the instance type with in a
 370         -- and returning the free variables of the type
 371     initRnMS emptyRnEnv vanillaInterfaceMode (
 372         discardOccurrencesRn (rnHsSigType (text "an instance decl") munged_inst_ty)
 373     )                                           `thenRn` \ (_, gate_names) ->
 374     getModuleRn                                 `thenRn` \ mod_name ->
 375     returnRn (((mod_name, decl), gate_names) `consBag` insts)
 376
 377 vanillaInterfaceMode = InterfaceMode Compulsory
 378 \end{code}
 379
 380
 381 %********************************************************
 382 %*                                                      *
 383 \subsection{Loading usage information}
 384 %*                                                      *
 385 %********************************************************
 386
 387 \begin{code}
 388 checkUpToDate :: Module -> RnMG Bool            -- True <=> no need to recompile
 389 checkUpToDate mod_name
 390   = findAndReadIface doc_str mod_name           `thenRn` \ read_result ->
 391
 392         -- CHECK WHETHER WE HAVE IT ALREADY
 393     case read_result of
 394         Nothing ->      -- Old interface file not found, so we'd better bail out
 395                     traceRn (sep [ptext SLIT("Didnt find old iface"),
 396                                     pprModule mod_name])        `thenRn_`
 397                     returnRn False
 398
 399         Just (_, ParsedIface _ usages _ _ _ _)
 400                 ->      -- Found it, so now check it
 401                     checkModUsage usages
 402   where
 403         -- Only look in current directory, with suffix .hi
 404     doc_str = sep [ptext SLIT("need usage info from"), pprModule mod_name]
 405
 406 checkModUsage [] = returnRn True                -- Yes!  Everything is up to date!
 407
 408 checkModUsage ((mod, old_mod_vers, whats_imported) : rest)
 409   = loadInterface doc_str mod           `thenRn` \ (mod, ifaces) ->
 410     let
 411         maybe_new_mod_vers        = lookupFM (iModMap ifaces) mod
 412         Just (_, new_mod_vers, _) = maybe_new_mod_vers
 413     in
 414         -- If we can't find a version number for the old module then
 415         -- bail out saying things aren't up to date
 416     if not (maybeToBool maybe_new_mod_vers) then
 417         traceRn (sep [ptext SLIT("Can't find version number for module"), pprModule mod]) `thenRn_`
 418         returnRn False
 419     else
 420
 421         -- If the module version hasn't changed, just move on
 422     if new_mod_vers == old_mod_vers then
 423         traceRn (sep [ptext SLIT("Module version unchanged:"), pprModule mod])  `thenRn_`
 424         checkModUsage rest
 425     else
 426     traceRn (sep [ptext SLIT("Module version has changed:"), pprModule mod])    `thenRn_`
 427
 428         -- Module version changed, so check entities inside
 429
 430         -- If the usage info wants to say "I imported everything from this module"
 431         --     it does so by making whats_imported equal to Everything
 432         -- In that case, we must recompile
 433     case whats_imported of {
 434       Everything -> traceRn (ptext SLIT("...and I needed the whole module"))    `thenRn_`
 435                     returnRn False;                -- Bale out
 436
 437       Specifically old_local_vers ->
 438
 439         -- Non-empty usage list, so check item by item
 440     checkEntityUsage mod (iDecls ifaces) old_local_vers `thenRn` \ up_to_date ->
 441     if up_to_date then
 442         traceRn (ptext SLIT("...but the bits I use haven't."))  `thenRn_`
 443         checkModUsage rest      -- This one's ok, so check the rest
 444     else
 445         returnRn False          -- This one failed, so just bail out now
 446     }
 447   where
 448     doc_str = sep [ptext SLIT("need version info for"), pprModule mod]
 449
 450
 451 checkEntityUsage mod decls []
 452   = returnRn True       -- Yes!  All up to date!
 453
 454 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
 455   = newImportedGlobalName mod occ_name          `thenRn` \ name ->
 456     case lookupNameEnv decls name of
 457
 458         Nothing       ->        -- We used it before, but it ain't there now
 459                           putDocRn (sep [ptext SLIT("No longer exported:"), ppr name])  `thenRn_`
 460                           returnRn False
 461
 462         Just (new_vers,_,_,_)   -- It's there, but is it up to date?
 463                 | new_vers == old_vers
 464                         -- Up to date, so check the rest
 465                 -> checkEntityUsage mod decls rest
 466
 467                 | otherwise
 468                         -- Out of date, so bale out
 469                 -> putDocRn (sep [ptext SLIT("Out of date:"), ppr name])  `thenRn_`
 470                    returnRn False
 471 \end{code}
 472
 473
 474 %*********************************************************
 475 %*                                                      *
 476 \subsection{Getting in a declaration}
 477 %*                                                      *
 478 %*********************************************************
 479
 480 \begin{code}
 481 importDecl :: Occurrence -> RnMode -> RnMG (Maybe RdrNameHsDecl)
 482         -- Returns Nothing for a wired-in or already-slurped decl
 483
 484 importDecl (name, loc) mode
 485   = checkSlurped name                   `thenRn` \ already_slurped ->
 486     if already_slurped then
 487 --      traceRn (sep [text "Already slurped:", ppr name])       `thenRn_`
 488         returnRn Nothing        -- Already dealt with
 489     else
 490     if isWiredInName name then
 491         getWiredInDecl name mode
 492     else
 493        getIfacesRn              `thenRn` \ ifaces ->
 494        let
 495          mod = nameModule name
 496        in
 497        if mod == iMod ifaces then    -- Don't bring in decls from
 498           addWarnRn (importDeclWarn mod name loc) `thenRn_`
 499 --        pprTrace "importDecl wierdness:" (ppr name) $
 500           returnRn Nothing         -- the renamed module's own interface file
 501                                    --
 502        else
 503        getNonWiredInDecl name loc mode
 504 \end{code}
 505
 506 \begin{code}
 507 getNonWiredInDecl :: Name -> SrcLoc -> RnMode -> RnMG (Maybe RdrNameHsDecl)
 508 getNonWiredInDecl needed_name loc mode
 509   = traceRn doc_str                             `thenRn_`
 510     loadHomeInterface doc_str needed_name       `thenRn` \ (_, ifaces) ->
 511     case lookupNameEnv (iDecls ifaces) needed_name of
 512
 513         -- Special case for data/newtype type declarations
 514       Just (version, avail, TyClD tycl_decl, _) | isDataDecl tycl_decl
 515         -> getNonWiredDataDecl needed_name version avail tycl_decl      `thenRn` \ (avail', maybe_decl) ->
 516            recordSlurp (Just version) necessity avail'                  `thenRn_`
 517            returnRn maybe_decl
 518
 519       Just (version,avail,decl,_)
 520         -> recordSlurp (Just version) necessity avail   `thenRn_`
 521            returnRn (Just decl)
 522
 523       Nothing ->        -- Can happen legitimately for "Optional" occurrences
 524                    case necessity of {
 525                         Optional -> addWarnRn (getDeclWarn needed_name loc);
 526                         other    -> addErrRn  (getDeclErr  needed_name loc)
 527                    }                                            `thenRn_`
 528                    returnRn Nothing
 529   where
 530      necessity = modeToNecessity mode
 531      doc_str = sep [ptext SLIT("need decl for"), ppr needed_name, ptext SLIT("needed at"), ppr loc]
 532 \end{code}
 533
 534 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
 535 It behaves exactly as if the wired in decl were actually in an interface file.
 536 Specifically,
 537
 538   *     if the wired-in name is a data type constructor or a data constructor,
 539         it brings in the type constructor and all the data constructors; and
 540         marks as "occurrences" any free vars of the data con.
 541
 542   *     similarly for synonum type constructor
 543
 544   *     if the wired-in name is another wired-in Id, it marks as "occurrences"
 545         the free vars of the Id's type.
 546
 547   *     it loads the interface file for the wired-in thing for the
 548         sole purpose of making sure that its instance declarations are available
 549
 550 All this is necessary so that we know all types that are "in play", so
 551 that we know just what instances to bring into scope.
 552
 553 \begin{code}
 554 getWiredInDecl name mode
 555   = setModuleRn mod_name (
 556         initRnMS emptyRnEnv new_mode get_wired
 557     )                                           `thenRn` \ avail ->
 558     recordSlurp Nothing necessity avail         `thenRn_`
 559
 560         -- Force in the home module in case it has instance decls for
 561         -- the thing we are interested in.
 562         --
 563         -- Mini hack 1: no point for non-tycons/class; and if we
 564         -- do this we find PrelNum trying to import PackedString,
 565         -- because PrelBase's .hi file mentions PackedString.unpackString
 566         -- But PackedString.hi isn't built by that point!
 567         --
 568         -- Mini hack 2; GHC is guaranteed not to have
 569         -- instance decls, so it's a waste of time to read it
 570         --
 571         -- NB: We *must* look at the availName of the slurped avail,
 572         -- not the name passed to getWiredInDecl!  Why?  Because if a data constructor
 573         -- or class op is passed to getWiredInDecl we'll pull in the whole data/class
 574         -- decl, and recordSlurp will record that fact.  But since the data constructor
 575         -- isn't a tycon/class we won't force in the home module.  And even if the
 576         -- type constructor/class comes along later, loadDecl will say that it's already
 577         -- been slurped, so getWiredInDecl won't even be called.  Pretty obscure bug, this was.
 578     let
 579         main_name  = availName avail
 580         main_is_tc = case avail of { AvailTC _ _ -> True; Avail _ -> False }
 581         mod        = nameModule main_name
 582         doc_str    = sep [ptext SLIT("need home module for wired in thing"), ppr name]
 583     in
 584     (if not main_is_tc || mod == pREL_GHC then
 585         returnRn ()
 586     else
 587         loadHomeInterface doc_str main_name     `thenRn_`
 588         returnRn ()
 589     )                                           `thenRn_`
 590
 591     returnRn Nothing            -- No declaration to process further
 592   where
 593     necessity = modeToNecessity mode
 594     new_mode = case mode of
 595                         InterfaceMode _ -> mode
 596                         SourceMode      -> vanillaInterfaceMode
 597
 598     get_wired | is_tycon                        -- ... a type constructor
 599               = get_wired_tycon the_tycon
 600
 601               | maybeToBool maybe_data_con              -- ... a wired-in data constructor
 602               = get_wired_tycon (dataConTyCon data_con)
 603
 604               | otherwise                       -- ... a wired-in non data-constructor
 605               = get_wired_id the_id
 606
 607     mod_name             = nameModule name
 608     maybe_wired_in_tycon = maybeWiredInTyConName name
 609     is_tycon             = maybeToBool maybe_wired_in_tycon
 610     maybe_wired_in_id    = maybeWiredInIdName    name
 611     Just the_tycon       = maybe_wired_in_tycon
 612     Just the_id          = maybe_wired_in_id
 613     maybe_data_con       = isDataConId_maybe the_id
 614     Just data_con        = maybe_data_con
 615
 616
 617 get_wired_id id
 618   = addImplicitOccsRn id_mentions       `thenRn_`
 619     returnRn (Avail (getName id))
 620   where
 621     id_mentions = nameSetToList (namesOfType ty)
 622     ty = idType id
 623
 624 get_wired_tycon tycon
 625   | isSynTyCon tycon
 626   = addImplicitOccsRn (nameSetToList mentioned)         `thenRn_`
 627     returnRn (AvailTC tc_name [tc_name])
 628   where
 629     tc_name     = getName tycon
 630     (tyvars,ty) = getSynTyConDefn tycon
 631     mentioned   = namesOfType ty `minusNameSet` mkNameSet (map getName tyvars)
 632
 633 get_wired_tycon tycon
 634   | otherwise           -- data or newtype
 635   = addImplicitOccsRn (nameSetToList mentioned)         `thenRn_`
 636     returnRn (AvailTC tycon_name (tycon_name : map getName data_cons))
 637   where
 638     tycon_name = getName tycon
 639     data_cons  = tyConDataCons tycon
 640     mentioned  = foldr (unionNameSets . namesOfType . dataConType) emptyNameSet data_cons
 641 \end{code}
 642
 643
 644
 645 %*********************************************************
 646 %*                                                      *
 647 \subsection{Getting what a module exports}
 648 %*                                                      *
 649 %*********************************************************
 650
 651 \begin{code}
 652 getInterfaceExports :: Module -> RnMG (Module, Avails)
 653 getInterfaceExports mod
 654   = loadInterface doc_str mod   `thenRn` \ (mod, ifaces) ->
 655     case lookupFM (iModMap ifaces) mod of
 656         Nothing ->      -- Not there; it must be that the interface file wasn't found;
 657                         -- the error will have been reported already.
 658                         -- (Actually loadInterface should put the empty export env in there
 659                         --  anyway, but this does no harm.)
 660                       returnRn (mod, [])
 661
 662         Just (_, _, avails) -> returnRn (mod, avails)
 663   where
 664     doc_str = sep [pprModule mod, ptext SLIT("is directly imported")]
 665 \end{code}
 666
 667
 668 %*********************************************************
 669 %*                                                      *
 670 \subsection{Data type declarations are handled specially}
 671 %*                                                      *
 672 %*********************************************************
 673
 674 Data type declarations get special treatment.  If we import a data type decl
 675 with all its constructors, we end up importing all the types mentioned in
 676 the constructors' signatures, and hence {\em their} data type decls, and so on.
 677 In effect, we get the transitive closure of data type decls.  Worse, this drags
 678 in tons on instance decls, and their unfoldings, and so on.
 679
 680 If only the type constructor is mentioned, then all this is a waste of time.
 681 If any of the data constructors are mentioned then we really have to
 682 drag in the whole declaration.
 683
 684 So when we import the type constructor for a @data@ or @newtype@ decl, we
 685 put it in the "deferred data/newtype decl" pile in Ifaces.  Right at the end
 686 we slurp these decls, if they havn't already been dragged in by an occurrence
 687 of a constructor.
 688
 689 \begin{code}
 690 getNonWiredDataDecl needed_name
 691                     version
 692                     avail@(AvailTC tycon_name _)
 693                     ty_decl@(TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
 694   |  needed_name == tycon_name
 695   && opt_PruneTyDecls
 696         -- don't prune newtypes, as the code generator may
 697         -- want to peer inside a newtype type constructor
 698         -- (ClosureInfo.fun_result_ty is the culprit.)
 699   && not (new_or_data == NewType)
 700   && not (nameUnique needed_name `elem` cCallishTyKeys)
 701         -- Hack!  Don't prune these tycons whose constructors
 702         -- the desugarer must be able to see when desugaring
 703         -- a CCall.  Ugh!
 704
 705   =     -- Need the type constructor; so put it in the deferred set for now
 706     getIfacesRn                 `thenRn` \ ifaces ->
 707     let
 708         deferred_data_decls = iDefData ifaces
 709         new_ifaces          = ifaces {iDefData = new_deferred_data_decls}
 710
 711         no_constr_ty_decl       = TyData new_or_data [] tycon tyvars [] derivings pragmas src_loc
 712         new_deferred_data_decls = addToNameEnv deferred_data_decls tycon_name
 713                                                (nameModule tycon_name, no_constr_ty_decl)
 714                 -- Nota bene: we nuke both the constructors and the context in the deferred decl.
 715                 -- If we don't nuke the context then renaming the deferred data decls can give
 716                 -- new unresolved names (for the classes).  This could be handled, but there's
 717                 -- no point.  If the data type is completely abstract then we aren't interested
 718                 -- its context.
 719     in
 720     setIfacesRn new_ifaces      `thenRn_`
 721     returnRn (AvailTC tycon_name [tycon_name], Nothing)
 722
 723   | otherwise
 724   =     -- Need a data constructor, so delete the data decl from the deferred set if it's there
 725     getIfacesRn                 `thenRn` \ ifaces ->
 726     let
 727         deferred_data_decls = iDefData ifaces
 728         new_ifaces          = ifaces {iDefData = new_deferred_data_decls}
 729
 730         new_deferred_data_decls = delFromNameEnv deferred_data_decls tycon_name
 731     in
 732     setIfacesRn new_ifaces      `thenRn_`
 733     returnRn (avail, Just (TyClD ty_decl))
 734 \end{code}
 735
 736 \begin{code}
 737 getDeferredDataDecls :: RnMG [(Module, RdrNameTyClDecl)]
 738 getDeferredDataDecls
 739   = getIfacesRn                 `thenRn` \ ifaces ->
 740     let
 741         deferred_list = nameEnvElts (iDefData ifaces)
 742         trace_msg = hang (text "Slurping abstract data/newtype decls for: ")
 743                         4 (ppr (map fst deferred_list))
 744     in
 745     traceRn trace_msg                   `thenRn_`
 746     returnRn deferred_list
 747 \end{code}
 748
 749
 750 %*********************************************************
 751 %*                                                      *
 752 \subsection{Instance declarations are handled specially}
 753 %*                                                      *
 754 %*********************************************************
 755
 756 \begin{code}
 757 getImportedInstDecls :: RnMG [(Module,RdrNameInstDecl)]
 758 getImportedInstDecls
 759   =     -- First load any special-instance modules that aren't aready loaded
 760     getSpecialInstModules                       `thenRn` \ inst_mods ->
 761     mapRn load_it inst_mods                     `thenRn_`
 762
 763         -- Now we're ready to grab the instance declarations
 764         -- Find the un-gated ones and return them,
 765         -- removing them from the bag kept in Ifaces
 766     getIfacesRn         `thenRn` \ ifaces ->
 767     let
 768         (insts, tycls_names) = iDefInsts ifaces
 769
 770                 -- An instance decl is ungated if all its gates have been slurped
 771         select_ungated :: IfaceInst                                     -- A gated inst decl
 772
 773                        -> ([(Module, RdrNameInstDecl)], [IfaceInst])    -- Accumulator
 774
 775                        -> ([(Module, RdrNameInstDecl)],                 -- The ungated ones
 776                            [IfaceInst])                                 -- Still gated, but with
 777                                                                         -- depeleted gates
 778         select_ungated (decl,gates) (ungated_decls, gated_decls)
 779           | isEmptyNameSet remaining_gates
 780           = (decl : ungated_decls, gated_decls)
 781           | otherwise
 782           = (ungated_decls, (decl, remaining_gates) : gated_decls)
 783           where
 784             remaining_gates = gates `minusNameSet` tycls_names
 785
 786         (un_gated_insts, still_gated_insts) = foldrBag select_ungated ([], []) insts
 787
 788         new_ifaces = ifaces {iDefInsts = (listToBag still_gated_insts, tycls_names)}
 789                                 -- NB: don't throw away tycls_names;
 790                                 -- we may comre across more instance decls
 791     in
 792     traceRn (sep [text "getInstDecls:", fsep (map ppr (nameSetToList tycls_names))])    `thenRn_`
 793     setIfacesRn new_ifaces      `thenRn_`
 794     returnRn un_gated_insts
 795   where
 796     load_it mod = loadInterface (doc_str mod) mod
 797     doc_str mod = sep [pprModule mod, ptext SLIT("is a special-instance module")]
 798
 799
 800 getSpecialInstModules :: RnMG [Module]
 801 getSpecialInstModules
 802   = getIfacesRn                                         `thenRn` \ ifaces ->
 803     returnRn (iInstMods ifaces)
 804
 805 getImportedFixities :: GlobalRdrEnv -> RnMG FixityEnv
 806         -- Get all imported fixities
 807         -- We first make sure that all the home modules
 808         -- of all in-scope variables are loaded.
 809 getImportedFixities gbl_env
 810   = let
 811         home_modules = [ nameModule name | names <- rdrEnvElts gbl_env,
 812                                            name <- names,
 813                                            not (isLocallyDefined name)
 814                        ]
 815     in
 816     mapRn load (nub home_modules)       `thenRn_`
 817
 818         -- Now we can snaffle the fixity env
 819     getIfacesRn                                         `thenRn` \ ifaces ->
 820     returnRn (iFixes ifaces)
 821   where
 822     load mod = loadInterface doc_str mod
 823              where
 824                doc_str = ptext SLIT("Need fixities from") <+> ppr mod
 825 \end{code}
 826
 827
 828 %*********************************************************
 829 %*                                                      *
 830 \subsection{Keeping track of what we've slurped, and version numbers}
 831 %*                                                      *
 832 %*********************************************************
 833
 834 getImportVersions figures out what the "usage information" for this moudule is;
 835 that is, what it must record in its interface file as the things it uses.
 836 It records:
 837         - anything reachable from its body code
 838         - any module exported with a "module Foo".
 839
 840 Why the latter?  Because if Foo changes then this module's export list
 841 will change, so we must recompile this module at least as far as
 842 making a new interface file --- but in practice that means complete
 843 recompilation.
 844
 845 What about this?
 846         module A( f, g ) where          module B( f ) where
 847           import B( f )                   f = h 3
 848           g = ...                         h = ...
 849
 850 Should we record B.f in A's usages?  In fact we don't.  Certainly, if
 851 anything about B.f changes than anyone who imports A should be recompiled;
 852 they'll get an early exit if they don't use B.f.  However, even if B.f
 853 doesn't change at all, B.h may do so, and this change may not be reflected
 854 in f's version number.  So there are two things going on when compiling module A:
 855
 856 1.  Are A.o and A.hi correct?  Then we can bale out early.
 857 2.  Should modules that import A be recompiled?
 858
 859 For (1) it is slightly harmful to record B.f in A's usages, because a change in
 860 B.f's version will provoke full recompilation of A, producing an identical A.o,
 861 and A.hi differing only in its usage-version of B.f (which isn't used by any importer).
 862
 863 For (2), because of the tricky B.h question above, we ensure that A.hi is touched
 864 (even if identical to its previous version) if A's recompilation was triggered by
 865 an imported .hi file date change.  Given that, there's no need to record B.f in
 866 A's usages.
 867
 868 On the other hand, if A exports "module B" then we *do* count module B among
 869 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
 870
 871 \begin{code}
 872 getImportVersions :: Module                     -- Name of this module
 873                   -> Maybe [IE any]             -- Export list for this module
 874                   -> RnMG (VersionInfo Name)    -- Version info for these names
 875
 876 getImportVersions this_mod exports
 877   = getIfacesRn                                 `thenRn` \ ifaces ->
 878     let
 879         mod_map   = iModMap ifaces
 880         imp_names = iVSlurp ifaces
 881
 882         -- mv_map groups together all the things imported from a particular module.
 883         mv_map, mv_map_mod :: FiniteMap Module (WhatsImported Name)
 884
 885         mv_map_mod = foldl add_mod emptyFM export_mods
 886                 -- mv_map_mod records all the modules that have a "module M"
 887                 -- in this module's export list with an "Everything"
 888
 889         mv_map = foldl add_mv mv_map_mod imp_names
 890                 -- mv_map adds the version numbers of things exported individually
 891
 892         mk_version_info (mod, local_versions)
 893            = case lookupFM mod_map mod of
 894                 Just (hif, version, _) -> (mod, version, local_versions)
 895     in
 896     returnRn (map mk_version_info (fmToList mv_map))
 897   where
 898      export_mods = case exports of
 899                         Nothing -> []
 900                         Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
 901
 902      add_mv mv_map v@(name, version)
 903       = addToFM_C add_item mv_map mod (Specifically [v])
 904         where
 905          mod = nameModule name
 906
 907          add_item Everything        _ = Everything
 908          add_item (Specifically xs) _ = Specifically (v:xs)
 909
 910      add_mod mv_map mod = addToFM mv_map mod Everything
 911 \end{code}
 912
 913 \begin{code}
 914 checkSlurped name
 915   = getIfacesRn         `thenRn` \ ifaces ->
 916     returnRn (name `elemNameSet` iSlurp ifaces)
 917
 918 getSlurpedNames :: RnMG NameSet
 919 getSlurpedNames
 920   = getIfacesRn         `thenRn` \ ifaces ->
 921     returnRn (iSlurp ifaces)
 922
 923 recordSlurp maybe_version necessity avail
 924   = {- traceRn (hsep [text "Record slurp:", pprAvail avail,
 925                                         -- NB PprForDebug prints export flag, which is too
 926                                         -- strict; it's a knot-tied thing in RnNames
 927                   case necessity of {Compulsory -> text "comp"; Optional -> text "opt" } ])     `thenRn_`
 928     -}
 929     getIfacesRn         `thenRn` \ ifaces ->
 930     let
 931         Ifaces { iSlurp    = slurped_names,
 932                  iVSlurp   = imp_names,
 933                  iDefInsts = (insts, tycls_names) } = ifaces
 934
 935         new_slurped_names = addAvailToNameSet slurped_names avail
 936
 937         new_imp_names = case maybe_version of
 938                            Just version -> (availName avail, version) : imp_names
 939                            Nothing      -> imp_names
 940
 941                 -- Add to the names that will let in instance declarations;
 942                 -- but only (a) if it's a type/class
 943                 --          (b) if it's compulsory (unless the test flag opt_PruneInstDecls is off)
 944         new_tycls_names = case avail of
 945                                 AvailTC tc _  | not opt_PruneInstDecls ||
 946                                                 case necessity of {Optional -> False; Compulsory -> True }
 947                                               -> tycls_names `addOneToNameSet` tc
 948                                 otherwise     -> tycls_names
 949
 950         new_ifaces = ifaces { iSlurp    = new_slurped_names,
 951                               iVSlurp   = new_imp_names,
 952                               iDefInsts = (insts, new_tycls_names) }
 953     in
 954     setIfacesRn new_ifaces
 955 \end{code}
 956
 957
 958 %*********************************************************
 959 %*                                                      *
 960 \subsection{Getting binders out of a declaration}
 961 %*                                                      *
 962 %*********************************************************
 963
 964 @getDeclBinders@ returns the names for a @RdrNameHsDecl@.
 965 It's used for both source code (from @availsFromDecl@) and interface files
 966 (from @loadDecl@).
 967
 968 It doesn't deal with source-code specific things: ValD, DefD.  They
 969 are handled by the sourc-code specific stuff in RnNames.
 970
 971 \begin{code}
 972 getDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)      -- New-name function
 973                 -> RdrNameHsDecl
 974                 -> RnMG (Maybe AvailInfo)
 975
 976 getDeclBinders new_name (TyClD (TyData _ _ tycon _ condecls _ _ src_loc))
 977   = new_name tycon src_loc                      `thenRn` \ tycon_name ->
 978     getConFieldNames new_name condecls          `thenRn` \ sub_names ->
 979     returnRn (Just (AvailTC tycon_name (tycon_name : nub sub_names)))
 980         -- The "nub" is because getConFieldNames can legitimately return duplicates,
 981         -- when a record declaration has the same field in multiple constructors
 982
 983 getDeclBinders new_name (TyClD (TySynonym tycon _ _ src_loc))
 984   = new_name tycon src_loc              `thenRn` \ tycon_name ->
 985     returnRn (Just (AvailTC tycon_name [tycon_name]))
 986
 987 getDeclBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc))
 988   = new_name cname src_loc                      `thenRn` \ class_name ->
 989
 990         -- Record the names for the class ops
 991     let
 992         -- ignoring fixity declarations
 993         nonfix_sigs = nonFixitySigs sigs
 994     in
 995     mapRn (getClassOpNames new_name) nonfix_sigs        `thenRn` \ sub_names ->
 996
 997     returnRn (Just (AvailTC class_name (class_name : sub_names)))
 998
 999 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
1000   = new_name var src_loc                        `thenRn` \ var_name ->
1001     returnRn (Just (Avail var_name))
1002
1003 getDeclBinders new_name (FixD _)  = returnRn Nothing
1004 getDeclBinders new_name (ForD _)  = returnRn Nothing
1005 getDeclBinders new_name (DefD _)  = returnRn Nothing
1006 getDeclBinders new_name (InstD _) = returnRn Nothing
1007
1008 ----------------
1009 getConFieldNames new_name (ConDecl con _ _ (RecCon fielddecls) src_loc : rest)
1010   = mapRn (\n -> new_name n src_loc) (con:fields)       `thenRn` \ cfs ->
1011     getConFieldNames new_name rest                      `thenRn` \ ns  ->
1012     returnRn (cfs ++ ns)
1013   where
1014     fields = concat (map fst fielddecls)
1015
1016 getConFieldNames new_name (ConDecl con _ _ condecl src_loc : rest)
1017   = new_name con src_loc                `thenRn` \ n ->
1018     (case condecl of
1019       NewCon _ (Just f) ->
1020         new_name f src_loc `thenRn` \ new_f ->
1021         returnRn [n,new_f]
1022       _ -> returnRn [n])                `thenRn` \ nn ->
1023     getConFieldNames new_name rest      `thenRn` \ ns ->
1024     returnRn (nn ++ ns)
1025
1026 getConFieldNames new_name [] = returnRn []
1027
1028 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
1029 \end{code}
1030
1031 @getDeclSysBinders@ gets the implicit binders introduced by a decl.
1032 A the moment that's just the tycon and datacon that come with a class decl.
1033 They aren'te returned by getDeclBinders because they aren't in scope;
1034 but they *should* be put into the DeclsMap of this module.
1035
1036 \begin{code}
1037 getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc))
1038   = new_name dname src_loc                      `thenRn` \ datacon_name ->
1039     new_name tname src_loc                      `thenRn` \ tycon_name ->
1040     returnRn [tycon_name, datacon_name]
1041
1042 getDeclSysBinders new_name other_decl
1043   = returnRn []
1044 \end{code}
1045
1046 %*********************************************************
1047 %*                                                      *
1048 \subsection{Reading an interface file}
1049 %*                                                      *
1050 %*********************************************************
1051
1052 \begin{code}
1053 findAndReadIface :: SDoc -> Module -> RnMG (Maybe (Module, ParsedIface))
1054         -- Nothing <=> file not found, or unreadable, or illegible
1055         -- Just x  <=> successfully found and parsed
1056
1057 findAndReadIface doc_str mod_name
1058   = traceRn trace_msg                   `thenRn_`
1059       -- we keep two maps for interface files,
1060       -- one for 'normal' ones, the other for .hi-boot files,
1061       -- hence the need to signal which kind we're interested.
1062     getModuleHiMap from_hi_boot         `thenRn` \ himap ->
1063     case (lookupFM himap (moduleUserString mod_name)) of
1064          -- Found the file
1065        Just fpath -> readIface mod_name fpath
1066        Nothing    -> traceRn (ptext SLIT("...failed"))  `thenRn_`
1067                      returnRn Nothing
1068   where
1069     hif          = moduleIfaceFlavour mod_name
1070     from_hi_boot = bootFlavour hif
1071
1072     trace_msg = sep [hsep [ptext SLIT("Reading"),
1073                            if from_hi_boot then ptext SLIT("[boot]") else empty,
1074                            ptext SLIT("interface for"),
1075                            pprModule mod_name <> semi],
1076                      nest 4 (ptext SLIT("reason:") <+> doc_str)]
1077 \end{code}
1078
1079 @readIface@ tries just the one file.
1080
1081 \begin{code}
1082 readIface :: Module -> (String, Bool) -> RnMG (Maybe (Module, ParsedIface))
1083         -- Nothing <=> file not found, or unreadable, or illegible
1084         -- Just x  <=> successfully found and parsed
1085 readIface requested_mod (file_path, is_dll)
1086   = ioToRnMG (hGetStringBuffer file_path)       `thenRn` \ read_result ->
1087     case read_result of
1088         Right contents    ->
1089              case parseIface contents (mkSrcLoc (mkFastString file_path) 1) of
1090                   Failed err                    -> failWithRn Nothing err
1091                   Succeeded (PIface mod_nm iface) ->
1092                             (if mod_nm /=  moduleFS requested_mod then
1093                                 addWarnRn (hsep [ ptext SLIT("Something is amiss; requested module name")
1094                                                 , pprModule requested_mod
1095                                                 , ptext SLIT("differs from name found in the interface file ")
1096                                                 , pprEncodedFS mod_nm
1097                                                 ])
1098                              else
1099                                 returnRn ())        `thenRn_`
1100                             let
1101                              the_mod
1102                                | is_dll    = mkDynamicModule requested_mod
1103                                | otherwise = requested_mod
1104                             in
1105                             if opt_D_show_rn_imports then
1106                                putDocRn (hcat[ptext SLIT("Read module "), pprEncodedFS mod_nm,
1107                                               ptext SLIT(" from "), text file_path]) `thenRn_`
1108                                returnRn (Just (the_mod, iface))
1109                             else
1110                                returnRn (Just (the_mod, iface))
1111
1112         Left err
1113           | isDoesNotExistError err -> returnRn Nothing
1114           | otherwise               -> failWithRn Nothing (cannaeReadFile file_path err)
1115
1116 \end{code}
1117
1118 %*********************************************************
1119 %*                                                       *
1120 \subsection{Utils}
1121 %*                                                       *
1122 %*********************************************************
1123
1124 @mkSearchPath@ takes a string consisting of a colon-separated list
1125 of directories and corresponding suffixes, and turns it into a list
1126 of (directory, suffix) pairs.  For example:
1127
1128 \begin{verbatim}
1129  mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
1130    = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
1131 \begin{verbatim}
1132
1133 \begin{code}
1134 mkSearchPath :: Maybe String -> SearchPath
1135 mkSearchPath Nothing = [(".",".hi")]  -- ToDo: default should be to look in
1136                                       -- the directory the module we're compiling
1137                                       -- lives.
1138 mkSearchPath (Just s) = go s
1139   where
1140     go "" = []
1141     go s  =
1142       case span (/= '%') s of
1143        (dir,'%':rs) ->
1144          case span (/= ':') rs of
1145           (hisuf,_:rest) -> (dir,hisuf):go rest
1146           (hisuf,[])     -> [(dir,hisuf)]
1147 \end{code}
1148
1149 %*********************************************************
1150 %*                                                       *
1151 \subsection{Errors}
1152 %*                                                       *
1153 %*********************************************************
1154
1155 \begin{code}
1156 noIfaceErr filename
1157   = hcat [ptext SLIT("Could not find valid interface file "),
1158           quotes (pprModule filename)]
1159
1160 cannaeReadFile file err
1161   = hcat [ptext SLIT("Failed in reading file: "),
1162           text file,
1163           ptext SLIT("; error="),
1164           text (show err)]
1165
1166 getDeclErr name loc
1167   = sep [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
1168          ptext SLIT("needed at") <+> ppr loc]
1169
1170 getDeclWarn name loc
1171   = sep [ptext SLIT("Failed to find (optional) interface decl for") <+> quotes (ppr name),
1172          ptext SLIT("desired at") <+> ppr loc]
1173
1174 importDeclWarn mod name loc
1175   = sep [ptext SLIT("Compiler tried to import decl from interface file with same name as module."),
1176          ptext SLIT("(possible cause: module name clashes with interface file already in scope.)")
1177         ] $$
1178     hsep [ptext SLIT("Interface:"), quotes (pprModule mod), comma, ptext SLIT("name:"), quotes (ppr name),
1179           comma, ptext SLIT("desired at:"), ppr loc
1180          ]
1181
1182 \end{code}