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, discardDeclPrags,
  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(..), IfaceConDecls(..), IfaceConDecl(..), IfaceClassOp(..),
  24                           IfaceInst(..), IfaceRule(..), IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..),
  25                           IfaceType(..), IfacePredType(..), IfaceExtName, visibleIfConDecls, 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            ( 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         { ignore_prags <- doptM Opt_IgnoreInterfacePragmas
 231         ; new_eps_decls <- loadDecls ignore_prags mod (eps_decls eps) (mi_decls iface)
 232         ; new_eps_rules <- loadRules ignore_prags mod (eps_rules eps) (mi_rules iface)
 233         ; new_eps_insts <- loadInsts              mod (eps_insts eps) (mi_insts iface)
 234
 235         ; let { final_iface = iface {   mi_decls = panic "No mi_decls in PIT",
 236                                         mi_insts = panic "No mi_insts in PIT",
 237                                         mi_rules = panic "No mi_rules in PIT" }
 238
 239               ; new_eps = eps { eps_PIT   = extendModuleEnv pit mod final_iface,
 240                                 eps_decls = new_eps_decls,
 241                                 eps_rules = new_eps_rules,
 242                                 eps_insts = new_eps_insts } }
 243         ; writeMutVar eps_var new_eps
 244         ; return (Right final_iface)
 245     }}}}}
 246
 247 -----------------------------------------------------
 248 --      Loading type/class/value decls
 249 -- We pass the full Module name here, replete with
 250 -- its package info, so that we can build a Name for
 251 -- each binder with the right package info in it
 252 -- All subsequent lookups, including crucially lookups during typechecking
 253 -- the declaration itself, will find the fully-glorious Name
 254 -----------------------------------------------------
 255
 256 loadDecls :: Bool       -- Don't load pragmas into the decl pool
 257           -> Module -> DeclPool
 258           -> [(Version, IfaceDecl)]
 259           -> IfM lcl DeclPool
 260 loadDecls ignore_prags mod (Pool decls_map n_in n_out) decls
 261   = do  { decls_map' <- foldlM (loadDecl ignore_prags mod) decls_map decls
 262         ; returnM (Pool decls_map' (n_in + length decls) n_out) }
 263
 264 loadDecl ignore_prags mod decls_map (_version, decl)
 265   = do  { main_name <- mk_new_bndr Nothing (ifName decl)
 266         ; let decl' | ignore_prags = discardDeclPrags decl
 267                     | otherwise    = decl
 268
 269         -- Populate the name cache with final versions of all the subordinate names
 270         ; mapM_ (mk_new_bndr (Just main_name)) (ifaceDeclSubBndrs decl')
 271
 272         -- Extend the decls pool with a mapping for the main name (only)
 273         ; returnM (extendNameEnv decls_map main_name decl') }
 274   where
 275         -- mk_new_bndr allocates in the name cache the final canonical
 276         -- name for the thing, with the correct
 277         --      * package info
 278         --      * parent
 279         --      * location
 280         -- imported name, to fix the module correctly in the cache
 281     mk_new_bndr mb_parent occ = newGlobalBinder mod occ mb_parent loc
 282     loc = importedSrcLoc (moduleUserString mod)
 283
 284 discardDeclPrags :: IfaceDecl -> IfaceDecl
 285 discardDeclPrags decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = NoInfo }
 286 discardDeclPrags decl                                  = decl
 287
 288
 289 -----------------
 290 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
 291 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
 292 -- Rather revolting, because it has to predict what gets bound
 293
 294 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, ifSigs = sigs })
 295   = [tc_occ, dc_occ] ++
 296     [op | IfaceClassOp op _ _ <- sigs] ++
 297     [mkSuperDictSelOcc n cls_occ | n <- [1..length sc_ctxt]] ++
 298         -- The worker and wrapper for the DataCon of the class TyCon
 299         -- are based off the data-con name
 300     [mkDataConWrapperOcc dc_occ, mkDataConWorkerOcc dc_occ]
 301   where
 302     tc_occ  = mkClassTyConOcc cls_occ
 303     dc_occ  = mkClassDataConOcc cls_occ
 304
 305 ifaceDeclSubBndrs (IfaceData {ifCons = cons}) = foldr ((++) . conDeclBndrs) []
 306                                                       (visibleIfConDecls cons)
 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 :: Bool       -- Don't load pragmas into the decl pool
 365           -> Module -> RulePool -> [IfaceRule] -> IfL RulePool
 366 loadRules ignore_prags mod pool@(Pool rule_pool n_in n_out) rules
 367   | ignore_prags = returnM pool
 368   | otherwise
 369   = do  { new_pool <- foldlM (loadRule (moduleName mod)) rule_pool rules
 370         ; returnM (Pool new_pool (n_in + length rules) n_out) }
 371
 372 loadRule :: ModuleName -> RulePoolContents -> IfaceRule -> IfL RulePoolContents
 373 -- "Gate" the rule simply by a crude notion of the free vars of
 374 -- the LHS.  It can be crude, because having too few free vars is safe.
 375 loadRule mod_name pool decl@(IfaceRule {ifRuleHead = fn, ifRuleArgs = args})
 376   = do  { names <- mapM lookupIfaceExt (fn : arg_fvs)
 377         ; returnM (addRuleToPool pool (mod_name, decl) names) }
 378   where
 379     arg_fvs = [n | arg <- args, n <- crudeIfExprGblFvs arg]
 380
 381 ---------------------------
 382 crudeIfExprGblFvs :: IfaceExpr -> [IfaceExtName]
 383 -- A crude approximation to the free external names of an IfExpr
 384 -- Returns a subset of the true answer
 385 crudeIfExprGblFvs (IfaceType ty) = get_tcs ty
 386 crudeIfExprGblFvs (IfaceExt v)   = [v]
 387 crudeIfExprGblFvs other          = []   -- Well, I said it was crude
 388
 389 get_tcs :: IfaceType -> [IfaceExtName]
 390 -- Get a crude subset of the TyCons of an IfaceType
 391 get_tcs (IfaceTyVar _)      = []
 392 get_tcs (IfaceAppTy t1 t2)  = get_tcs t1 ++ get_tcs t2
 393 get_tcs (IfaceFunTy t1 t2)  = get_tcs t1 ++ get_tcs t2
 394 get_tcs (IfaceForAllTy _ t) = get_tcs t
 395 get_tcs (IfacePredTy st)    = case st of
 396                                  IfaceClassP cl ts -> get_tcs_s ts
 397                                  IfaceIParam _ t   -> get_tcs t
 398 get_tcs (IfaceTyConApp (IfaceTc tc) ts) = tc : get_tcs_s ts
 399 get_tcs (IfaceTyConApp other        ts) = get_tcs_s ts
 400
 401 -- The lists are always small => appending is fine
 402 get_tcs_s :: [IfaceType] -> [IfaceExtName]
 403 get_tcs_s tys = foldr ((++) . get_tcs) [] tys
 404 \end{code}
 405
 406
 407 %*********************************************************
 408 %*                                                      *
 409                 Gating
 410 %*                                                      *
 411 %*********************************************************
 412
 413 Extract the gates of an instance declaration
 414
 415 \begin{code}
 416 ifaceInstGates :: IfaceType -> (IfaceExtName, [IfaceTyCon])
 417 -- Return the class, and the tycons mentioned in the rest of the head
 418 -- We only pick the TyCon at the root of each type, to avoid
 419 -- difficulties with overlap.  For example, suppose there are interfaces
 420 -- in the pool for
 421 --      C Int b
 422 --      C a [b]
 423 --      C a [T]
 424 -- Then, if we are trying to resolve (C Int x), we need the first
 425 --       if we are trying to resolve (C x [y]), we need *both* the latter
 426 --       two, even though T is not involved yet, so that we spot the overlap
 427
 428 ifaceInstGates (IfaceForAllTy _ t)                 = ifaceInstGates t
 429 ifaceInstGates (IfaceFunTy _ t)                    = ifaceInstGates t
 430 ifaceInstGates (IfacePredTy (IfaceClassP cls tys)) = instHeadGates cls tys
 431 ifaceInstGates other = pprPanic "ifaceInstGates" (ppr other)
 432         -- The other cases should not happen
 433
 434 instHeadGates cls tys = (cls, mapCatMaybes root_tycon tys)
 435   where
 436     root_tycon (IfaceFunTy _ _)      = Just (IfaceTc funTyConExtName)
 437     root_tycon (IfaceTyConApp tc _)  = Just tc
 438     root_tycon other                 = Nothing
 439
 440 funTyConExtName = mkIfaceExtName (tyConName funTyCon)
 441
 442
 443 predInstGates :: Class -> [Type] -> (Name, [Name])
 444 -- The same function, only this time on the predicate found in a dictionary
 445 predInstGates cls tys
 446   = (className cls, mapCatMaybes root_tycon tys)
 447   where
 448     root_tycon ty = case tcSplitTyConApp_maybe ty of
 449                         Just (tc, _) -> Just (tyConName tc)
 450                         Nothing      -> Nothing
 451 \end{code}
 452
 453
 454 %*********************************************************
 455 %*                                                      *
 456 \subsection{Reading an interface file}
 457 %*                                                      *
 458 %*********************************************************
 459
 460 \begin{code}
 461 findAndReadIface :: SDoc -> ModuleName
 462                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
 463                                         -- False <=> Look for .hi file
 464                  -> IfM lcl (Either Message ModIface)
 465         -- Nothing <=> file not found, or unreadable, or illegible
 466         -- Just x  <=> successfully found and parsed
 467
 468         -- It *doesn't* add an error to the monad, because
 469         -- sometimes it's ok to fail... see notes with loadInterface
 470
 471 findAndReadIface doc_str mod_name hi_boot_file
 472   = do  { traceIf (sep [hsep [ptext SLIT("Reading"),
 473                               if hi_boot_file
 474                                 then ptext SLIT("[boot]")
 475                                 else empty,
 476                               ptext SLIT("interface for"),
 477                               ppr mod_name <> semi],
 478                         nest 4 (ptext SLIT("reason:") <+> doc_str)])
 479
 480         -- Check for GHC.Prim, and return its static interface
 481         ; if mod_name == gHC_PRIM_Name
 482           then returnM (Right ghcPrimIface)
 483           else do
 484
 485         -- Look for the file
 486         ; mb_found <- ioToIOEnv (findHiFile mod_name hi_boot_file)
 487         ; case mb_found of {
 488               Left files -> do
 489                 { traceIf (ptext SLIT("...not found"))
 490                 ; dflags <- getDOpts
 491                 ; returnM (Left (noIfaceErr dflags mod_name hi_boot_file files)) } ;
 492
 493               Right file_path -> do
 494
 495         -- Found file, so read it
 496         { traceIf (ptext SLIT("readIFace") <+> text file_path)
 497         ; read_result <- readIface mod_name file_path hi_boot_file
 498         ; case read_result of
 499             Left err    -> returnM (Left (badIfaceFile file_path err))
 500             Right iface
 501                 | moduleName (mi_module iface) /= mod_name ->
 502                   return (Left (wrongIfaceModErr iface mod_name file_path))
 503                 | otherwise ->
 504                   returnM (Right iface)
 505         }}}
 506
 507 findHiFile :: ModuleName -> IsBootInterface
 508            -> IO (Either [FilePath] FilePath)
 509 findHiFile mod_name hi_boot_file
 510  = do {
 511         -- In interactive or --make mode, we are *not allowed* to demand-load
 512         -- a home package .hi file.  So don't even look for them.
 513         -- This helps in the case where you are sitting in eg. ghc/lib/std
 514         -- and start up GHCi - it won't complain that all the modules it tries
 515         -- to load are found in the home location.
 516         ghci_mode <- readIORef v_GhcMode ;
 517         let { home_allowed = hi_boot_file ||
 518                              not (isCompManagerMode ghci_mode) } ;
 519         maybe_found <-  if home_allowed
 520                         then findModule mod_name
 521                         else findPackageModule mod_name ;
 522
 523         case maybe_found of {
 524           Left files -> return (Left files) ;
 525
 526           Right (_, loc) -> do {        -- Don't need module returned by finder
 527
 528         -- Return the path to M.hi, M.hi-boot, or M.hi-boot-n as appropriate
 529         let { hi_path            = ml_hi_file loc ;
 530               hi_boot_path       = replaceFilenameSuffix hi_path hiBootExt ;
 531               hi_boot_ver_path   = replaceFilenameSuffix hi_path hiBootVerExt
 532             };
 533
 534         if not hi_boot_file then
 535            return (Right hi_path)
 536         else do {
 537                 hi_ver_exists <- doesFileExist hi_boot_ver_path ;
 538                 if hi_ver_exists then return (Right hi_boot_ver_path)
 539                                  else return (Right hi_boot_path)
 540         }}}}
 541 \end{code}
 542
 543 @readIface@ tries just the one file.
 544
 545 \begin{code}
 546 readIface :: ModuleName -> String -> IsBootInterface
 547           -> IfM lcl (Either Message ModIface)
 548         -- Left err    <=> file not found, or unreadable, or illegible
 549         -- Right iface <=> successfully found and parsed
 550
 551 readIface wanted_mod_name file_path is_hi_boot_file
 552   = do  { dflags <- getDOpts
 553         ; ioToIOEnv (read_iface dflags wanted_mod_name file_path is_hi_boot_file) }
 554
 555 read_iface dflags wanted_mod file_path is_hi_boot_file
 556  | is_hi_boot_file              -- Read ascii
 557  = do { res <- tryMost (hGetStringBuffer file_path) ;
 558         case res of {
 559           Left exn     -> return (Left (text (showException exn))) ;
 560           Right buffer ->
 561         case unP parseIface (mkPState buffer loc dflags) of
 562           PFailed span err -> return (Left (mkLocMessage span err))
 563           POk _ iface
 564              | wanted_mod == actual_mod -> return (Right iface)
 565              | otherwise                -> return (Left err)
 566              where
 567                 actual_mod = moduleName (mi_module iface)
 568                 err = hiModuleNameMismatchWarn wanted_mod actual_mod
 569      }}
 570
 571  | otherwise            -- Read binary
 572  = do   { res <- tryMost (readBinIface file_path)
 573         ; case res of
 574             Right iface -> return (Right iface)
 575             Left exn    -> return (Left (text (showException exn))) }
 576  where
 577     loc  = mkSrcLoc (mkFastString file_path) 1 0
 578 \end{code}
 579
 580
 581 %*********************************************************
 582 %*                                                       *
 583         Wired-in interface for GHC.Prim
 584 %*                                                       *
 585 %*********************************************************
 586
 587 \begin{code}
 588 initExternalPackageState :: ExternalPackageState
 589 initExternalPackageState
 590   = EPS {
 591       eps_PIT        = emptyPackageIfaceTable,
 592       eps_PTE        = emptyTypeEnv,
 593       eps_inst_env   = emptyInstEnv,
 594       eps_rule_base  = emptyRuleBase,
 595       eps_decls      = emptyPool emptyNameEnv,
 596       eps_insts      = emptyPool emptyNameEnv,
 597       eps_rules      = foldr add (emptyPool []) builtinRules
 598     }
 599   where
 600         -- Initialise the EPS rule pool with the built-in rules
 601     add (fn_name, core_rule) (Pool rules n_in n_out)
 602       = Pool rules' (n_in+1) n_out
 603       where
 604         rules' = addRuleToPool rules iface_rule [fn_name]
 605         iface_rule = (nameModuleName fn_name, IfaceBuiltinRule (mkIfaceExtName fn_name) core_rule)
 606 \end{code}
 607
 608
 609 %*********************************************************
 610 %*                                                       *
 611         Wired-in interface for GHC.Prim
 612 %*                                                       *
 613 %*********************************************************
 614
 615 \begin{code}
 616 ghcPrimIface :: ModIface
 617 ghcPrimIface
 618   = (emptyModIface basePackage gHC_PRIM_Name) {
 619         mi_exports  = [(gHC_PRIM_Name, ghcPrimExports)],
 620         mi_decls    = [],
 621         mi_fixities = fixities,
 622         mi_fix_fn  = mkIfaceFixCache fixities
 623     }
 624   where
 625     fixities = [(getOccName seqId, Fixity 0 InfixR)]
 626                         -- seq is infixr 0
 627 \end{code}
 628
 629 %*********************************************************
 630 %*                                                      *
 631 \subsection{Statistics}
 632 %*                                                      *
 633 %*********************************************************
 634
 635 \begin{code}
 636 ifaceStats :: ExternalPackageState -> SDoc
 637 ifaceStats eps
 638   = hcat [text "Renamer stats: ", stats]
 639   where
 640     n_mods = length [() | _ <- moduleEnvElts (eps_PIT eps)]
 641         -- This is really only right for a one-shot compile
 642
 643     Pool _ n_decls_in n_decls_out = eps_decls eps
 644     Pool _ n_insts_in n_insts_out = eps_insts eps
 645     Pool _ n_rules_in n_rules_out = eps_rules eps
 646
 647     stats = vcat
 648         [int n_mods <+> text "interfaces read",
 649          hsep [ int n_decls_out, text "type/class/variable imported, out of",
 650                 int n_decls_in, text "read"],
 651          hsep [ int n_insts_out, text "instance decls imported, out of",
 652                 int n_insts_in, text "read"],
 653          hsep [ int n_rules_out, text "rule decls imported, out of",
 654                 int n_rules_in, text "read"]
 655         ]
 656 \end{code}
 657
 658
 659 %*********************************************************
 660 %*                                                       *
 661 \subsection{Errors}
 662 %*                                                       *
 663 %*********************************************************
 664
 665 \begin{code}
 666 badIfaceFile file err
 667   = vcat [ptext SLIT("Bad interface file:") <+> text file,
 668           nest 4 err]
 669
 670 hiModuleNameMismatchWarn :: ModuleName -> ModuleName -> Message
 671 hiModuleNameMismatchWarn requested_mod read_mod =
 672     hsep [ ptext SLIT("Something is amiss; requested module name")
 673          , ppr requested_mod
 674          , ptext SLIT("differs from name found in the interface file")
 675          , ppr read_mod
 676          ]
 677
 678 noIfaceErr dflags mod_name boot_file files
 679   = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
 680     $$ extra
 681   where
 682    extra
 683     | verbosity dflags < 3 =
 684         text "(use -v to see a list of the files searched for)"
 685     | otherwise =
 686         hang (ptext SLIT("locations searched:")) 4 (vcat (map text files))
 687
 688 wrongIfaceModErr iface mod_name file_path
 689   = sep [ptext SLIT("Interface file") <+> iface_file,
 690          ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
 691          ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
 692          sep [ptext SLIT("Probable cause: the source code which generated"),
 693              nest 2 iface_file,
 694              ptext SLIT("has an incompatible module name")
 695             ]
 696         ]
 697   where iface_file = doubleQuotes (text file_path)
 698 \end{code}