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