ghc/compiler/iface/LoadIface.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 LoadIface (
   8         loadHomeInterface, loadInterface,
   9         loadSrcInterface, loadOrphanModules,
  10         readIface,      -- Used when reading the module's old interface
  11         predInstGates, ifaceInstGates, ifaceStats,
  12         initExternalPackageState
  13    ) where
  14
  15 #include "HsVersions.h"
  16
  17 import DriverState      ( v_GhcMode, isCompManagerMode )
  18 import DriverUtil       ( replaceFilenameSuffix )
  19 import CmdLineOpts      ( DynFlags( verbosity ), DynFlag( Opt_IgnoreInterfacePragmas ),
  20                           opt_InPackage )
  21 import Parser           ( parseIface )
  22
  23 import IfaceSyn         ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..), IfaceInst(..),
  24                           IfaceRule(..), IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..),
  25                           IfaceType(..), IfacePredType(..), IfaceExtName, mkIfaceExtName )
  26 import IfaceEnv         ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc )
  27 import HscTypes         ( HscEnv(..), ModIface(..), emptyModIface,
  28                           ExternalPackageState(..), emptyTypeEnv, emptyPool,
  29                           lookupIfaceByModName, emptyPackageIfaceTable,
  30                           IsBootInterface, mkIfaceFixCache,
  31                           Pool(..), DeclPool, InstPool,
  32                           RulePool, addRuleToPool, RulePoolContents
  33                          )
  34
  35 import BasicTypes       ( Version, Fixity(..), FixityDirection(..) )
  36 import TcType           ( Type, tcSplitTyConApp_maybe )
  37 import Type             ( funTyCon )
  38 import TcRnMonad
  39
  40 import PrelNames        ( gHC_PRIM_Name )
  41 import PrelInfo         ( ghcPrimExports )
  42 import PrelRules        ( builtinRules )
  43 import Rules            ( emptyRuleBase )
  44 import InstEnv          ( emptyInstEnv )
  45 import Name             ( Name {-instance NamedThing-}, getOccName,
  46                           nameModuleName, isInternalName )
  47 import NameEnv
  48 import MkId             ( seqId )
  49 import Packages         ( basePackage )
  50 import Module           ( Module, ModuleName, ModLocation(ml_hi_file),
  51                           moduleName, isHomeModule, moduleEnvElts,
  52                           extendModuleEnv, lookupModuleEnvByName, moduleUserString
  53                         )
  54 import OccName          ( OccName, mkClassTyConOcc, mkClassDataConOcc,
  55                           mkSuperDictSelOcc,
  56                           mkDataConWrapperOcc, mkDataConWorkerOcc )
  57 import Class            ( Class, className )
  58 import TyCon            ( DataConDetails(..), tyConName )
  59 import SrcLoc           ( mkSrcLoc, importedSrcLoc )
  60 import Maybes           ( isJust, mapCatMaybes )
  61 import StringBuffer     ( hGetStringBuffer )
  62 import FastString       ( mkFastString )
  63 import ErrUtils         ( Message, mkLocMessage )
  64 import Finder           ( findModule, findPackageModule,
  65                           hiBootExt, hiBootVerExt )
  66 import Lexer
  67 import Outputable
  68 import BinIface         ( readBinIface )
  69 import Panic
  70
  71 import DATA_IOREF       ( readIORef )
  72
  73 import Directory
  74 \end{code}
  75
  76
  77 %************************************************************************
  78 %*                                                                      *
  79                 loadSrcInterface, loadOrphanModules
  80
  81                 These two are called from TcM-land
  82 %*                                                                      *
  83 %************************************************************************
  84
  85 \begin{code}
  86 loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -> RnM ModIface
  87 -- This is called for each 'import' declaration in the source code
  88 -- On a failure, fail in the monad with an error message
  89
  90 loadSrcInterface doc mod_name want_boot
  91   = do  { mb_iface <- initIfaceTcRn $ loadInterface doc mod_name
  92                                            (ImportByUser want_boot)
  93         ; case mb_iface of
  94             Left err    -> failWithTc (elaborate err)
  95             Right iface -> return iface
  96         }
  97   where
  98     elaborate err = hang (ptext SLIT("Failed to load interface for") <+>
  99                          quotes (ppr mod_name) <> colon) 4 err
 100
 101 loadOrphanModules :: [ModuleName] -> TcM ()
 102 loadOrphanModules mods
 103   | null mods = returnM ()
 104   | otherwise = initIfaceTcRn $
 105                 do { traceIf (text "Loading orphan modules:" <+>
 106                                  fsep (map ppr mods))
 107                    ; mappM_ load mods
 108                    ; returnM () }
 109   where
 110     load mod   = loadSysInterface (mk_doc mod) mod
 111     mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
 112 \end{code}
 113
 114 %*********************************************************
 115 %*                                                      *
 116                 loadHomeInterface
 117                 Called from Iface-land
 118 %*                                                      *
 119 %*********************************************************
 120
 121 \begin{code}
 122 loadHomeInterface :: SDoc -> Name -> IfM lcl ModIface
 123 loadHomeInterface doc name
 124   = ASSERT2( not (isInternalName name), ppr name <+> parens doc )
 125     loadSysInterface doc (nameModuleName name)
 126
 127 loadSysInterface :: SDoc -> ModuleName -> IfM lcl ModIface
 128 -- A wrapper for loadInterface that Throws an exception if it fails
 129 loadSysInterface doc mod_name
 130   = do  { mb_iface <- loadInterface doc mod_name ImportBySystem
 131         ; case mb_iface of
 132             Left err    -> ghcError (ProgramError (showSDoc err))
 133             Right iface -> return iface }
 134 \end{code}
 135
 136
 137 %*********************************************************
 138 %*                                                      *
 139                 loadInterface
 140
 141         The main function to load an interface
 142         for an imported module, and put it in
 143         the External Package State
 144 %*                                                      *
 145 %*********************************************************
 146
 147 \begin{code}
 148 loadInterface :: SDoc -> ModuleName -> WhereFrom
 149               -> IfM lcl (Either Message ModIface)
 150 -- If it can't find a suitable interface file, we
 151 --      a) modify the PackageIfaceTable to have an empty entry
 152 --              (to avoid repeated complaints)
 153 --      b) return (Left message)
 154 --
 155 -- It's not necessarily an error for there not to be an interface
 156 -- file -- perhaps the module has changed, and that interface
 157 -- is no longer used -- but the caller can deal with that by
 158 -- catching the exception
 159
 160 loadInterface doc_str mod_name from
 161   = do  {       -- Read the state
 162           env <- getTopEnv
 163         ; let { hpt     = hsc_HPT env
 164               ; eps_var = hsc_EPS env }
 165         ; eps <- readMutVar eps_var
 166         ; let { pit = eps_PIT eps }
 167
 168                 -- Check whether we have the interface already
 169         ; case lookupIfaceByModName hpt pit mod_name of {
 170             Just iface
 171                 -> returnM (Right iface) ;      -- Already loaded
 172                         -- The (src_imp == mi_boot iface) test checks that the already-loaded
 173                         -- interface isn't a boot iface.  This can conceivably happen,
 174                         -- if an earlier import had a before we got to real imports.   I think.
 175             other -> do
 176
 177         { if_gbl_env <- getGblEnv
 178         ; let { hi_boot_file = case from of
 179                                 ImportByUser usr_boot -> usr_boot
 180                                 ImportBySystem        -> sys_boot
 181
 182               ; mb_dep   = lookupModuleEnvByName (if_is_boot if_gbl_env) mod_name
 183               ; sys_boot = case mb_dep of
 184                                 Just (_, is_boot) -> is_boot
 185                                 Nothing           -> False
 186                         -- The boot-ness of the requested interface,
 187               }         -- based on the dependencies in directly-imported modules
 188
 189         -- READ THE MODULE IN
 190         ; read_result <- findAndReadIface doc_str mod_name hi_boot_file
 191         ; case read_result of {
 192             Left err -> do
 193                 { let { -- Not found, so add an empty iface to
 194                         -- the EPS map so that we don't look again
 195                         fake_iface = emptyModIface opt_InPackage mod_name
 196                       ; new_pit    = extendModuleEnv pit (mi_module fake_iface) fake_iface
 197                       ; new_eps    = eps { eps_PIT = new_pit } }
 198                 ; writeMutVar eps_var new_eps
 199                 ; returnM (Left err) } ;
 200
 201         -- Found and parsed!
 202             Right iface ->
 203
 204         let { mod = mi_module iface } in
 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(   case from of { ImportBySystem -> True; other -> False } &&
 209                 not (isJust mb_dep) &&
 210                 isHomeModule mod,
 211                 ppr mod $$ ppr mb_dep)
 212
 213         initIfaceLcl (moduleName mod) $ do
 214         --      Load the new ModIface into the External Package State
 215         -- Even home-package interfaces loaded by loadInterface
 216         --      (which only happens in OneShot mode; in Batch/Interactive
 217         --      mode, home-package modules are loaded one by one into the HPT)
 218         -- are put in the EPS.
 219         --
 220         -- The main thing is to add the ModIface to the PIT, but
 221         -- we also take the
 222         --      IfaceDecls, IfaceInst, IfaceRules
 223         -- out of the ModIface and put them into the big EPS pools
 224
 225         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
 226         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
 227         --     If we do loadExport first the wrong info gets into the cache (unless we
 228         --      explicitly tag each export which seems a bit of a bore)
 229
 230         { new_eps_decls <- loadDecls mod (eps_decls eps) (mi_decls iface)
 231         ; new_eps_insts <- loadInsts mod (eps_insts eps) (mi_insts iface)
 232         ; new_eps_rules <- loadRules mod (eps_rules eps) (mi_rules iface)
 233
 234         ; let { final_iface = iface {   mi_decls = panic "No mi_decls in PIT",
 235                                         mi_insts = panic "No mi_insts in PIT",
 236                                         mi_rules = panic "No mi_rules in PIT" }
 237
 238               ; new_eps = eps { eps_PIT   = extendModuleEnv pit mod final_iface,
 239                                 eps_decls = new_eps_decls,
 240                                 eps_rules = new_eps_rules,
 241                                 eps_insts = new_eps_insts } }
 242         ; writeMutVar eps_var new_eps
 243         ; return (Right final_iface)
 244     }}}}}
 245
 246 -----------------------------------------------------
 247 --      Loading type/class/value decls
 248 -- We pass the full Module name here, replete with
 249 -- its package info, so that we can build a Name for
 250 -- each binder with the right package info in it
 251 -- All subsequent lookups, including crucially lookups during typechecking
 252 -- the declaration itself, will find the fully-glorious Name
 253 -----------------------------------------------------
 254
 255 loadDecls :: Module -> DeclPool
 256           -> [(Version, IfaceDecl)]
 257           -> IfM lcl DeclPool
 258 loadDecls mod (Pool decls_map n_in n_out) decls
 259   = do  { ignore_prags <- doptM Opt_IgnoreInterfacePragmas
 260         ; decls_map' <- foldlM (loadDecl ignore_prags mod) decls_map decls
 261         ; returnM (Pool decls_map' (n_in + length decls) n_out) }
 262
 263 loadDecl ignore_prags mod decls_map (_version, decl)
 264   = do  { main_name <- mk_new_bndr Nothing (ifName decl)
 265         ; let decl' | ignore_prags = zapIdInfo decl
 266                     | otherwise    = decl
 267
 268         -- Populate the name cache with final versions of all the subordinate names
 269         ; mapM_ (mk_new_bndr (Just main_name)) (ifaceDeclSubBndrs decl')
 270
 271         -- Extend the decls pool with a mapping for the main name (only)
 272         ; returnM (extendNameEnv decls_map main_name decl') }
 273   where
 274         -- mk_new_bndr allocates in the name cache the final canonical
 275         -- name for the thing, with the correct
 276         --      * package info
 277         --      * parent
 278         --      * location
 279         -- imported name, to fix the module correctly in the cache
 280     mk_new_bndr mb_parent occ = newGlobalBinder mod occ mb_parent loc
 281     loc = importedSrcLoc (moduleUserString mod)
 282
 283 zapIdInfo decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = DiscardedInfo }
 284 zapIdInfo decl                                  = decl
 285         -- Don't alter "NoInfo", just "HasInfo"
 286
 287 -----------------
 288 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
 289 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
 290 -- Rather revolting, because it has to predict what gets bound
 291
 292 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, ifSigs = sigs })
 293   = [tc_occ, dc_occ] ++
 294     [op | IfaceClassOp op _ _ <- sigs] ++
 295     [mkSuperDictSelOcc n cls_occ | n <- [1..length sc_ctxt]] ++
 296         -- The worker and wrapper for the DataCon of the class TyCon
 297         -- are based off the data-con name
 298     [mkDataConWrapperOcc dc_occ, mkDataConWorkerOcc dc_occ]
 299   where
 300     tc_occ  = mkClassTyConOcc cls_occ
 301     dc_occ  = mkClassDataConOcc cls_occ
 302
 303 ifaceDeclSubBndrs (IfaceData {ifCons = Unknown}) = []
 304 ifaceDeclSubBndrs (IfaceData {ifCons = DataCons cons})
 305   = foldr ((++) . conDeclBndrs) [] cons
 306
 307 ifaceDeclSubBndrs other = []
 308
 309 conDeclBndrs (IfaceConDecl con_occ _ _ _ _ fields)
 310   = fields ++
 311     [con_occ, mkDataConWrapperOcc con_occ, mkDataConWorkerOcc con_occ]
 312
 313
 314 -----------------------------------------------------
 315 --      Loading instance decls
 316 -----------------------------------------------------
 317
 318 loadInsts :: Module -> InstPool -> [IfaceInst] -> IfL InstPool
 319 loadInsts mod (Pool pool n_in n_out) decls
 320   = do  { new_pool <- foldlM (loadInstDecl (moduleName mod)) pool decls
 321         ; returnM (Pool new_pool
 322                         (n_in + length decls)
 323                         n_out) }
 324
 325 loadInstDecl mod pool decl@(IfaceInst {ifInstHead = inst_ty})
 326   = do  {
 327         -- Find out what type constructors and classes are "gates" for the
 328         -- instance declaration.  If all these "gates" are slurped in then
 329         -- we should slurp the instance decl too.
 330         --
 331         -- We *don't* want to count names in the context part as gates, though.
 332         -- For example:
 333         --              instance Foo a => Baz (T a) where ...
 334         --
 335         -- Here the gates are Baz and T, but *not* Foo.
 336         --
 337         -- HOWEVER: functional dependencies make things more complicated
 338         --      class C a b | a->b where ...
 339         --      instance C Foo Baz where ...
 340         -- Here, the gates are really only C and Foo, *not* Baz.
 341         -- That is, if C and Foo are visible, even if Baz isn't, we must
 342         -- slurp the decl.
 343         --
 344         -- Rather than take fundeps into account "properly", we just slurp
 345         -- if C is visible and *any one* of the Names in the types
 346         -- This is a slightly brutal approximation, but most instance decls
 347         -- are regular H98 ones and it's perfect for them.
 348         --
 349         -- NOTICE that we rename the type before extracting its free
 350         -- variables.  The free-variable finder for a renamed HsType
 351         -- does the Right Thing for built-in syntax like [] and (,).
 352           let { (cls_ext, tc_exts) = ifaceInstGates inst_ty }
 353         ; cls <- lookupIfaceExt cls_ext
 354         ; tcs <- mapM lookupIfaceTc tc_exts
 355         ; let { new_pool = extendNameEnv_C combine pool cls [(tcs, (mod,decl))]
 356               ; combine old _ = (tcs,(mod,decl)) : old }
 357         ; returnM new_pool
 358         }
 359
 360 -----------------------------------------------------
 361 --      Loading Rules
 362 -----------------------------------------------------
 363
 364 loadRules :: Module -> RulePool -> [IfaceRule] -> IfL RulePool
 365 loadRules mod pool@(Pool rule_pool n_in n_out) rules
 366   = do  { ignore_prags <- doptM Opt_IgnoreInterfacePragmas
 367         ; if ignore_prags then
 368                  returnM pool
 369           else do
 370         { new_pool <- foldlM (loadRule (moduleName mod)) rule_pool rules
 371         ; returnM (Pool new_pool (n_in + length rules) n_out) } }
 372
 373 loadRule :: ModuleName -> RulePoolContents -> IfaceRule -> IfL RulePoolContents
 374 -- "Gate" the rule simply by a crude notion of the free vars of
 375 -- the LHS.  It can be crude, because having too few free vars is safe.
 376 loadRule mod_name pool decl@(IfaceRule {ifRuleHead = fn, ifRuleArgs = args})
 377   = do  { names <- mapM lookupIfaceExt (fn : arg_fvs)
 378         ; returnM (addRuleToPool pool (mod_name, decl) names) }
 379   where
 380     arg_fvs = [n | arg <- args, n <- crudeIfExprGblFvs arg]
 381
 382 ---------------------------
 383 crudeIfExprGblFvs :: IfaceExpr -> [IfaceExtName]
 384 -- A crude approximation to the free external names of an IfExpr
 385 -- Returns a subset of the true answer
 386 crudeIfExprGblFvs (IfaceType ty) = get_tcs ty
 387 crudeIfExprGblFvs (IfaceExt v)   = [v]
 388 crudeIfExprGblFvs other          = []   -- Well, I said it was crude
 389
 390 get_tcs :: IfaceType -> [IfaceExtName]
 391 -- Get a crude subset of the TyCons of an IfaceType
 392 get_tcs (IfaceTyVar _)      = []
 393 get_tcs (IfaceAppTy t1 t2)  = get_tcs t1 ++ get_tcs t2
 394 get_tcs (IfaceFunTy t1 t2)  = get_tcs t1 ++ get_tcs t2
 395 get_tcs (IfaceForAllTy _ t) = get_tcs t
 396 get_tcs (IfacePredTy st)    = case st of
 397                                  IfaceClassP cl ts -> get_tcs_s ts
 398                                  IfaceIParam _ t   -> get_tcs t
 399 get_tcs (IfaceTyConApp (IfaceTc tc) ts) = tc : get_tcs_s ts
 400 get_tcs (IfaceTyConApp other        ts) = get_tcs_s ts
 401
 402 -- The lists are always small => appending is fine
 403 get_tcs_s :: [IfaceType] -> [IfaceExtName]
 404 get_tcs_s tys = foldr ((++) . get_tcs) [] tys
 405 \end{code}
 406
 407
 408 %*********************************************************
 409 %*                                                      *
 410                 Gating
 411 %*                                                      *
 412 %*********************************************************
 413
 414 Extract the gates of an instance declaration
 415
 416 \begin{code}
 417 ifaceInstGates :: IfaceType -> (IfaceExtName, [IfaceTyCon])
 418 -- Return the class, and the tycons mentioned in the rest of the head
 419 -- We only pick the TyCon at the root of each type, to avoid
 420 -- difficulties with overlap.  For example, suppose there are interfaces
 421 -- in the pool for
 422 --      C Int b
 423 --      C a [b]
 424 --      C a [T]
 425 -- Then, if we are trying to resolve (C Int x), we need the first
 426 --       if we are trying to resolve (C x [y]), we need *both* the latter
 427 --       two, even though T is not involved yet, so that we spot the overlap
 428
 429 ifaceInstGates (IfaceForAllTy _ t)                 = ifaceInstGates t
 430 ifaceInstGates (IfaceFunTy _ t)                    = ifaceInstGates t
 431 ifaceInstGates (IfacePredTy (IfaceClassP cls tys)) = instHeadGates cls tys
 432 ifaceInstGates other = pprPanic "ifaceInstGates" (ppr other)
 433         -- The other cases should not happen
 434
 435 instHeadGates cls tys = (cls, mapCatMaybes root_tycon tys)
 436   where
 437     root_tycon (IfaceFunTy _ _)      = Just (IfaceTc funTyConExtName)
 438     root_tycon (IfaceTyConApp tc _)  = Just tc
 439     root_tycon other                 = Nothing
 440
 441 funTyConExtName = mkIfaceExtName (tyConName funTyCon)
 442
 443
 444 predInstGates :: Class -> [Type] -> (Name, [Name])
 445 -- The same function, only this time on the predicate found in a dictionary
 446 predInstGates cls tys
 447   = (className cls, mapCatMaybes root_tycon tys)
 448   where
 449     root_tycon ty = case tcSplitTyConApp_maybe ty of
 450                         Just (tc, _) -> Just (tyConName tc)
 451                         Nothing      -> Nothing
 452 \end{code}
 453
 454
 455 %*********************************************************
 456 %*                                                      *
 457 \subsection{Reading an interface file}
 458 %*                                                      *
 459 %*********************************************************
 460
 461 \begin{code}
 462 findAndReadIface :: SDoc -> ModuleName
 463                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
 464                                         -- False <=> Look for .hi file
 465                  -> IfM lcl (Either Message ModIface)
 466         -- Nothing <=> file not found, or unreadable, or illegible
 467         -- Just x  <=> successfully found and parsed
 468
 469         -- It *doesn't* add an error to the monad, because
 470         -- sometimes it's ok to fail... see notes with loadInterface
 471
 472 findAndReadIface doc_str mod_name hi_boot_file
 473   = do  { traceIf (sep [hsep [ptext SLIT("Reading"),
 474                               if hi_boot_file
 475                                 then ptext SLIT("[boot]")
 476                                 else empty,
 477                               ptext SLIT("interface for"),
 478                               ppr mod_name <> semi],
 479                         nest 4 (ptext SLIT("reason:") <+> doc_str)])
 480
 481         -- Check for GHC.Prim, and return its static interface
 482         ; if mod_name == gHC_PRIM_Name
 483           then returnM (Right ghcPrimIface)
 484           else do
 485
 486         -- Look for the file
 487         ; mb_found <- ioToIOEnv (findHiFile mod_name hi_boot_file)
 488         ; case mb_found of {
 489               Left files -> do
 490                 { traceIf (ptext SLIT("...not found"))
 491                 ; dflags <- getDOpts
 492                 ; returnM (Left (noIfaceErr dflags mod_name hi_boot_file files)) } ;
 493
 494               Right file_path -> do
 495
 496         -- Found file, so read it
 497         { traceIf (ptext SLIT("readIFace") <+> text file_path)
 498         ; read_result <- readIface mod_name file_path hi_boot_file
 499         ; case read_result of
 500             Left err    -> returnM (Left (badIfaceFile file_path err))
 501             Right iface -> returnM (Right iface)
 502         }}}
 503
 504 findHiFile :: ModuleName -> IsBootInterface
 505            -> IO (Either [FilePath] FilePath)
 506 findHiFile mod_name hi_boot_file
 507  = do {
 508         -- In interactive or --make mode, we are *not allowed* to demand-load
 509         -- a home package .hi file.  So don't even look for them.
 510         -- This helps in the case where you are sitting in eg. ghc/lib/std
 511         -- and start up GHCi - it won't complain that all the modules it tries
 512         -- to load are found in the home location.
 513         ghci_mode <- readIORef v_GhcMode ;
 514         let { home_allowed = hi_boot_file ||
 515                              not (isCompManagerMode ghci_mode) } ;
 516         maybe_found <-  if home_allowed
 517                         then findModule mod_name
 518                         else findPackageModule mod_name ;
 519
 520         case maybe_found of {
 521           Left files -> return (Left files) ;
 522
 523           Right (_, loc) -> do {        -- Don't need module returned by finder
 524
 525         -- Return the path to M.hi, M.hi-boot, or M.hi-boot-n as appropriate
 526         let { hi_path            = ml_hi_file loc ;
 527               hi_boot_path       = replaceFilenameSuffix hi_path hiBootExt ;
 528               hi_boot_ver_path   = replaceFilenameSuffix hi_path hiBootVerExt
 529             };
 530
 531         if not hi_boot_file then
 532            return (Right hi_path)
 533         else do {
 534                 hi_ver_exists <- doesFileExist hi_boot_ver_path ;
 535                 if hi_ver_exists then return (Right hi_boot_ver_path)
 536                                  else return (Right hi_boot_path)
 537         }}}}
 538 \end{code}
 539
 540 @readIface@ tries just the one file.
 541
 542 \begin{code}
 543 readIface :: ModuleName -> String -> IsBootInterface
 544           -> IfM lcl (Either Message ModIface)
 545         -- Left err    <=> file not found, or unreadable, or illegible
 546         -- Right iface <=> successfully found and parsed
 547
 548 readIface wanted_mod_name file_path is_hi_boot_file
 549   = do  { dflags <- getDOpts
 550         ; ioToIOEnv (read_iface dflags wanted_mod_name file_path is_hi_boot_file) }
 551
 552 read_iface dflags wanted_mod file_path is_hi_boot_file
 553  | is_hi_boot_file              -- Read ascii
 554  = do { res <- tryMost (hGetStringBuffer file_path) ;
 555         case res of {
 556           Left exn     -> return (Left (text (showException exn))) ;
 557           Right buffer ->
 558         case unP parseIface (mkPState buffer loc dflags) of
 559           PFailed span err -> return (Left (mkLocMessage span err))
 560           POk _ iface
 561              | wanted_mod == actual_mod -> return (Right iface)
 562              | otherwise                -> return (Left err)
 563              where
 564                 actual_mod = moduleName (mi_module iface)
 565                 err = hiModuleNameMismatchWarn wanted_mod actual_mod
 566      }}
 567
 568  | otherwise            -- Read binary
 569  = do   { res <- tryMost (readBinIface file_path)
 570         ; case res of
 571             Right iface -> return (Right iface)
 572             Left exn    -> return (Left (text (showException exn))) }
 573  where
 574     loc  = mkSrcLoc (mkFastString file_path) 1 0
 575 \end{code}
 576
 577
 578 %*********************************************************
 579 %*                                                       *
 580         Wired-in interface for GHC.Prim
 581 %*                                                       *
 582 %*********************************************************
 583
 584 \begin{code}
 585 initExternalPackageState :: ExternalPackageState
 586 initExternalPackageState
 587   = EPS {
 588       eps_PIT        = emptyPackageIfaceTable,
 589       eps_PTE        = emptyTypeEnv,
 590       eps_inst_env   = emptyInstEnv,
 591       eps_rule_base  = emptyRuleBase,
 592       eps_decls      = emptyPool emptyNameEnv,
 593       eps_insts      = emptyPool emptyNameEnv,
 594       eps_rules      = foldr add (emptyPool []) builtinRules
 595     }
 596   where
 597         -- Initialise the EPS rule pool with the built-in rules
 598     add (fn_name, core_rule) (Pool rules n_in n_out)
 599       = Pool rules' (n_in+1) n_out
 600       where
 601         rules' = addRuleToPool rules iface_rule [fn_name]
 602         iface_rule = (nameModuleName fn_name, IfaceBuiltinRule (mkIfaceExtName fn_name) core_rule)
 603 \end{code}
 604
 605
 606 %*********************************************************
 607 %*                                                       *
 608         Wired-in interface for GHC.Prim
 609 %*                                                       *
 610 %*********************************************************
 611
 612 \begin{code}
 613 ghcPrimIface :: ModIface
 614 ghcPrimIface
 615   = (emptyModIface basePackage gHC_PRIM_Name) {
 616         mi_exports  = [(gHC_PRIM_Name, ghcPrimExports)],
 617         mi_decls    = [],
 618         mi_fixities = fixities,
 619         mi_fix_fn  = mkIfaceFixCache fixities
 620     }
 621   where
 622     fixities = [(getOccName seqId, Fixity 0 InfixR)]
 623                         -- seq is infixr 0
 624 \end{code}
 625
 626 %*********************************************************
 627 %*                                                      *
 628 \subsection{Statistics}
 629 %*                                                      *
 630 %*********************************************************
 631
 632 \begin{code}
 633 ifaceStats :: ExternalPackageState -> SDoc
 634 ifaceStats eps
 635   = hcat [text "Renamer stats: ", stats]
 636   where
 637     n_mods = length [() | _ <- moduleEnvElts (eps_PIT eps)]
 638         -- This is really only right for a one-shot compile
 639
 640     Pool _ n_decls_in n_decls_out = eps_decls eps
 641     Pool _ n_insts_in n_insts_out = eps_insts eps
 642     Pool _ n_rules_in n_rules_out = eps_rules eps
 643
 644     stats = vcat
 645         [int n_mods <+> text "interfaces read",
 646          hsep [ int n_decls_out, text "type/class/variable imported, out of",
 647                 int n_decls_in, text "read"],
 648          hsep [ int n_insts_out, text "instance decls imported, out of",
 649                 int n_insts_in, text "read"],
 650          hsep [ int n_rules_out, text "rule decls imported, out of",
 651                 int n_rules_in, text "read"]
 652         ]
 653 \end{code}
 654
 655
 656 %*********************************************************
 657 %*                                                       *
 658 \subsection{Errors}
 659 %*                                                       *
 660 %*********************************************************
 661
 662 \begin{code}
 663 badIfaceFile file err
 664   = vcat [ptext SLIT("Bad interface file:") <+> text file,
 665           nest 4 err]
 666
 667 hiModuleNameMismatchWarn :: ModuleName -> ModuleName -> Message
 668 hiModuleNameMismatchWarn requested_mod read_mod =
 669     hsep [ ptext SLIT("Something is amiss; requested module name")
 670          , ppr requested_mod
 671          , ptext SLIT("differs from name found in the interface file")
 672          , ppr read_mod
 673          ]
 674
 675 noIfaceErr dflags mod_name boot_file files
 676   = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
 677     $$ extra
 678   where
 679    extra
 680     | verbosity dflags < 3 =
 681         text "(use -v to see a list of the files searched for)"
 682     | otherwise =
 683         hang (ptext SLIT("locations searched:")) 4 (vcat (map text files))
 684 \end{code}