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, isClassOpSig
  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   |  null condecls ||
 695         -- HACK ALERT!  If the data type is abstract then it must from a
 696         -- hand-written hi-boot file.  We put it in the deferred pile unconditionally,
 697         -- because we don't want to read it in, and then later find a decl for a constructor
 698         -- from that type, read the real interface file, and read in the full data type
 699         -- decl again!!!
 700
 701      (needed_name == tycon_name
 702      && opt_PruneTyDecls
 703         -- don't prune newtypes, as the code generator may
 704         -- want to peer inside a newtype type constructor
 705         -- (ClosureInfo.fun_result_ty is the culprit.)
 706      && not (new_or_data == NewType)
 707      && not (nameUnique needed_name `elem` cCallishTyKeys))
 708         -- Hack!  Don't prune these tycons whose constructors
 709         -- the desugarer must be able to see when desugaring
 710         -- a CCall.  Ugh!
 711
 712   =     -- Need the type constructor; so put it in the deferred set for now
 713     getIfacesRn                 `thenRn` \ ifaces ->
 714     let
 715         deferred_data_decls = iDefData ifaces
 716         new_ifaces          = ifaces {iDefData = new_deferred_data_decls}
 717
 718         no_constr_ty_decl       = TyData new_or_data [] tycon tyvars [] derivings pragmas src_loc
 719         new_deferred_data_decls = addToNameEnv deferred_data_decls tycon_name
 720                                                (nameModule tycon_name, no_constr_ty_decl)
 721                 -- Nota bene: we nuke both the constructors and the context in the deferred decl.
 722                 -- If we don't nuke the context then renaming the deferred data decls can give
 723                 -- new unresolved names (for the classes).  This could be handled, but there's
 724                 -- no point.  If the data type is completely abstract then we aren't interested
 725                 -- its context.
 726     in
 727     setIfacesRn new_ifaces      `thenRn_`
 728     returnRn (AvailTC tycon_name [tycon_name], Nothing)
 729
 730   | otherwise
 731   =     -- Need a data constructor, so delete the data decl from the deferred set if it's there
 732     getIfacesRn                 `thenRn` \ ifaces ->
 733     let
 734         deferred_data_decls = iDefData ifaces
 735         new_ifaces          = ifaces {iDefData = new_deferred_data_decls}
 736
 737         new_deferred_data_decls = delFromNameEnv deferred_data_decls tycon_name
 738     in
 739     setIfacesRn new_ifaces      `thenRn_`
 740     returnRn (avail, Just (TyClD ty_decl))
 741 \end{code}
 742
 743 \begin{code}
 744 getDeferredDataDecls :: RnMG [(Module, RdrNameTyClDecl)]
 745 getDeferredDataDecls
 746   = getIfacesRn                 `thenRn` \ ifaces ->
 747     let
 748         deferred_list = nameEnvElts (iDefData ifaces)
 749         trace_msg = hang (text "Slurping abstract data/newtype decls for: ")
 750                         4 (ppr (map fst deferred_list))
 751     in
 752     traceRn trace_msg                   `thenRn_`
 753     returnRn deferred_list
 754 \end{code}
 755
 756
 757 %*********************************************************
 758 %*                                                      *
 759 \subsection{Instance declarations are handled specially}
 760 %*                                                      *
 761 %*********************************************************
 762
 763 \begin{code}
 764 getImportedInstDecls :: RnMG [(Module,RdrNameInstDecl)]
 765 getImportedInstDecls
 766   =     -- First load any special-instance modules that aren't aready loaded
 767     getSpecialInstModules                       `thenRn` \ inst_mods ->
 768     mapRn_ load_it inst_mods                    `thenRn_`
 769
 770         -- Now we're ready to grab the instance declarations
 771         -- Find the un-gated ones and return them,
 772         -- removing them from the bag kept in Ifaces
 773     getIfacesRn         `thenRn` \ ifaces ->
 774     let
 775         (insts, tycls_names) = iDefInsts ifaces
 776
 777                 -- An instance decl is ungated if all its gates have been slurped
 778         select_ungated :: IfaceInst                                     -- A gated inst decl
 779
 780                        -> ([(Module, RdrNameInstDecl)], [IfaceInst])    -- Accumulator
 781
 782                        -> ([(Module, RdrNameInstDecl)],                 -- The ungated ones
 783                            [IfaceInst])                                 -- Still gated, but with
 784                                                                         -- depeleted gates
 785         select_ungated (decl,gates) (ungated_decls, gated_decls)
 786           | isEmptyNameSet remaining_gates
 787           = (decl : ungated_decls, gated_decls)
 788           | otherwise
 789           = (ungated_decls, (decl, remaining_gates) : gated_decls)
 790           where
 791             remaining_gates = gates `minusNameSet` tycls_names
 792
 793         (un_gated_insts, still_gated_insts) = foldrBag select_ungated ([], []) insts
 794
 795         new_ifaces = ifaces {iDefInsts = (listToBag still_gated_insts, tycls_names)}
 796                                 -- NB: don't throw away tycls_names;
 797                                 -- we may comre across more instance decls
 798     in
 799     traceRn (sep [text "getInstDecls:", fsep (map ppr (nameSetToList tycls_names))])    `thenRn_`
 800     setIfacesRn new_ifaces      `thenRn_`
 801     returnRn un_gated_insts
 802   where
 803     load_it mod = loadInterface (doc_str mod) mod
 804     doc_str mod = sep [pprModule mod, ptext SLIT("is a special-instance module")]
 805
 806
 807 getSpecialInstModules :: RnMG [Module]
 808 getSpecialInstModules
 809   = getIfacesRn                                         `thenRn` \ ifaces ->
 810     returnRn (iInstMods ifaces)
 811
 812 getImportedFixities :: GlobalRdrEnv -> RnMG FixityEnv
 813         -- Get all imported fixities
 814         -- We first make sure that all the home modules
 815         -- of all in-scope variables are loaded.
 816 getImportedFixities gbl_env
 817   = let
 818         home_modules = [ nameModule name | names <- rdrEnvElts gbl_env,
 819                                            name <- names,
 820                                            not (isLocallyDefined name)
 821                        ]
 822     in
 823     mapRn_ load (nub home_modules)      `thenRn_`
 824
 825         -- Now we can snaffle the fixity env
 826     getIfacesRn                                         `thenRn` \ ifaces ->
 827     returnRn (iFixes ifaces)
 828   where
 829     load mod = loadInterface doc_str mod
 830              where
 831                doc_str = ptext SLIT("Need fixities from") <+> ppr mod
 832 \end{code}
 833
 834
 835 %*********************************************************
 836 %*                                                      *
 837 \subsection{Keeping track of what we've slurped, and version numbers}
 838 %*                                                      *
 839 %*********************************************************
 840
 841 getImportVersions figures out what the "usage information" for this moudule is;
 842 that is, what it must record in its interface file as the things it uses.
 843 It records:
 844         - anything reachable from its body code
 845         - any module exported with a "module Foo".
 846
 847 Why the latter?  Because if Foo changes then this module's export list
 848 will change, so we must recompile this module at least as far as
 849 making a new interface file --- but in practice that means complete
 850 recompilation.
 851
 852 What about this?
 853         module A( f, g ) where          module B( f ) where
 854           import B( f )                   f = h 3
 855           g = ...                         h = ...
 856
 857 Should we record B.f in A's usages?  In fact we don't.  Certainly, if
 858 anything about B.f changes than anyone who imports A should be recompiled;
 859 they'll get an early exit if they don't use B.f.  However, even if B.f
 860 doesn't change at all, B.h may do so, and this change may not be reflected
 861 in f's version number.  So there are two things going on when compiling module A:
 862
 863 1.  Are A.o and A.hi correct?  Then we can bale out early.
 864 2.  Should modules that import A be recompiled?
 865
 866 For (1) it is slightly harmful to record B.f in A's usages, because a change in
 867 B.f's version will provoke full recompilation of A, producing an identical A.o,
 868 and A.hi differing only in its usage-version of B.f (which isn't used by any importer).
 869
 870 For (2), because of the tricky B.h question above, we ensure that A.hi is touched
 871 (even if identical to its previous version) if A's recompilation was triggered by
 872 an imported .hi file date change.  Given that, there's no need to record B.f in
 873 A's usages.
 874
 875 On the other hand, if A exports "module B" then we *do* count module B among
 876 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
 877
 878 \begin{code}
 879 getImportVersions :: Module                     -- Name of this module
 880                   -> Maybe [IE any]             -- Export list for this module
 881                   -> RnMG (VersionInfo Name)    -- Version info for these names
 882
 883 getImportVersions this_mod exports
 884   = getIfacesRn                                 `thenRn` \ ifaces ->
 885     let
 886         mod_map   = iModMap ifaces
 887         imp_names = iVSlurp ifaces
 888
 889         -- mv_map groups together all the things imported from a particular module.
 890         mv_map, mv_map_mod :: FiniteMap Module (WhatsImported Name)
 891
 892         mv_map_mod = foldl add_mod emptyFM export_mods
 893                 -- mv_map_mod records all the modules that have a "module M"
 894                 -- in this module's export list with an "Everything"
 895
 896         mv_map = foldl add_mv mv_map_mod imp_names
 897                 -- mv_map adds the version numbers of things exported individually
 898
 899         mk_version_info (mod, local_versions)
 900            = case lookupFM mod_map mod of
 901                 Just (hif, version, _) -> (mod, version, local_versions)
 902     in
 903     returnRn (map mk_version_info (fmToList mv_map))
 904   where
 905      export_mods = case exports of
 906                         Nothing -> []
 907                         Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
 908
 909      add_mv mv_map v@(name, version)
 910       = addToFM_C add_item mv_map mod (Specifically [v])
 911         where
 912          mod = nameModule name
 913
 914          add_item Everything        _ = Everything
 915          add_item (Specifically xs) _ = Specifically (v:xs)
 916
 917      add_mod mv_map mod = addToFM mv_map mod Everything
 918 \end{code}
 919
 920 \begin{code}
 921 checkSlurped name
 922   = getIfacesRn         `thenRn` \ ifaces ->
 923     returnRn (name `elemNameSet` iSlurp ifaces)
 924
 925 getSlurpedNames :: RnMG NameSet
 926 getSlurpedNames
 927   = getIfacesRn         `thenRn` \ ifaces ->
 928     returnRn (iSlurp ifaces)
 929
 930 recordSlurp maybe_version necessity avail
 931   = {- traceRn (hsep [text "Record slurp:", pprAvail avail,
 932                                         -- NB PprForDebug prints export flag, which is too
 933                                         -- strict; it's a knot-tied thing in RnNames
 934                   case necessity of {Compulsory -> text "comp"; Optional -> text "opt" } ])     `thenRn_`
 935     -}
 936     getIfacesRn         `thenRn` \ ifaces ->
 937     let
 938         Ifaces { iSlurp    = slurped_names,
 939                  iVSlurp   = imp_names,
 940                  iDefInsts = (insts, tycls_names) } = ifaces
 941
 942         new_slurped_names = addAvailToNameSet slurped_names avail
 943
 944         new_imp_names = case maybe_version of
 945                            Just version -> (availName avail, version) : imp_names
 946                            Nothing      -> imp_names
 947
 948                 -- Add to the names that will let in instance declarations;
 949                 -- but only (a) if it's a type/class
 950                 --          (b) if it's compulsory (unless the test flag opt_PruneInstDecls is off)
 951         new_tycls_names = case avail of
 952                                 AvailTC tc _  | not opt_PruneInstDecls ||
 953                                                 case necessity of {Optional -> False; Compulsory -> True }
 954                                               -> tycls_names `addOneToNameSet` tc
 955                                 otherwise     -> tycls_names
 956
 957         new_ifaces = ifaces { iSlurp    = new_slurped_names,
 958                               iVSlurp   = new_imp_names,
 959                               iDefInsts = (insts, new_tycls_names) }
 960     in
 961     setIfacesRn new_ifaces
 962 \end{code}
 963
 964
 965 %*********************************************************
 966 %*                                                      *
 967 \subsection{Getting binders out of a declaration}
 968 %*                                                      *
 969 %*********************************************************
 970
 971 @getDeclBinders@ returns the names for a @RdrNameHsDecl@.
 972 It's used for both source code (from @availsFromDecl@) and interface files
 973 (from @loadDecl@).
 974
 975 It doesn't deal with source-code specific things: ValD, DefD.  They
 976 are handled by the sourc-code specific stuff in RnNames.
 977
 978 \begin{code}
 979 getDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)      -- New-name function
 980                 -> RdrNameHsDecl
 981                 -> RnMG (Maybe AvailInfo)
 982
 983 getDeclBinders new_name (TyClD (TyData _ _ tycon _ condecls _ _ src_loc))
 984   = new_name tycon src_loc                      `thenRn` \ tycon_name ->
 985     getConFieldNames new_name condecls          `thenRn` \ sub_names ->
 986     returnRn (Just (AvailTC tycon_name (tycon_name : nub sub_names)))
 987         -- The "nub" is because getConFieldNames can legitimately return duplicates,
 988         -- when a record declaration has the same field in multiple constructors
 989
 990 getDeclBinders new_name (TyClD (TySynonym tycon _ _ src_loc))
 991   = new_name tycon src_loc              `thenRn` \ tycon_name ->
 992     returnRn (Just (AvailTC tycon_name [tycon_name]))
 993
 994 getDeclBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc))
 995   = new_name cname src_loc                      `thenRn` \ class_name ->
 996
 997         -- Record the names for the class ops
 998     let
 999         -- just want class-op sigs
1000         op_sigs = filter isClassOpSig sigs
1001     in
1002     mapRn (getClassOpNames new_name) op_sigs    `thenRn` \ sub_names ->
1003
1004     returnRn (Just (AvailTC class_name (class_name : sub_names)))
1005
1006 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
1007   = new_name var src_loc                        `thenRn` \ var_name ->
1008     returnRn (Just (Avail var_name))
1009
1010 getDeclBinders new_name (FixD _)  = returnRn Nothing
1011 getDeclBinders new_name (ForD _)  = returnRn Nothing
1012 getDeclBinders new_name (DefD _)  = returnRn Nothing
1013 getDeclBinders new_name (InstD _) = returnRn Nothing
1014
1015 ----------------
1016 getConFieldNames new_name (ConDecl con _ _ (RecCon fielddecls) src_loc : rest)
1017   = mapRn (\n -> new_name n src_loc) (con:fields)       `thenRn` \ cfs ->
1018     getConFieldNames new_name rest                      `thenRn` \ ns  ->
1019     returnRn (cfs ++ ns)
1020   where
1021     fields = concat (map fst fielddecls)
1022
1023 getConFieldNames new_name (ConDecl con _ _ condecl src_loc : rest)
1024   = new_name con src_loc                `thenRn` \ n ->
1025     (case condecl of
1026       NewCon _ (Just f) ->
1027         new_name f src_loc `thenRn` \ new_f ->
1028         returnRn [n,new_f]
1029       _ -> returnRn [n])                `thenRn` \ nn ->
1030     getConFieldNames new_name rest      `thenRn` \ ns ->
1031     returnRn (nn ++ ns)
1032
1033 getConFieldNames new_name [] = returnRn []
1034
1035 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
1036 \end{code}
1037
1038 @getDeclSysBinders@ gets the implicit binders introduced by a decl.
1039 A the moment that's just the tycon and datacon that come with a class decl.
1040 They aren'te returned by getDeclBinders because they aren't in scope;
1041 but they *should* be put into the DeclsMap of this module.
1042
1043 \begin{code}
1044 getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc))
1045   = new_name dname src_loc                      `thenRn` \ datacon_name ->
1046     new_name tname src_loc                      `thenRn` \ tycon_name ->
1047     returnRn [tycon_name, datacon_name]
1048
1049 getDeclSysBinders new_name other_decl
1050   = returnRn []
1051 \end{code}
1052
1053 %*********************************************************
1054 %*                                                      *
1055 \subsection{Reading an interface file}
1056 %*                                                      *
1057 %*********************************************************
1058
1059 \begin{code}
1060 findAndReadIface :: SDoc -> Module -> RnMG (Maybe (Module, ParsedIface))
1061         -- Nothing <=> file not found, or unreadable, or illegible
1062         -- Just x  <=> successfully found and parsed
1063
1064 findAndReadIface doc_str mod_name
1065   = traceRn trace_msg                   `thenRn_`
1066       -- we keep two maps for interface files,
1067       -- one for 'normal' ones, the other for .hi-boot files,
1068       -- hence the need to signal which kind we're interested.
1069     getModuleHiMap from_hi_boot         `thenRn` \ himap ->
1070     case (lookupFM himap (moduleUserString mod_name)) of
1071          -- Found the file
1072        Just fpath -> readIface mod_name fpath
1073        Nothing    -> traceRn (ptext SLIT("...failed"))  `thenRn_`
1074                      returnRn Nothing
1075   where
1076     hif          = moduleIfaceFlavour mod_name
1077     from_hi_boot = bootFlavour hif
1078
1079     trace_msg = sep [hsep [ptext SLIT("Reading"),
1080                            if from_hi_boot then ptext SLIT("[boot]") else empty,
1081                            ptext SLIT("interface for"),
1082                            pprModule mod_name <> semi],
1083                      nest 4 (ptext SLIT("reason:") <+> doc_str)]
1084 \end{code}
1085
1086 @readIface@ tries just the one file.
1087
1088 \begin{code}
1089 readIface :: Module -> (String, Bool) -> RnMG (Maybe (Module, ParsedIface))
1090         -- Nothing <=> file not found, or unreadable, or illegible
1091         -- Just x  <=> successfully found and parsed
1092 readIface requested_mod (file_path, is_dll)
1093   = ioToRnMG (hGetStringBuffer file_path)       `thenRn` \ read_result ->
1094     case read_result of
1095         Right contents    ->
1096              case parseIface contents (mkSrcLoc (mkFastString file_path) 1) of
1097                   Failed err                    -> failWithRn Nothing err
1098                   Succeeded (PIface mod_nm iface) ->
1099                             (if mod_nm /=  moduleFS requested_mod then
1100                                 addWarnRn (hsep [ ptext SLIT("Something is amiss; requested module name")
1101                                                 , pprModule requested_mod
1102                                                 , ptext SLIT("differs from name found in the interface file ")
1103                                                 , pprEncodedFS mod_nm
1104                                                 ])
1105                              else
1106                                 returnRn ())        `thenRn_`
1107                             let
1108                              the_mod
1109                                | is_dll    = mkDynamicModule requested_mod
1110                                | otherwise = requested_mod
1111                             in
1112                             if opt_D_show_rn_imports then
1113                                putDocRn (hcat[ptext SLIT("Read module "), pprEncodedFS mod_nm,
1114                                               ptext SLIT(" from "), text file_path]) `thenRn_`
1115                                returnRn (Just (the_mod, iface))
1116                             else
1117                                returnRn (Just (the_mod, iface))
1118
1119         Left err
1120           | isDoesNotExistError err -> returnRn Nothing
1121           | otherwise               -> failWithRn Nothing (cannaeReadFile file_path err)
1122
1123 \end{code}
1124
1125 %*********************************************************
1126 %*                                                       *
1127 \subsection{Utils}
1128 %*                                                       *
1129 %*********************************************************
1130
1131 @mkSearchPath@ takes a string consisting of a colon-separated list
1132 of directories and corresponding suffixes, and turns it into a list
1133 of (directory, suffix) pairs.  For example:
1134
1135 \begin{verbatim}
1136  mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
1137    = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
1138 \begin{verbatim}
1139
1140 \begin{code}
1141 mkSearchPath :: Maybe String -> SearchPath
1142 mkSearchPath Nothing = [(".",".hi")]  -- ToDo: default should be to look in
1143                                       -- the directory the module we're compiling
1144                                       -- lives.
1145 mkSearchPath (Just s) = go s
1146   where
1147     go "" = []
1148     go s  =
1149       case span (/= '%') s of
1150        (dir,'%':rs) ->
1151          case span (/= ':') rs of
1152           (hisuf,_:rest) -> (dir,hisuf):go rest
1153           (hisuf,[])     -> [(dir,hisuf)]
1154 \end{code}
1155
1156 %*********************************************************
1157 %*                                                       *
1158 \subsection{Errors}
1159 %*                                                       *
1160 %*********************************************************
1161
1162 \begin{code}
1163 noIfaceErr filename
1164   = hcat [ptext SLIT("Could not find valid interface file "),
1165           quotes (pprModule filename)]
1166
1167 cannaeReadFile file err
1168   = hcat [ptext SLIT("Failed in reading file: "),
1169           text file,
1170           ptext SLIT("; error="),
1171           text (show err)]
1172
1173 getDeclErr name loc
1174   = sep [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
1175          ptext SLIT("needed at") <+> ppr loc]
1176
1177 getDeclWarn name loc
1178   = sep [ptext SLIT("Failed to find (optional) interface decl for") <+> quotes (ppr name),
1179          ptext SLIT("desired at") <+> ppr loc]
1180
1181 importDeclWarn mod name loc
1182   = sep [ptext SLIT("Compiler tried to import decl from interface file with same name as module."),
1183          ptext SLIT("(possible cause: module name clashes with interface file already in scope.)")
1184         ] $$
1185     hsep [ptext SLIT("Interface:"), quotes (pprModule mod), comma, ptext SLIT("name:"), quotes (ppr name),
1186           comma, ptext SLIT("desired at:"), ppr loc
1187          ]
1188
1189 \end{code}