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