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