ghc/compiler/rename/RnHiFiles.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section{Dealing with interface files}
   5
   6 \begin{code}
   7 module RnHiFiles (
   8         readIface, loadInterface, loadHomeInterface,
   9         loadOrphanModules,
  10         loadOldIface,
  11         ParsedIface(..)
  12    ) where
  13
  14 #include "HsVersions.h"
  15
  16 import DriverState      ( v_GhcMode, isCompManagerMode )
  17 import DriverUtil       ( splitFilename, replaceFilenameSuffix )
  18 import CmdLineOpts      ( opt_IgnoreIfacePragmas )
  19 import Parser           ( parseIface )
  20 import HscTypes         ( ModIface(..), emptyModIface,
  21                           ExternalPackageState(..),
  22                           VersionInfo(..), Usage(..),
  23                           lookupIfaceByModName, RdrExportItem,
  24                           WhetherHasOrphans, IsBootInterface,
  25                           DeclsMap, GatedDecl, IfaceInsts, IfaceRules, mkIfaceDecls,
  26                           AvailInfo, GenAvailInfo(..), ParsedIface(..), IfaceDeprecs,
  27                           Avails, availNames, availName, Deprecations(..)
  28                          )
  29 import HsSyn            ( TyClDecl(..), InstDecl(..), RuleDecl(..), ConDecl(..),
  30                           hsTyVarNames, splitHsInstDeclTy, tyClDeclName, tyClDeclNames
  31                         )
  32 import RdrHsSyn         ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl )
  33 import RnHsSyn          ( RenamedInstDecl, RenamedRuleDecl, RenamedTyClDecl,
  34                           extractHsTyNames_s )
  35 import BasicTypes       ( Version, FixitySig(..), Fixity(..), FixityDirection(..) )
  36 import RnSource         ( rnIfaceRuleDecl, rnTyClDecl, rnInstDecl )
  37 import RnTypes          ( rnHsType )
  38 import RnEnv
  39 import TcRnMonad
  40
  41 import PrelNames        ( gHC_PRIM_Name, gHC_PRIM )
  42 import PrelInfo         ( ghcPrimExports, cCallableClassDecl, cReturnableClassDecl )
  43 import Name             ( Name {-instance NamedThing-},
  44                           nameModule, isInternalName )
  45 import NameEnv
  46 import NameSet
  47 import Id               ( idName )
  48 import MkId             ( seqId )
  49 import Packages         ( basePackage )
  50 import Module           ( Module, ModuleName, ModLocation(ml_hi_file),
  51                           moduleName, isHomeModule, mkPackageModule,
  52                           extendModuleEnv, lookupModuleEnvByName
  53                         )
  54 import RdrName          ( RdrName, mkRdrUnqual, rdrNameOcc, nameRdrName )
  55 import OccName          ( OccName, mkWorkerOcc, mkClassTyConOcc, mkClassDataConOcc,
  56                           mkSuperDictSelOcc, mkGenOcc1, mkGenOcc2 )
  57 import TyCon            ( DataConDetails(..) )
  58 import SrcLoc           ( noSrcLoc, mkSrcLoc )
  59 import Maybes           ( maybeToBool )
  60 import StringBuffer     ( hGetStringBuffer )
  61 import FastString       ( mkFastString )
  62 import ErrUtils         ( Message )
  63 import Finder           ( findModule, findPackageModule,
  64                           hiBootExt, hiBootVerExt )
  65 import Lex
  66 import FiniteMap
  67 import ListSetOps       ( minusList )
  68 import Outputable
  69 import Bag
  70 import BinIface         ( readBinIface )
  71 import Panic
  72 import Config
  73
  74 import EXCEPTION as Exception
  75 import DATA_IOREF       ( readIORef )
  76
  77 import Directory
  78 \end{code}
  79
  80
  81 %*********************************************************
  82 %*                                                      *
  83 \subsection{Loading a new interface file}
  84 %*                                                      *
  85 %*********************************************************
  86
  87 \begin{code}
  88 loadHomeInterface :: SDoc -> Name -> TcRn m ModIface
  89 loadHomeInterface doc_str name
  90   = ASSERT2( not (isInternalName name), ppr name <+> parens doc_str )
  91     loadInterface doc_str (moduleName (nameModule name)) ImportBySystem
  92
  93 loadOrphanModules :: [ModuleName] -> TcRn m ()
  94 loadOrphanModules mods
  95   | null mods = returnM ()
  96   | otherwise = traceRn (text "Loading orphan modules:" <+>
  97                          fsep (map ppr mods))                   `thenM_`
  98                 mappM_ load mods                                `thenM_`
  99                 returnM ()
 100   where
 101     load mod   = loadInterface (mk_doc mod) mod ImportBySystem
 102     mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
 103
 104 loadInterface :: SDoc -> ModuleName -> WhereFrom -> TcRn m ModIface
 105   -- Returns Nothing if failed
 106   -- If we can't find an interface file, and we are doing ImportForUsage,
 107   --    just fail in the monad, and modify anything else
 108   -- Otherwise, if we can't find an interface file,
 109   --    add an error message to the monad (the first time only)
 110   --    and return emptyIface
 111   -- The "first time only" part is done by modifying the PackageIfaceTable
 112   --            to have an empty entry
 113   --
 114   -- The ImportForUsage case is because when we read the usage information from
 115   -- an interface file, we try to read the interfaces it mentions.
 116   -- But it's OK to fail; perhaps the module has changed, and that interface
 117   -- is no longer used.
 118
 119 loadInterface doc_str mod_name from
 120  = getHpt               `thenM` \ hpt ->
 121    getModule            `thenM` \ this_mod ->
 122    getImports           `thenM` \ import_avails ->
 123    getEps               `thenM` \ eps@(EPS { eps_PIT = pit }) ->
 124
 125         -- CHECK WHETHER WE HAVE IT ALREADY
 126    case lookupIfaceByModName hpt pit mod_name of {
 127         Just iface |  case from of
 128                         ImportByUser   src_imp -> src_imp == mi_boot iface
 129                         ImportForUsage src_imp -> src_imp == mi_boot iface
 130                         ImportBySystem         -> True
 131                    -> returnM iface ;           -- Already loaded
 132                         -- The not (mi_boot iface) test checks that the already-loaded
 133                         -- interface isn't a boot iface.  This can conceivably happen,
 134                         -- if the version checking happened to load a boot interface
 135                         -- before we got to real imports.
 136         other       ->
 137
 138    traceRn (vcat [text "loadInterface" <+> brackets doc_str,
 139                   ppr (dep_mods import_avails)])        `thenM_`
 140    let
 141         mod_map  = dep_mods import_avails
 142         mod_info = lookupModuleEnvByName mod_map mod_name
 143
 144         hi_boot_file
 145           = case (from, mod_info) of
 146                 (ImportByUser   is_boot, _)            -> is_boot
 147                 (ImportForUsage is_boot, _)            -> is_boot
 148                 (ImportBySystem, Just (_, _, is_boot)) -> is_boot
 149                 (ImportBySystem, Nothing)              -> False
 150                         -- We're importing a module we know absolutely
 151                         -- nothing about, so we assume it's from
 152                         -- another package, where we aren't doing
 153                         -- dependency tracking. So it won't be a hi-boot file.
 154
 155         redundant_source_import
 156           = case (from, mod_info) of
 157                 (ImportByUser True, Just (_, _, False)) -> True
 158                 other                                   -> False
 159    in
 160
 161         -- Issue a warning for a redundant {- SOURCE -} import
 162         -- NB that we arrange to read all the ordinary imports before
 163         -- any of the {- SOURCE -} imports
 164    warnIf       redundant_source_import
 165                 (warnRedundantSourceImport mod_name)    `thenM_`
 166
 167         -- Check that we aren't importing ourselves.
 168         -- That only happens in Rename.checkOldIface,
 169         -- which doesn't call loadInterface
 170    warnIf
 171         (isHomeModule this_mod && moduleName this_mod == mod_name)
 172         (warnSelfImport this_mod)               `thenM_`
 173
 174         -- READ THE MODULE IN
 175    findAndReadIface doc_str mod_name hi_boot_file
 176                                             `thenM` \ read_result ->
 177    case read_result of {
 178         Left err
 179           | case from of { ImportForUsage _ -> True ; other -> False }
 180           -> failM      -- Fail with no error messages
 181
 182           |  otherwise
 183           -> let        -- Not found, so add an empty export env to
 184                         -- the EPS map so that we don't look again
 185                 fake_mod   = mkPackageModule mod_name
 186                 fake_iface = emptyModIface fake_mod
 187                 new_eps    = eps { eps_PIT = extendModuleEnv pit fake_mod fake_iface }
 188              in
 189              setEps new_eps             `thenM_`
 190              addErr (elaborate err)     `thenM_`
 191              returnM fake_iface
 192           where
 193             elaborate err = hang (ptext SLIT("Failed to load interface for") <+>
 194                                   quotes (ppr mod_name) <> colon) 4 err
 195           ;
 196
 197         -- Found and parsed!
 198         Right (mod, iface) ->
 199
 200         -- LOAD IT INTO EPS
 201
 202         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
 203         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
 204         --     If we do loadExport first the wrong info gets into the cache (unless we
 205         --      explicitly tag each export which seems a bit of a bore)
 206
 207
 208         -- Sanity check.  If we're system-importing a module we know nothing at all
 209         -- about, it should be from a different package to this one
 210     WARN( not (maybeToBool mod_info) &&
 211           case from of { ImportBySystem -> True; other -> False } &&
 212           isHomeModule mod,
 213           ppr mod )
 214
 215     initRn (InterfaceMode mod)                                  $
 216         -- Set the module, for use when looking up occurrences
 217         -- of names in interface decls and rules
 218     loadDecls mod       (eps_decls eps)   (pi_decls iface)      `thenM` \ (decls_vers, new_decls) ->
 219     loadRules     mod   (eps_rules eps)   (pi_rules iface)      `thenM` \ (rule_vers, new_rules) ->
 220     loadInstDecls mod   (eps_insts eps)   (pi_insts iface)      `thenM` \ new_insts ->
 221     loadExports                           (pi_exports iface)    `thenM` \ (export_vers, avails) ->
 222     loadFixDecls                          (pi_fixity iface)     `thenM` \ fix_env ->
 223     loadDeprecs                           (pi_deprecs iface)    `thenM` \ deprec_env ->
 224    let
 225         version = VersionInfo { vers_module  = pi_vers iface,
 226                                 vers_exports = export_vers,
 227                                 vers_rules = rule_vers,
 228                                 vers_decls = decls_vers }
 229
 230         this_mod_name = moduleName this_mod
 231         is_loaded m   =  m == this_mod_name
 232                       || maybeToBool (lookupIfaceByModName hpt pit m)
 233                 -- We treat the currently-being-compiled module as 'loaded' because
 234                 -- even though it isn't yet in the HIT or PIT; otherwise it gets
 235                 -- put into iImpModInfo, and then spat out into its own interface
 236                 -- file as a dependency
 237
 238         -- Now add info about this module to the PIT
 239         has_orphans = pi_orphan iface
 240         new_pit   = extendModuleEnv pit mod mod_iface
 241         mod_iface = ModIface { mi_module = mod, mi_package = pi_pkg iface,
 242                                mi_version = version,
 243                                mi_orphan = has_orphans, mi_boot = hi_boot_file,
 244                                mi_exports = avails,
 245                                mi_fixities = fix_env, mi_deprecs = deprec_env,
 246                                mi_deps     = pi_deps iface,
 247                                mi_usages   = panic "No mi_usages in PIT",
 248                                mi_decls    = panic "No mi_decls in PIT",
 249                                mi_globals  = Nothing
 250                     }
 251
 252         new_eps = eps { eps_PIT      = new_pit,
 253                         eps_decls    = new_decls,
 254                         eps_insts    = new_insts,
 255                         eps_rules    = new_rules }
 256     in
 257     setEps new_eps              `thenM_`
 258     returnM mod_iface
 259     }}
 260
 261 -----------------------------------------------------
 262 --      Loading the export list
 263 -----------------------------------------------------
 264
 265 loadExports :: (Version, [RdrExportItem]) -> TcRn m (Version, [(ModuleName,Avails)])
 266 loadExports (vers, items)
 267   = mappM loadExport items      `thenM` \ avails_s ->
 268     returnM (vers, avails_s)
 269
 270
 271 loadExport :: RdrExportItem -> TcRn m (ModuleName, Avails)
 272 loadExport (mod, entities)
 273   = mappM (load_entity mod) entities    `thenM` \ avails ->
 274     returnM (mod, avails)
 275   where
 276     load_entity mod (Avail occ)
 277       = newGlobalName2 mod occ  `thenM` \ name ->
 278         returnM (Avail name)
 279     load_entity mod (AvailTC occ occs)
 280       = newGlobalName2 mod occ          `thenM` \ name ->
 281         mappM (newGlobalName2 mod) occs `thenM` \ names ->
 282         returnM (AvailTC name names)
 283
 284
 285 -----------------------------------------------------
 286 --      Loading type/class/value decls
 287 -----------------------------------------------------
 288
 289 loadDecls :: Module
 290           -> DeclsMap
 291           -> [(Version, RdrNameTyClDecl)]
 292           -> TcRn m (NameEnv Version, DeclsMap)
 293 loadDecls mod (decls_map, n_slurped) decls
 294   = foldlM (loadDecl mod) (emptyNameEnv, decls_map) decls       `thenM` \ (vers, decls_map') ->
 295     returnM (vers, (decls_map', n_slurped))
 296
 297 loadDecl mod (version_map, decls_map) (version, decl)
 298   = getTyClDeclBinders mod decl         `thenM` \ avail ->
 299     getSysBinders mod decl              `thenM` \ sys_names ->
 300     let
 301         full_avail    = case avail of
 302                           Avail n -> avail
 303                           AvailTC n ns -> AvailTC n (sys_names ++ ns)
 304         main_name     = availName full_avail
 305         new_decls_map = extendNameEnvList decls_map stuff
 306         stuff         = [ (name, (full_avail, name==main_name, (mod, decl)))
 307                         | name <- availNames full_avail]
 308
 309         new_version_map = extendNameEnv version_map main_name version
 310     in
 311     traceRn (text "Loading" <+> ppr full_avail) `thenM_`
 312     returnM (new_version_map, new_decls_map)
 313
 314
 315
 316 -----------------
 317 getTyClDeclBinders :: Module -> RdrNameTyClDecl -> TcRn m AvailInfo
 318
 319 getTyClDeclBinders mod (IfaceSig {tcdName = var, tcdLoc = src_loc})
 320   = newTopBinder mod var src_loc                        `thenM` \ var_name ->
 321     returnM (Avail var_name)
 322
 323 getTyClDeclBinders mod tycl_decl
 324   = mapM new (tyClDeclNames tycl_decl)  `thenM` \ names@(main_name:_) ->
 325     returnM (AvailTC main_name names)
 326   where
 327     new (nm,loc) = newTopBinder mod nm loc
 328
 329 --------------------------------
 330 -- The "system names" are extra implicit names *bound* by the decl.
 331
 332 getSysBinders :: Module -> TyClDecl RdrName -> TcRn m [Name]
 333 -- Similar to tyClDeclNames, but returns the "implicit"
 334 -- or "system" names of the declaration.  And it only works
 335 -- on RdrNames, returning OccNames
 336
 337 getSysBinders mod (ClassDecl {tcdName = cname, tcdCtxt = cxt, tcdLoc = loc})
 338   = sequenceM [new_sys_bndr mod n loc | n <- sys_occs]
 339   where
 340         -- C.f. TcClassDcl.tcClassDecl1
 341     sys_occs    = tc_occ : data_occ : dw_occ : sc_sel_occs
 342     cls_occ     = rdrNameOcc cname
 343     data_occ    = mkClassDataConOcc cls_occ
 344     dw_occ      = mkWorkerOcc data_occ
 345     tc_occ      = mkClassTyConOcc   cls_occ
 346     sc_sel_occs = [mkSuperDictSelOcc n cls_occ | n <- [1..length cxt]]
 347
 348 getSysBinders mod (TyData {tcdName = tc_name, tcdCons = DataCons cons,
 349                            tcdGeneric = Just want_generic, tcdLoc = loc})
 350         -- The 'Just' is because this is an interface-file decl
 351         -- so it will say whether to derive generic stuff for it or not
 352   = sequenceM ([new_sys_bndr mod n loc | n <- gen_occs] ++
 353                map con_sys_occ cons)
 354   where
 355         -- c.f. TcTyDecls.tcTyDecl
 356     tc_occ = rdrNameOcc tc_name
 357     gen_occs | want_generic = [mkGenOcc1 tc_occ, mkGenOcc2 tc_occ]
 358              | otherwise    = []
 359     con_sys_occ (ConDecl name _ _ _ loc)
 360         = new_sys_bndr mod (mkWorkerOcc (rdrNameOcc name)) loc
 361
 362 getSysBinders mod decl = returnM []
 363
 364 new_sys_bndr mod occ loc = newTopBinder mod (mkRdrUnqual occ) loc
 365
 366
 367 -----------------------------------------------------
 368 --      Loading fixity decls
 369 -----------------------------------------------------
 370
 371 loadFixDecls decls
 372   = mappM loadFixDecl decls     `thenM` \ to_add ->
 373     returnM (mkNameEnv to_add)
 374
 375 loadFixDecl (FixitySig rdr_name fixity loc)
 376   = lookupGlobalOccRn rdr_name          `thenM` \ name ->
 377     returnM (name, FixitySig name fixity loc)
 378
 379
 380 -----------------------------------------------------
 381 --      Loading instance decls
 382 -----------------------------------------------------
 383
 384 loadInstDecls :: Module -> IfaceInsts
 385               -> [RdrNameInstDecl]
 386               -> RnM IfaceInsts
 387 loadInstDecls mod (insts, n_slurped) decls
 388   = foldlM (loadInstDecl mod) insts decls       `thenM` \ insts' ->
 389     returnM (insts', n_slurped)
 390
 391
 392 loadInstDecl mod insts decl@(InstDecl inst_ty _ _ _ _)
 393   =     -- Find out what type constructors and classes are "gates" for the
 394         -- instance declaration.  If all these "gates" are slurped in then
 395         -- we should slurp the instance decl too.
 396         --
 397         -- We *don't* want to count names in the context part as gates, though.
 398         -- For example:
 399         --              instance Foo a => Baz (T a) where ...
 400         --
 401         -- Here the gates are Baz and T, but *not* Foo.
 402         --
 403         -- HOWEVER: functional dependencies make things more complicated
 404         --      class C a b | a->b where ...
 405         --      instance C Foo Baz where ...
 406         -- Here, the gates are really only C and Foo, *not* Baz.
 407         -- That is, if C and Foo are visible, even if Baz isn't, we must
 408         -- slurp the decl.
 409         --
 410         -- Rather than take fundeps into account "properly", we just slurp
 411         -- if C is visible and *any one* of the Names in the types
 412         -- This is a slightly brutal approximation, but most instance decls
 413         -- are regular H98 ones and it's perfect for them.
 414         --
 415         -- NOTICE that we rename the type before extracting its free
 416         -- variables.  The free-variable finder for a renamed HsType
 417         -- does the Right Thing for built-in syntax like [] and (,).
 418     rnHsType (text "In an interface instance decl") inst_ty     `thenM` \ inst_ty' ->
 419     let
 420         (tvs,_,cls,tys) = splitHsInstDeclTy inst_ty'
 421         free_tcs  = nameSetToList (extractHsTyNames_s tys) `minusList` hsTyVarNames tvs
 422
 423         gate_fn vis_fn = vis_fn cls && (null free_tcs || any vis_fn free_tcs)
 424         -- The 'vis_fn' returns True for visible names
 425         -- Here is the implementation of HOWEVER above
 426         -- (Note that we do let the inst decl in if it mentions
 427         --  no tycons at all.  Hence the null free_ty_names.)
 428     in
 429     traceRn ((text "Load instance for" <+> ppr inst_ty') $$ ppr free_tcs)       `thenM_`
 430     returnM ((gate_fn, (mod, decl)) `consBag` insts)
 431
 432
 433
 434 -----------------------------------------------------
 435 --      Loading Rules
 436 -----------------------------------------------------
 437
 438 loadRules :: Module
 439           -> IfaceRules
 440           -> (Version, [RdrNameRuleDecl])
 441           -> RnM (Version, IfaceRules)
 442 loadRules mod (rule_bag, n_slurped) (version, rules)
 443   | null rules || opt_IgnoreIfacePragmas
 444   = returnM (version, (rule_bag, n_slurped))
 445   | otherwise
 446   = mappM (loadRule mod) rules          `thenM` \ new_rules ->
 447     returnM (version, (rule_bag `unionBags` listToBag new_rules, n_slurped))
 448
 449 loadRule :: Module -> RdrNameRuleDecl -> RnM (GatedDecl RdrNameRuleDecl)
 450 -- "Gate" the rule simply by whether the rule variable is
 451 -- needed.  We can refine this later.
 452 loadRule mod decl@(IfaceRule _ _ _ var _ _ src_loc)
 453   = lookupGlobalOccRn var               `thenM` \ var_name ->
 454     returnM (\vis_fn -> vis_fn var_name, (mod, decl))
 455
 456
 457 -----------------------------------------------------
 458 --      Loading Deprecations
 459 -----------------------------------------------------
 460
 461 loadDeprecs :: IfaceDeprecs -> RnM Deprecations
 462 loadDeprecs Nothing            = returnM NoDeprecs
 463 loadDeprecs (Just (Left txt))  = returnM (DeprecAll txt)
 464 loadDeprecs (Just (Right prs)) = foldlM loadDeprec emptyNameEnv prs     `thenM` \ env ->
 465                                  returnM (DeprecSome env)
 466 loadDeprec deprec_env (n, txt)
 467   = lookupGlobalOccRn n         `thenM` \ name ->
 468     traceRn (text "Loaded deprecation(s) for" <+> ppr name <> colon <+> ppr txt) `thenM_`
 469     returnM (extendNameEnv deprec_env name (name,txt))
 470 \end{code}
 471
 472
 473 %********************************************************
 474 %*                                                      *
 475         Load the ParsedIface for the *current* module
 476         into a ModIface; then it can be checked
 477         for up-to-date-ness
 478 %*                                                      *
 479 %********************************************************
 480
 481 \begin{code}
 482 loadOldIface :: ParsedIface -> RnM ModIface
 483
 484 loadOldIface iface
 485   = loadHomeDecls       (pi_decls iface)        `thenM` \ (decls_vers, new_decls) ->
 486     loadHomeRules       (pi_rules iface)        `thenM` \ (rule_vers, new_rules) ->
 487     loadHomeInsts       (pi_insts iface)        `thenM` \ new_insts ->
 488     mappM loadHomeUsage (pi_usages iface)       `thenM` \ usages ->
 489     loadExports         (pi_exports iface)      `thenM` \ (export_vers, avails) ->
 490     loadFixDecls        (pi_fixity iface)       `thenM` \ fix_env ->
 491     loadDeprecs         (pi_deprecs iface)      `thenM` \ deprec_env ->
 492
 493     getModeRn                                   `thenM` \ (InterfaceMode mod) ->
 494                 -- Caller sets the module before the call; also needed
 495                 -- by the newGlobalName stuff in some of the loadHomeX calls
 496     let
 497         version = VersionInfo { vers_module  = pi_vers iface,
 498                                 vers_exports = export_vers,
 499                                 vers_rules   = rule_vers,
 500                                 vers_decls   = decls_vers }
 501
 502         decls = mkIfaceDecls new_decls new_rules new_insts
 503
 504         mod_iface = ModIface { mi_module = mod, mi_package = pi_pkg iface,
 505                                mi_version = version, mi_deps = pi_deps iface,
 506                                mi_exports = avails, mi_usages = usages,
 507                                mi_boot = False, mi_orphan = pi_orphan iface,
 508                                mi_fixities = fix_env, mi_deprecs = deprec_env,
 509                                mi_decls   = decls,
 510                                mi_globals = Nothing
 511                     }
 512     in
 513     returnM mod_iface
 514 \end{code}
 515
 516 \begin{code}
 517 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
 518               -> RnM (NameEnv Version, [RenamedTyClDecl])
 519 loadHomeDecls decls = foldlM loadHomeDecl (emptyNameEnv, []) decls
 520
 521 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
 522              -> (Version, RdrNameTyClDecl)
 523              -> RnM (NameEnv Version, [RenamedTyClDecl])
 524 loadHomeDecl (version_map, decls) (version, decl)
 525   = rnTyClDecl decl     `thenM` \ decl' ->
 526     returnM (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
 527
 528 ------------------
 529 loadHomeRules :: (Version, [RdrNameRuleDecl])
 530               -> RnM (Version, [RenamedRuleDecl])
 531 loadHomeRules (version, rules)
 532   = mappM rnIfaceRuleDecl rules `thenM` \ rules' ->
 533     returnM (version, rules')
 534
 535 ------------------
 536 loadHomeInsts :: [RdrNameInstDecl]
 537               -> RnM [RenamedInstDecl]
 538 loadHomeInsts insts = mappM rnInstDecl insts
 539
 540 ------------------
 541 loadHomeUsage :: Usage OccName -> TcRn m (Usage Name)
 542 loadHomeUsage usage
 543   = mappM rn_imp (usg_entities usage)   `thenM` \ entities' ->
 544     returnM (usage { usg_entities = entities' })
 545   where
 546     mod_name = usg_name usage
 547     rn_imp (occ,vers) = newGlobalName2 mod_name occ     `thenM` \ name ->
 548                         returnM (name,vers)
 549 \end{code}
 550
 551
 552 %*********************************************************
 553 %*                                                      *
 554 \subsection{Reading an interface file}
 555 %*                                                      *
 556 %*********************************************************
 557
 558 \begin{code}
 559 findAndReadIface :: SDoc -> ModuleName
 560                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
 561                                         -- False <=> Look for .hi file
 562                  -> TcRn m (Either Message (Module, ParsedIface))
 563         -- Nothing <=> file not found, or unreadable, or illegible
 564         -- Just x  <=> successfully found and parsed
 565
 566         -- It *doesn't* add an error to the monad, because
 567         -- sometimes it's ok to fail... see notes with loadInterface
 568
 569 findAndReadIface doc_str mod_name hi_boot_file
 570   = traceRn trace_msg                   `thenM_`
 571
 572     -- Check for GHC.Prim, and return its static interface
 573     if mod_name == gHC_PRIM_Name
 574         then returnM (Right (gHC_PRIM, ghcPrimIface))
 575         else
 576
 577     ioToTcRn (findHiFile mod_name hi_boot_file) `thenM` \ maybe_found ->
 578
 579     case maybe_found of
 580       Nothing ->
 581         traceRn (ptext SLIT("...not found"))    `thenM_`
 582         returnM (Left (noIfaceErr mod_name hi_boot_file))
 583
 584       Just (wanted_mod, file_path) ->
 585         traceRn (ptext SLIT("readIFace") <+> text file_path)    `thenM_`
 586
 587         readIface wanted_mod file_path hi_boot_file     `thenM` \ read_result ->
 588                 -- Catch exceptions here
 589
 590         case read_result of
 591           Left exn    -> returnM (Left (badIfaceFile file_path
 592                                           (text (showException exn))))
 593
 594           Right iface -> returnM (Right (wanted_mod, iface))
 595
 596   where
 597     trace_msg = sep [hsep [ptext SLIT("Reading"),
 598                            if hi_boot_file then ptext SLIT("[boot]") else empty,
 599                            ptext SLIT("interface for"),
 600                            ppr mod_name <> semi],
 601                      nest 4 (ptext SLIT("reason:") <+> doc_str)]
 602
 603 findHiFile :: ModuleName -> IsBootInterface -> IO (Maybe (Module, FilePath))
 604 findHiFile mod_name hi_boot_file
 605  = do {
 606         -- In interactive or --make mode, we are *not allowed* to demand-load
 607         -- a home package .hi file.  So don't even look for them.
 608         -- This helps in the case where you are sitting in eg. ghc/lib/std
 609         -- and start up GHCi - it won't complain that all the modules it tries
 610         -- to load are found in the home location.
 611         ghci_mode <- readIORef v_GhcMode ;
 612         let { home_allowed = hi_boot_file ||
 613                              not (isCompManagerMode ghci_mode) } ;
 614         maybe_found <-  if home_allowed
 615                         then findModule mod_name
 616                         else findPackageModule mod_name ;
 617
 618         case maybe_found of {
 619           Nothing -> return Nothing ;
 620
 621           Just (mod,loc) -> do {
 622
 623         -- Return the path to M.hi, M.hi-boot, or M.hi-boot-n as appropriate
 624         let { hi_path            = ml_hi_file loc ;
 625               hi_boot_path       = replaceFilenameSuffix hi_path hiBootExt ;
 626               hi_boot_ver_path   = replaceFilenameSuffix hi_path hiBootVerExt
 627             };
 628
 629         if not hi_boot_file then
 630            return (Just (mod, hi_path))
 631         else do {
 632                 hi_ver_exists <- doesFileExist hi_boot_ver_path ;
 633                 if hi_ver_exists then return (Just (mod, hi_boot_ver_path))
 634                                  else return (Just (mod, hi_boot_path))
 635         }}}}
 636 \end{code}
 637
 638 @readIface@ tries just the one file.
 639
 640 \begin{code}
 641 readIface :: Module -> String -> IsBootInterface -> TcRn m (Either Exception ParsedIface)
 642         -- Nothing <=> file not found, or unreadable, or illegible
 643         -- Just x  <=> successfully found and parsed
 644
 645 readIface mod file_path is_hi_boot_file
 646   = ioToTcRn (tryMost (read_iface mod file_path is_hi_boot_file))
 647
 648 read_iface mod file_path is_hi_boot_file
 649  | is_hi_boot_file              -- Read ascii
 650  = do { buffer <- hGetStringBuffer file_path ;
 651         case parseIface buffer (mkPState loc exts) of
 652           POk _ iface | wanted_mod_name == actual_mod_name
 653                       -> return iface
 654                       | otherwise
 655                       -> throwDyn (ProgramError (showSDoc err))
 656                                 -- 'showSDoc' is a bit yukky
 657                 where
 658                   wanted_mod_name = moduleName mod
 659                   actual_mod_name = pi_mod iface
 660                   err = hiModuleNameMismatchWarn wanted_mod_name actual_mod_name
 661
 662           PFailed err -> throwDyn (ProgramError (showSDoc err))
 663      }
 664
 665  | otherwise            -- Read binary
 666  = readBinIface file_path
 667
 668  where
 669     exts = ExtFlags {glasgowExtsEF = True,
 670                      ffiEF         = True,
 671                      withEF        = True,
 672                      parrEF        = True}
 673     loc  = mkSrcLoc (mkFastString file_path) 1
 674 \end{code}
 675
 676
 677 %*********************************************************
 678 %*                                                       *
 679         Wired-in interface for GHC.Prim
 680 %*                                                       *
 681 %*********************************************************
 682
 683 \begin{code}
 684 ghcPrimIface :: ParsedIface
 685 ghcPrimIface = ParsedIface {
 686       pi_mod     = gHC_PRIM_Name,
 687       pi_pkg     = basePackage,
 688       pi_deps    = ([],[]),
 689       pi_vers    = 1,
 690       pi_orphan  = False,
 691       pi_usages  = [],
 692       pi_exports = (1, [(gHC_PRIM_Name, ghcPrimExports)]),
 693       pi_decls   = [(1,cCallableClassDecl),
 694                     (1,cReturnableClassDecl)],
 695       pi_fixity  = [FixitySig (nameRdrName (idName seqId))
 696                               (Fixity 0 InfixR) noSrcLoc],
 697                 -- seq is infixr 0
 698       pi_insts   = [],
 699       pi_rules   = (1,[]),
 700       pi_deprecs = Nothing
 701  }
 702 \end{code}
 703
 704 %*********************************************************
 705 %*                                                       *
 706 \subsection{Errors}
 707 %*                                                       *
 708 %*********************************************************
 709
 710 \begin{code}
 711 noIfaceErr mod_name boot_file
 712   = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
 713         -- We used to print the search path, but we can't do that
 714         -- now, because it's hidden inside the finder.
 715         -- Maybe the finder should expose more functions.
 716
 717 badIfaceFile file err
 718   = vcat [ptext SLIT("Bad interface file:") <+> text file,
 719           nest 4 err]
 720
 721 hiModuleNameMismatchWarn :: ModuleName -> ModuleName -> Message
 722 hiModuleNameMismatchWarn requested_mod read_mod =
 723     hsep [ ptext SLIT("Something is amiss; requested module name")
 724          , ppr requested_mod
 725          , ptext SLIT("differs from name found in the interface file")
 726          , ppr read_mod
 727          ]
 728
 729 warnRedundantSourceImport mod_name
 730   = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
 731           <+> quotes (ppr mod_name)
 732
 733 warnSelfImport mod
 734   = ptext SLIT("Importing my own interface: module") <+> ppr mod
 735 \end{code}